{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NondecreasingIndentation #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module GHC.CmmToAsm.X86.CodeGen (
        cmmTopCodeGen,
        generateJumpTableForInstr,
        extractUnwindPoints,
        invertCondBranches,
        InstrBlock
)
where
import GHC.Prelude
import GHC.CmmToAsm.X86.Instr
import GHC.CmmToAsm.X86.Cond
import GHC.CmmToAsm.X86.Regs
import GHC.CmmToAsm.X86.Ppr
import GHC.CmmToAsm.X86.RegInfo
import GHC.Platform.Regs
import GHC.CmmToAsm.CPrim
import GHC.CmmToAsm.Types
import GHC.Cmm.DebugBlock
   ( DebugBlock(..), UnwindPoint(..), UnwindTable
   , UnwindExpr(UwReg), toUnwindExpr
   )
import GHC.CmmToAsm.PIC
import GHC.CmmToAsm.Monad
   ( NatM, getNewRegNat, getNewLabelNat, setDeltaNat
   , getDeltaNat, getBlockIdNat, getPicBaseNat
   , Reg64(..), RegCode64(..), getNewReg64, localReg64
   , getPicBaseMaybeNat, getDebugBlock, getFileId
   , addImmediateSuccessorNat, updateCfgNat, getConfig, getPlatform
   , getCfgWeights
   )
import GHC.CmmToAsm.CFG
import GHC.CmmToAsm.Format
import GHC.CmmToAsm.Config
import GHC.Platform.Reg
import GHC.Platform
import GHC.Types.Basic
import GHC.Cmm.BlockId
import GHC.Unit.Types ( primUnitId )
import GHC.Cmm.Utils
import GHC.Cmm.Switch
import GHC.Cmm
import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Collections
import GHC.Cmm.Dataflow.Graph
import GHC.Cmm.Dataflow.Label
import GHC.Cmm.CLabel
import GHC.Types.Tickish ( GenTickish(..) )
import GHC.Types.SrcLoc  ( srcSpanFile, srcSpanStartLine, srcSpanStartCol )
import GHC.Types.ForeignCall ( CCallConv(..) )
import GHC.Data.OrdList
import GHC.Utils.Outputable
import GHC.Utils.Constants (debugIsOn)
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain
import GHC.Data.FastString
import GHC.Utils.Misc
import GHC.Types.Unique.Supply ( getUniqueM )
import Control.Monad
import Data.Foldable (fold)
import Data.Int
import Data.Maybe
import Data.Word
import qualified Data.Map as M
is32BitPlatform :: NatM Bool
is32BitPlatform :: NatM Bool
is32BitPlatform = do
    Platform
platform <- NatM Platform
getPlatform
    Bool -> NatM Bool
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> NatM Bool) -> Bool -> NatM Bool
forall a b. (a -> b) -> a -> b
$ Platform -> Bool
target32Bit Platform
platform
expect32BitPlatform :: SDoc -> NatM ()
expect32BitPlatform :: SDoc -> NatM ()
expect32BitPlatform SDoc
doc = do
  Bool
is32Bit <- NatM Bool
is32BitPlatform
  Bool -> NatM () -> NatM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
is32Bit) (NatM () -> NatM ()) -> NatM () -> NatM ()
forall a b. (a -> b) -> a -> b
$
    String -> SDoc -> NatM ()
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Expecting 32-bit platform" SDoc
doc
sse2Enabled :: NatM Bool
sse2Enabled :: NatM Bool
sse2Enabled = do
  NCGConfig
config <- NatM NCGConfig
getConfig
  Bool -> NatM Bool
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (NCGConfig -> Maybe SseVersion
ncgSseVersion NCGConfig
config Maybe SseVersion -> Maybe SseVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= SseVersion -> Maybe SseVersion
forall a. a -> Maybe a
Just SseVersion
SSE2)
sse4_2Enabled :: NatM Bool
sse4_2Enabled :: NatM Bool
sse4_2Enabled = do
  NCGConfig
config <- NatM NCGConfig
getConfig
  Bool -> NatM Bool
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (NCGConfig -> Maybe SseVersion
ncgSseVersion NCGConfig
config Maybe SseVersion -> Maybe SseVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= SseVersion -> Maybe SseVersion
forall a. a -> Maybe a
Just SseVersion
SSE42)
cmmTopCodeGen
        :: RawCmmDecl
        -> NatM [NatCmmDecl (Alignment, RawCmmStatics) Instr]
cmmTopCodeGen :: RawCmmDecl -> NatM [NatCmmDecl (Alignment, 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 (Alignment, RawCmmStatics) Instr]]
statics) <- (CmmBlock
 -> NatM
      ([NatBasicBlock Instr],
       [NatCmmDecl (Alignment, RawCmmStatics) Instr]))
-> [CmmBlock]
-> NatM
     ([[NatBasicBlock Instr]],
      [[NatCmmDecl (Alignment, RawCmmStatics) Instr]])
forall (m :: * -> *) a b c.
Applicative m =>
(a -> m (b, c)) -> [a] -> m ([b], [c])
mapAndUnzipM CmmBlock
-> NatM
     ([NatBasicBlock Instr],
      [NatCmmDecl (Alignment, RawCmmStatics) Instr])
basicBlockCodeGen [CmmBlock]
blocks
  Maybe Reg
picBaseMb <- NatM (Maybe Reg)
getPicBaseMaybeNat
  Platform
platform <- NatM Platform
getPlatform
  let proc :: NatCmmDecl (Alignment, RawCmmStatics) Instr
proc = LabelMap RawCmmStatics
-> CLabel
-> [GlobalReg]
-> ListGraph Instr
-> NatCmmDecl (Alignment, 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 (Alignment, RawCmmStatics) Instr]
tops = NatCmmDecl (Alignment, RawCmmStatics) Instr
proc NatCmmDecl (Alignment, RawCmmStatics) Instr
-> [NatCmmDecl (Alignment, RawCmmStatics) Instr]
-> [NatCmmDecl (Alignment, RawCmmStatics) Instr]
forall a. a -> [a] -> [a]
: [[NatCmmDecl (Alignment, RawCmmStatics) Instr]]
-> [NatCmmDecl (Alignment, RawCmmStatics) Instr]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[NatCmmDecl (Alignment, RawCmmStatics) Instr]]
statics
      os :: OS
os   = Platform -> OS
platformOS Platform
platform
  case Maybe Reg
picBaseMb of
      Just Reg
picBase -> Arch
-> OS
-> Reg
-> [NatCmmDecl (Alignment, RawCmmStatics) Instr]
-> NatM [NatCmmDecl (Alignment, RawCmmStatics) Instr]
initializePicBase_x86 Arch
ArchX86 OS
os Reg
picBase [NatCmmDecl (Alignment, RawCmmStatics) Instr]
tops
      Maybe Reg
Nothing -> [NatCmmDecl (Alignment, RawCmmStatics) Instr]
-> NatM [NatCmmDecl (Alignment, RawCmmStatics) Instr]
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return [NatCmmDecl (Alignment, RawCmmStatics) Instr]
tops
cmmTopCodeGen (CmmData Section
sec RawCmmStatics
dat) =
  [NatCmmDecl (Alignment, RawCmmStatics) Instr]
-> NatM [NatCmmDecl (Alignment, RawCmmStatics) Instr]
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return [Section
-> (Alignment, RawCmmStatics)
-> NatCmmDecl (Alignment, RawCmmStatics) Instr
forall d h g. Section -> d -> GenCmmDecl d h g
CmmData Section
sec (Int -> Alignment
mkAlignment Int
1, RawCmmStatics
dat)]  
verifyBasicBlock :: Platform -> [Instr] -> ()
verifyBasicBlock :: Platform -> [Instr] -> ()
verifyBasicBlock Platform
platform [Instr]
instrs
  | Bool
debugIsOn     = Bool -> [Instr] -> ()
go Bool
False [Instr]
instrs
  | Bool
otherwise     = ()
  where
    go :: Bool -> [Instr] -> ()
go Bool
_     [] = ()
    go Bool
atEnd (Instr
i:[Instr]
instr)
        = case Instr
i of
            
            NEWBLOCK {} -> Bool -> [Instr] -> ()
go Bool
False [Instr]
instr
            
            CALL {}     | Bool
atEnd -> Instr -> ()
faultyBlockWith Instr
i
                        | Bool -> Bool
not Bool
atEnd -> Bool -> [Instr] -> ()
go Bool
atEnd [Instr]
instr
            
            Instr
_ | Bool -> Bool
not Bool
atEnd -> Bool -> [Instr] -> ()
go (Instr -> Bool
isJumpishInstr Instr
i) [Instr]
instr
              
              | Bool
otherwise -> if Instr -> Bool
isJumpishInstr Instr
i
                                then Bool -> [Instr] -> ()
go Bool
True [Instr]
instr
                                else Instr -> ()
faultyBlockWith Instr
i
    faultyBlockWith :: Instr -> ()
faultyBlockWith Instr
i
        = String -> SDoc -> ()
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Non control flow instructions after end of basic block."
                   (Platform -> Instr -> SDoc
pprInstr Platform
platform Instr
i SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"in:" SDoc -> SDoc -> SDoc
$$ [SDoc] -> SDoc
vcat ((Instr -> SDoc) -> [Instr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> Instr -> SDoc
pprInstr Platform
platform) [Instr]
instrs))
basicBlockCodeGen
        :: CmmBlock
        -> NatM ( [NatBasicBlock Instr]
                , [NatCmmDecl (Alignment, RawCmmStatics) Instr])
basicBlockCodeGen :: CmmBlock
-> NatM
     ([NatBasicBlock Instr],
      [NatCmmDecl (Alignment, 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 :: Label
id = CmmBlock -> Label
forall (x :: Extensibility). Block CmmNode C x -> Label
forall (thing :: Extensibility -> Extensibility -> *)
       (x :: Extensibility).
NonLocal thing =>
thing C x -> Label
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 <- Label -> NatM (Maybe DebugBlock)
getDebugBlock (CmmBlock -> Label
forall (x :: Extensibility). Block CmmNode C x -> Label
forall (thing :: Extensibility -> Extensibility -> *)
       (x :: Extensibility).
NonLocal thing =>
thing C x -> Label
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,Label
mid_bid) <- Label -> [CmmNode O O] -> NatM (OrdList Instr, Label)
stmtsToInstrs Label
id [CmmNode O O]
stmts
  (!OrdList Instr
tail_instrs,Maybe Label
_) <- Label -> CmmNode O C -> NatM (OrdList Instr, Maybe Label)
forall (e :: Extensibility) (x :: Extensibility).
Label -> CmmNode e x -> NatM (OrdList Instr, Maybe Label)
stmtToInstrs Label
mid_bid 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
  Platform
platform <- NatM Platform
getPlatform
  () -> NatM ()
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> NatM ()) -> () -> NatM ()
forall a b. (a -> b) -> a -> b
$! Platform -> [Instr] -> ()
verifyBasicBlock Platform
platform (OrdList Instr -> [Instr]
forall a. OrdList a -> [a]
fromOL OrdList Instr
instrs)
  OrdList Instr
instrs' <- OrdList (OrdList Instr) -> OrdList Instr
forall m. Monoid m => OrdList m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (OrdList (OrdList Instr) -> OrdList Instr)
-> NatM (OrdList (OrdList Instr)) -> NatM (OrdList Instr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList (OrdList Instr))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> OrdList a -> f (OrdList b)
traverse Instr -> NatM (OrdList Instr)
addSpUnwindings OrdList Instr
instrs
  
  
  
  
  let
        ([Instr]
top,[NatBasicBlock Instr]
other_blocks,[NatCmmDecl (Alignment, RawCmmStatics) Instr]
statics) = (Instr
 -> ([Instr], [NatBasicBlock Instr],
     [NatCmmDecl (Alignment, RawCmmStatics) Instr])
 -> ([Instr], [NatBasicBlock Instr],
     [NatCmmDecl (Alignment, RawCmmStatics) Instr]))
-> ([Instr], [NatBasicBlock Instr],
    [NatCmmDecl (Alignment, RawCmmStatics) Instr])
-> OrdList Instr
-> ([Instr], [NatBasicBlock Instr],
    [NatCmmDecl (Alignment, RawCmmStatics) Instr])
forall a b. (a -> b -> b) -> b -> OrdList a -> b
foldrOL Instr
-> ([Instr], [NatBasicBlock Instr],
    [NatCmmDecl (Alignment, RawCmmStatics) Instr])
-> ([Instr], [NatBasicBlock Instr],
    [NatCmmDecl (Alignment, RawCmmStatics) Instr])
forall {h} {g}.
Instr
-> ([Instr], [NatBasicBlock Instr],
    [GenCmmDecl (Alignment, RawCmmStatics) h g])
-> ([Instr], [NatBasicBlock Instr],
    [GenCmmDecl (Alignment, RawCmmStatics) h g])
mkBlocks ([],[],[]) OrdList Instr
instrs'
        mkBlocks :: Instr
-> ([Instr], [NatBasicBlock Instr],
    [GenCmmDecl (Alignment, RawCmmStatics) h g])
-> ([Instr], [NatBasicBlock Instr],
    [GenCmmDecl (Alignment, RawCmmStatics) h g])
mkBlocks (NEWBLOCK Label
id) ([Instr]
instrs,[NatBasicBlock Instr]
blocks,[GenCmmDecl (Alignment, RawCmmStatics) h g]
statics)
          = ([], Label -> [Instr] -> NatBasicBlock Instr
forall i. Label -> [i] -> GenBasicBlock i
BasicBlock Label
id [Instr]
instrs NatBasicBlock Instr
-> [NatBasicBlock Instr] -> [NatBasicBlock Instr]
forall a. a -> [a] -> [a]
: [NatBasicBlock Instr]
blocks, [GenCmmDecl (Alignment, RawCmmStatics) h g]
statics)
        mkBlocks (LDATA Section
sec (Alignment, RawCmmStatics)
dat) ([Instr]
instrs,[NatBasicBlock Instr]
blocks,[GenCmmDecl (Alignment, RawCmmStatics) h g]
statics)
          = ([Instr]
instrs, [NatBasicBlock Instr]
blocks, Section
-> (Alignment, RawCmmStatics)
-> GenCmmDecl (Alignment, RawCmmStatics) h g
forall d h g. Section -> d -> GenCmmDecl d h g
CmmData Section
sec (Alignment, RawCmmStatics)
datGenCmmDecl (Alignment, RawCmmStatics) h g
-> [GenCmmDecl (Alignment, RawCmmStatics) h g]
-> [GenCmmDecl (Alignment, RawCmmStatics) h g]
forall a. a -> [a] -> [a]
:[GenCmmDecl (Alignment, RawCmmStatics) h g]
statics)
        mkBlocks Instr
instr ([Instr]
instrs,[NatBasicBlock Instr]
blocks,[GenCmmDecl (Alignment, RawCmmStatics) h g]
statics)
          = (Instr
instrInstr -> [Instr] -> [Instr]
forall a. a -> [a] -> [a]
:[Instr]
instrs, [NatBasicBlock Instr]
blocks, [GenCmmDecl (Alignment, RawCmmStatics) h g]
statics)
  ([NatBasicBlock Instr],
 [NatCmmDecl (Alignment, RawCmmStatics) Instr])
-> NatM
     ([NatBasicBlock Instr],
      [NatCmmDecl (Alignment, RawCmmStatics) Instr])
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Label -> [Instr] -> NatBasicBlock Instr
forall i. Label -> [i] -> GenBasicBlock i
BasicBlock Label
id [Instr]
top NatBasicBlock Instr
-> [NatBasicBlock Instr] -> [NatBasicBlock Instr]
forall a. a -> [a] -> [a]
: [NatBasicBlock Instr]
other_blocks, [NatCmmDecl (Alignment, RawCmmStatics) Instr]
statics)
addSpUnwindings :: Instr -> NatM (OrdList Instr)
addSpUnwindings :: Instr -> NatM (OrdList Instr)
addSpUnwindings instr :: Instr
instr@(DELTA Int
d) = do
    NCGConfig
config <- NatM NCGConfig
getConfig
    if NCGConfig -> Bool
ncgDwarfUnwindings NCGConfig
config
        then do CLabel
lbl <- Unique -> CLabel
forall a. Uniquable a => a -> CLabel
mkAsmTempLabel (Unique -> CLabel) -> NatM Unique -> NatM CLabel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NatM Unique
forall (m :: * -> *). MonadUnique m => m Unique
getUniqueM
                let unwind :: Map GlobalReg (Maybe UnwindExpr)
unwind = GlobalReg -> Maybe UnwindExpr -> Map GlobalReg (Maybe UnwindExpr)
forall k a. k -> a -> Map k a
M.singleton GlobalReg
MachSp (UnwindExpr -> Maybe UnwindExpr
forall a. a -> Maybe a
Just (UnwindExpr -> Maybe UnwindExpr) -> UnwindExpr -> Maybe UnwindExpr
forall a b. (a -> b) -> a -> b
$ GlobalReg -> Int -> UnwindExpr
UwReg GlobalReg
MachSp (Int -> UnwindExpr) -> Int -> UnwindExpr
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Num a => a -> a
negate Int
d)
                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 [ Instr
instr, CLabel -> Map GlobalReg (Maybe UnwindExpr) -> Instr
UNWIND CLabel
lbl Map GlobalReg (Maybe UnwindExpr)
unwind ]
        else 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
instr)
addSpUnwindings Instr
instr = 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
instr
stmtsToInstrs :: BlockId 
              -> [CmmNode O O] 
              -> NatM (InstrBlock, BlockId) 
stmtsToInstrs :: Label -> [CmmNode O O] -> NatM (OrdList Instr, Label)
stmtsToInstrs Label
bid [CmmNode O O]
stmts =
    Label
-> [CmmNode O O] -> OrdList Instr -> NatM (OrdList Instr, Label)
forall {e :: Extensibility} {x :: Extensibility}.
Label
-> [CmmNode e x] -> OrdList Instr -> NatM (OrdList Instr, Label)
go Label
bid [CmmNode O O]
stmts OrdList Instr
forall a. OrdList a
nilOL
  where
    go :: Label
-> [CmmNode e x] -> OrdList Instr -> NatM (OrdList Instr, Label)
go Label
bid  []        OrdList Instr
instrs = (OrdList Instr, Label) -> NatM (OrdList Instr, Label)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr
instrs,Label
bid)
    go Label
bid (CmmNode e x
s:[CmmNode e x]
stmts)  OrdList Instr
instrs = do
      (OrdList Instr
instrs',Maybe Label
bid') <- Label -> CmmNode e x -> NatM (OrdList Instr, Maybe Label)
forall (e :: Extensibility) (x :: Extensibility).
Label -> CmmNode e x -> NatM (OrdList Instr, Maybe Label)
stmtToInstrs Label
bid CmmNode e x
s
      
      let !newBid :: Label
newBid = Label -> Maybe Label -> Label
forall a. a -> Maybe a -> a
fromMaybe Label
bid Maybe Label
bid'
      Label
-> [CmmNode e x] -> OrdList Instr -> NatM (OrdList Instr, Label)
go Label
newBid [CmmNode e x]
stmts (OrdList Instr
instrs OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
instrs')
stmtToInstrs :: BlockId 
             -> CmmNode e x
             -> NatM (InstrBlock, Maybe BlockId)
             
             
stmtToInstrs :: forall (e :: Extensibility) (x :: Extensibility).
Label -> CmmNode e x -> NatM (OrdList Instr, Maybe Label)
stmtToInstrs Label
bid CmmNode e x
stmt = do
  Bool
is32Bit <- NatM Bool
is32BitPlatform
  Platform
platform <- NatM Platform
getPlatform
  case CmmNode e x
stmt of
    CmmUnsafeForeignCall ForeignTarget
target [LocalReg]
result_regs [CmmExpr]
args
       -> ForeignTarget
-> [LocalReg]
-> [CmmExpr]
-> Label
-> NatM (OrdList Instr, Maybe Label)
genForeignCall ForeignTarget
target [LocalReg]
result_regs [CmmExpr]
args Label
bid
    CmmNode e x
_ -> (,Maybe Label
forall a. Maybe a
Nothing) (OrdList Instr -> (OrdList Instr, Maybe Label))
-> NatM (OrdList Instr) -> NatM (OrdList Instr, Maybe Label)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 [(GlobalReg, Maybe CmmExpr)]
regs -> do
        let to_unwind_entry :: (GlobalReg, Maybe CmmExpr) -> UnwindTable
            to_unwind_entry :: (GlobalReg, Maybe CmmExpr) -> Map GlobalReg (Maybe UnwindExpr)
to_unwind_entry (GlobalReg
reg, Maybe CmmExpr
expr) = GlobalReg -> Maybe UnwindExpr -> Map GlobalReg (Maybe UnwindExpr)
forall k a. k -> a -> Map k a
M.singleton GlobalReg
reg ((CmmExpr -> UnwindExpr) -> Maybe CmmExpr -> Maybe UnwindExpr
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Platform -> CmmExpr -> UnwindExpr
toUnwindExpr Platform
platform) Maybe CmmExpr
expr)
        case ((GlobalReg, Maybe CmmExpr) -> Map GlobalReg (Maybe UnwindExpr))
-> [(GlobalReg, Maybe CmmExpr)] -> Map GlobalReg (Maybe UnwindExpr)
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (GlobalReg, Maybe CmmExpr) -> Map GlobalReg (Maybe UnwindExpr)
to_unwind_entry [(GlobalReg, Maybe CmmExpr)]
regs of
          Map GlobalReg (Maybe UnwindExpr)
tbl | Map GlobalReg (Maybe UnwindExpr) -> Bool
forall k a. Map k a -> Bool
M.null Map GlobalReg (Maybe UnwindExpr)
tbl -> 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
              | Bool
otherwise  -> do
                  CLabel
lbl <- Unique -> CLabel
forall a. Uniquable a => a -> CLabel
mkAsmTempLabel (Unique -> CLabel) -> NatM Unique -> NatM CLabel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NatM Unique
forall (m :: * -> *). MonadUnique m => m Unique
getUniqueM
                  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
$ CLabel -> Map GlobalReg (Maybe UnwindExpr) -> Instr
UNWIND CLabel
lbl Map GlobalReg (Maybe UnwindExpr)
tbl
      CmmAssign CmmReg
reg CmmExpr
src
        | CmmType -> Bool
isFloatType CmmType
ty         -> Format -> CmmReg -> CmmExpr -> NatM (OrdList Instr)
assignReg_FltCode Format
format CmmReg
reg CmmExpr
src
        | Bool
is32Bit 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
        | Bool
is32Bit 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
      CmmBranch Label
id          -> 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
$ Label -> OrdList Instr
genBranch Label
id
      
      
      CmmCondBranch CmmExpr
arg Label
true Label
false Maybe Bool
_ -> Label -> Label -> Label -> CmmExpr -> NatM (OrdList Instr)
genCondBranch Label
bid Label
true Label
false CmmExpr
arg
      CmmSwitch CmmExpr
arg SwitchTargets
ids -> CmmExpr -> SwitchTargets -> NatM (OrdList Instr)
genSwitch 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 CondCode
        = CondCode Bool Cond InstrBlock
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 :: LocalReg -> 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 LocalReg
lreg) = LocalReg -> Reg
getLocalRegReg LocalReg
lreg
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) -> RealReg -> Reg
forall a b. (a -> b) -> a -> b
$ 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)
        
        
        
data Amode
        = Amode AddrMode InstrBlock
is32BitInteger :: Integer -> Bool
is32BitInteger :: Integer -> Bool
is32BitInteger Integer
i = Int64
i64 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
0x7fffffff Bool -> Bool -> Bool
&& Int64
i64 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= -Int64
0x80000000
  where i64 :: Int64
i64 = Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Int64
jumpTableEntry :: NCGConfig -> Maybe BlockId -> CmmStatic
jumpTableEntry :: NCGConfig -> Maybe Label -> CmmStatic
jumpTableEntry NCGConfig
config Maybe Label
Nothing = CmmLit -> CmmStatic
CmmStaticLit (Integer -> Width -> CmmLit
CmmInt Integer
0 (NCGConfig -> Width
ncgWordWidth NCGConfig
config))
jumpTableEntry NCGConfig
_ (Just Label
blockid) = CmmLit -> CmmStatic
CmmStaticLit (CLabel -> CmmLit
CmmLabel CLabel
blockLabel)
    where blockLabel :: CLabel
blockLabel = Label -> CLabel
blockLbl Label
blockid
mangleIndexTree :: Platform -> CmmReg -> Int -> CmmExpr
mangleIndexTree :: Platform -> CmmReg -> Int -> CmmExpr
mangleIndexTree Platform
platform 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)
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)
assignMem_I64Code :: CmmExpr -> CmmExpr -> NatM InstrBlock
assignMem_I64Code :: CmmExpr -> CmmExpr -> NatM (OrdList Instr)
assignMem_I64Code CmmExpr
addrTree CmmExpr
valueTree = do
  Amode AddrMode
addr OrdList Instr
addr_code <- CmmExpr -> NatM Amode
getAmode CmmExpr
addrTree
  RegCode64 OrdList Instr
vcode Reg
rhi Reg
rlo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
valueTree
  let
        
        mov_lo :: Instr
mov_lo = Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
rlo) (AddrMode -> Operand
OpAddr AddrMode
addr)
        mov_hi :: Instr
mov_hi = Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
rhi) (AddrMode -> Operand
OpAddr (Maybe AddrMode -> AddrMode
forall a. HasCallStack => Maybe a -> a
fromJust (AddrMode -> Int -> Maybe AddrMode
addrOffset AddrMode
addr Int
4)))
  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 LocalReg
dst) CmmExpr
valueTree = do
   RegCode64 OrdList Instr
vcode Reg
r_src_hi Reg
r_src_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
valueTree
   let
         Reg64 Reg
r_dst_hi Reg
r_dst_lo = (() :: Constraint) => LocalReg -> Reg64
LocalReg -> Reg64
localReg64 LocalReg
dst
         mov_lo :: Instr
mov_lo = Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r_src_lo) (Reg -> Operand
OpReg Reg
r_dst_lo)
         mov_hi :: Instr
mov_hi = Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r_src_hi) (Reg -> Operand
OpReg Reg
r_dst_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(i386): invalid lvalue"
iselExpr64 :: HasDebugCallStack => CmmExpr -> NatM (RegCode64 InstrBlock)
iselExpr64 :: (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 (CmmLit (CmmInt Integer
i Width
_)) = do
  Reg64 Reg
rhi Reg
rlo <- NatM Reg64
getNewReg64
  let
        r :: Integer
r = Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Word32)
        q :: Integer
q = Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word32
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) :: Word32)
        code :: OrdList Instr
code = [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [
                Format -> Operand -> Operand -> Instr
MOV Format
II32 (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
r)) (Reg -> Operand
OpReg Reg
rlo),
                Format -> Operand -> Operand -> Instr
MOV Format
II32 (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
q)) (Reg -> Operand
OpReg Reg
rhi)
                ]
  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 (CmmLoad CmmExpr
addrTree CmmType
ty AlignmentSpec
_) | CmmType -> Bool
isWord64 CmmType
ty = do
   Amode AddrMode
addr OrdList Instr
addr_code <- CmmExpr -> NatM Amode
getAmode CmmExpr
addrTree
   Reg64 Reg
rhi Reg
rlo <- NatM Reg64
getNewReg64
   let
        mov_lo :: Instr
mov_lo = Format -> Operand -> Operand -> Instr
MOV Format
II32 (AddrMode -> Operand
OpAddr AddrMode
addr) (Reg -> Operand
OpReg Reg
rlo)
        mov_hi :: Instr
mov_hi = Format -> Operand -> Operand -> Instr
MOV Format
II32 (AddrMode -> Operand
OpAddr (Maybe AddrMode -> AddrMode
forall a. HasCallStack => Maybe a -> a
fromJust (AddrMode -> Int -> Maybe AddrMode
addrOffset AddrMode
addr Int
4))) (Reg -> Operand
OpReg Reg
rhi)
   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
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 LocalReg
local_reg)) = do
  let Reg64 Reg
hi Reg
lo = (() :: Constraint) => LocalReg -> Reg64
LocalReg -> Reg64
localReg64 LocalReg
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 (CmmMachOp (MO_Add Width
_) [CmmExpr
e1, CmmLit (CmmInt Integer
i Width
_)]) = do
   RegCode64 OrdList Instr
code1 Reg
r1hi Reg
r1lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
e1
   Reg64 Reg
rhi Reg
rlo <- NatM Reg64
getNewReg64
   let
        r :: Integer
r = Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Word32)
        q :: Integer
q = Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word32
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) :: Word32)
        code :: OrdList Instr
code =  OrdList Instr
code1 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 -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r1lo) (Reg -> Operand
OpReg Reg
rlo),
                       Format -> Operand -> Operand -> Instr
ADD Format
II32 (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
r)) (Reg -> Operand
OpReg Reg
rlo),
                       Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r1hi) (Reg -> Operand
OpReg Reg
rhi),
                       Format -> Operand -> Operand -> Instr
ADC Format
II32 (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
q)) (Reg -> Operand
OpReg Reg
rhi) ]
   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 <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
e1
   RegCode64 OrdList Instr
code2 Reg
r2hi Reg
r2lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
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 [ Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r1lo) (Reg -> Operand
OpReg Reg
rlo),
                       Format -> Operand -> Operand -> Instr
ADD Format
II32 (Reg -> Operand
OpReg Reg
r2lo) (Reg -> Operand
OpReg Reg
rlo),
                       Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r1hi) (Reg -> Operand
OpReg Reg
rhi),
                       Format -> Operand -> Operand -> Instr
ADC Format
II32 (Reg -> Operand
OpReg Reg
r2hi) (Reg -> Operand
OpReg Reg
rhi) ]
   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 <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
e1
   RegCode64 OrdList Instr
code2 Reg
r2hi Reg
r2lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
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 [ Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r1lo) (Reg -> Operand
OpReg Reg
rlo),
                       Format -> Operand -> Operand -> Instr
SUB Format
II32 (Reg -> Operand
OpReg Reg
r2lo) (Reg -> Operand
OpReg Reg
rlo),
                       Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r1hi) (Reg -> Operand
OpReg Reg
rhi),
                       Format -> Operand -> Operand -> Instr
SBB Format
II32 (Reg -> Operand
OpReg Reg
r2hi) (Reg -> Operand
OpReg Reg
rhi) ]
   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
_ Width
W64) [CmmExpr
expr]) = do
     Reg -> OrdList Instr
code <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
expr
     Reg64 Reg
r_dst_hi Reg
r_dst_lo <- NatM Reg64
getNewReg64
     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 (Reg -> OrdList Instr
code Reg
r_dst_lo OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
                          Format -> Operand -> Operand -> Instr
MOV Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
0)) (Reg -> Operand
OpReg Reg
r_dst_hi))
                          Reg
r_dst_hi
                          Reg
r_dst_lo
iselExpr64 (CmmMachOp (MO_SS_Conv Width
W32 Width
W64) [CmmExpr
expr]) = do
     Reg -> OrdList Instr
code <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
expr
     Reg64 Reg
r_dst_hi Reg
r_dst_lo <- NatM Reg64
getNewReg64
     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 (Reg -> OrdList Instr
code Reg
r_dst_lo OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
                          Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r_dst_lo) (Reg -> Operand
OpReg Reg
eax) OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
                          Format -> Instr
CLTD Format
II32 OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
                          Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
eax) (Reg -> Operand
OpReg Reg
r_dst_lo) OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
                          Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
edx) (Reg -> Operand
OpReg Reg
r_dst_hi))
                          Reg
r_dst_hi
                          Reg
r_dst_lo
iselExpr64 CmmExpr
expr
   = do
      Platform
platform <- NatM Platform
getPlatform
      String -> SDoc -> NatM (RegCode64 (OrdList Instr))
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"iselExpr64(i386)" (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
expr)
getRegister :: CmmExpr -> NatM Register
getRegister :: CmmExpr -> NatM Register
getRegister CmmExpr
e = do Platform
platform <- NatM Platform
getPlatform
                   Bool
is32Bit <- NatM Bool
is32BitPlatform
                   Platform -> Bool -> CmmExpr -> NatM Register
getRegister' Platform
platform Bool
is32Bit CmmExpr
e
getRegister' :: Platform -> Bool -> CmmExpr -> NatM Register
getRegister' :: Platform -> Bool -> CmmExpr -> NatM Register
getRegister' Platform
platform Bool
is32Bit (CmmReg CmmReg
reg)
  = case CmmReg
reg of
        CmmGlobal GlobalReg
PicBaseReg
         | Bool
is32Bit ->
            
            
            
            do Reg
reg' <- Format -> NatM Reg
getPicBaseNat (Bool -> Format
archWordFormat Bool
is32Bit)
               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 Bool
is32Bit) Reg
reg' OrdList Instr
forall a. OrdList a
nilOL)
        CmmReg
_ ->
            do
               let
                 fmt :: Format
fmt = CmmType -> Format
cmmTypeFormat (Platform -> CmmReg -> CmmType
cmmRegType Platform
platform CmmReg
reg)
                 format :: Format
format  = Format
fmt
               
               Platform
platform <- NCGConfig -> Platform
ncgPlatform (NCGConfig -> Platform) -> NatM NCGConfig -> NatM Platform
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NatM NCGConfig
getConfig
               Register -> NatM Register
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> Reg -> OrdList Instr -> Register
Fixed Format
format
                             (Platform -> CmmReg -> Reg
getRegisterReg Platform
platform CmmReg
reg)
                             OrdList Instr
forall a. OrdList a
nilOL)
getRegister' Platform
platform Bool
is32Bit (CmmRegOff CmmReg
r Int
n)
  = Platform -> Bool -> CmmExpr -> NatM Register
getRegister' Platform
platform Bool
is32Bit (CmmExpr -> NatM Register) -> CmmExpr -> NatM Register
forall a b. (a -> b) -> a -> b
$ Platform -> CmmReg -> Int -> CmmExpr
mangleIndexTree Platform
platform CmmReg
r Int
n
getRegister' Platform
platform Bool
is32Bit (CmmMachOp (MO_AlignmentCheck Int
align Width
_) [CmmExpr
e])
  = Int -> Register -> Register
addAlignmentCheck Int
align (Register -> Register) -> NatM Register -> NatM Register
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Platform -> Bool -> CmmExpr -> NatM Register
getRegister' Platform
platform Bool
is32Bit CmmExpr
e
getRegister' Platform
_ Bool
is32Bit (CmmMachOp (MO_UU_Conv Width
W64 Width
W32)
                     [CmmMachOp (MO_U_Shr Width
W64) [CmmExpr
x,CmmLit (CmmInt Integer
32 Width
_)]])
 | Bool
is32Bit = do
  RegCode64 OrdList Instr
code Reg
rhi Reg
_rlo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
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
rhi OrdList Instr
code
getRegister' Platform
_ Bool
is32Bit (CmmMachOp (MO_SS_Conv Width
W64 Width
W32)
                     [CmmMachOp (MO_U_Shr Width
W64) [CmmExpr
x,CmmLit (CmmInt Integer
32 Width
_)]])
 | Bool
is32Bit = do
  RegCode64 OrdList Instr
code Reg
rhi Reg
_rlo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
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
rhi OrdList Instr
code
getRegister' Platform
_ Bool
is32Bit (CmmMachOp (MO_UU_Conv Width
W64 Width
W32) [CmmExpr
x])
 | Bool
is32Bit = do
  RegCode64 OrdList Instr
code Reg
_rhi Reg
rlo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
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' Platform
_ Bool
is32Bit (CmmMachOp (MO_SS_Conv Width
W64 Width
W32) [CmmExpr
x])
 | Bool
is32Bit = do
  RegCode64 OrdList Instr
code Reg
_rhi Reg
rlo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
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' Platform
_ Bool
_ (CmmLit lit :: CmmLit
lit@(CmmFloat Rational
f Width
w)) =
  NatM Register
float_const_sse2  where
  float_const_sse2 :: NatM Register
float_const_sse2
    | Rational
f Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
0.0 = do
      let
          format :: Format
format = Width -> Format
floatFormat Width
w
          code :: Reg -> OrdList Instr
code Reg
dst = Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL  (Format -> Operand -> Operand -> Instr
XOR Format
format (Reg -> Operand
OpReg Reg
dst) (Reg -> Operand
OpReg 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)
   | Bool
otherwise = do
      Amode AddrMode
addr OrdList Instr
code <- Alignment -> CmmLit -> NatM Amode
memConstant (Int -> Alignment
mkAlignment (Int -> Alignment) -> Int -> Alignment
forall a b. (a -> b) -> a -> b
$ Width -> Int
widthInBytes Width
w) CmmLit
lit
      Width -> AddrMode -> OrdList Instr -> NatM Register
loadFloatAmode Width
w AddrMode
addr OrdList Instr
code
getRegister' Platform
_ Bool
_ (CmmMachOp (MO_UU_Conv Width
W8 Width
W32) [CmmLoad CmmExpr
addr CmmType
_ AlignmentSpec
_]) = do
  Reg -> OrdList Instr
code <- (Operand -> Operand -> Instr)
-> CmmExpr -> NatM (Reg -> OrdList Instr)
intLoadCode (Format -> Operand -> Operand -> Instr
MOVZxL Format
II8) CmmExpr
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
II32 Reg -> OrdList Instr
code)
getRegister' Platform
_ Bool
_ (CmmMachOp (MO_SS_Conv Width
W8 Width
W32) [CmmLoad CmmExpr
addr CmmType
_ AlignmentSpec
_]) = do
  Reg -> OrdList Instr
code <- (Operand -> Operand -> Instr)
-> CmmExpr -> NatM (Reg -> OrdList Instr)
intLoadCode (Format -> Operand -> Operand -> Instr
MOVSxL Format
II8) CmmExpr
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
II32 Reg -> OrdList Instr
code)
getRegister' Platform
_ Bool
_ (CmmMachOp (MO_UU_Conv Width
W16 Width
W32) [CmmLoad CmmExpr
addr CmmType
_ AlignmentSpec
_]) = do
  Reg -> OrdList Instr
code <- (Operand -> Operand -> Instr)
-> CmmExpr -> NatM (Reg -> OrdList Instr)
intLoadCode (Format -> Operand -> Operand -> Instr
MOVZxL Format
II16) CmmExpr
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
II32 Reg -> OrdList Instr
code)
getRegister' Platform
_ Bool
_ (CmmMachOp (MO_SS_Conv Width
W16 Width
W32) [CmmLoad CmmExpr
addr CmmType
_ AlignmentSpec
_]) = do
  Reg -> OrdList Instr
code <- (Operand -> Operand -> Instr)
-> CmmExpr -> NatM (Reg -> OrdList Instr)
intLoadCode (Format -> Operand -> Operand -> Instr
MOVSxL Format
II16) CmmExpr
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
II32 Reg -> OrdList Instr
code)
getRegister' Platform
_ Bool
is32Bit (CmmMachOp (MO_UU_Conv Width
W8 Width
W64) [CmmLoad CmmExpr
addr CmmType
_ AlignmentSpec
_])
 | Bool -> Bool
not Bool
is32Bit = do
  Reg -> OrdList Instr
code <- (Operand -> Operand -> Instr)
-> CmmExpr -> NatM (Reg -> OrdList Instr)
intLoadCode (Format -> Operand -> Operand -> Instr
MOVZxL Format
II8) CmmExpr
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)
getRegister' Platform
_ Bool
is32Bit (CmmMachOp (MO_SS_Conv Width
W8 Width
W64) [CmmLoad CmmExpr
addr CmmType
_ AlignmentSpec
_])
 | Bool -> Bool
not Bool
is32Bit = do
  Reg -> OrdList Instr
code <- (Operand -> Operand -> Instr)
-> CmmExpr -> NatM (Reg -> OrdList Instr)
intLoadCode (Format -> Operand -> Operand -> Instr
MOVSxL Format
II8) CmmExpr
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)
getRegister' Platform
_ Bool
is32Bit (CmmMachOp (MO_UU_Conv Width
W16 Width
W64) [CmmLoad CmmExpr
addr CmmType
_ AlignmentSpec
_])
 | Bool -> Bool
not Bool
is32Bit = do
  Reg -> OrdList Instr
code <- (Operand -> Operand -> Instr)
-> CmmExpr -> NatM (Reg -> OrdList Instr)
intLoadCode (Format -> Operand -> Operand -> Instr
MOVZxL Format
II16) CmmExpr
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)
getRegister' Platform
_ Bool
is32Bit (CmmMachOp (MO_SS_Conv Width
W16 Width
W64) [CmmLoad CmmExpr
addr CmmType
_ AlignmentSpec
_])
 | Bool -> Bool
not Bool
is32Bit = do
  Reg -> OrdList Instr
code <- (Operand -> Operand -> Instr)
-> CmmExpr -> NatM (Reg -> OrdList Instr)
intLoadCode (Format -> Operand -> Operand -> Instr
MOVSxL Format
II16) CmmExpr
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)
getRegister' Platform
_ Bool
is32Bit (CmmMachOp (MO_UU_Conv Width
W32 Width
W64) [CmmLoad CmmExpr
addr CmmType
_ AlignmentSpec
_])
 | Bool -> Bool
not Bool
is32Bit = do
  Reg -> OrdList Instr
code <- (Operand -> Operand -> Instr)
-> CmmExpr -> NatM (Reg -> OrdList Instr)
intLoadCode (Format -> Operand -> Operand -> Instr
MOV Format
II32) CmmExpr
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)
getRegister' Platform
_ Bool
is32Bit (CmmMachOp (MO_SS_Conv Width
W32 Width
W64) [CmmLoad CmmExpr
addr CmmType
_ AlignmentSpec
_])
 | Bool -> Bool
not Bool
is32Bit = do
  Reg -> OrdList Instr
code <- (Operand -> Operand -> Instr)
-> CmmExpr -> NatM (Reg -> OrdList Instr)
intLoadCode (Format -> Operand -> Operand -> Instr
MOVSxL Format
II32) CmmExpr
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)
getRegister' Platform
_ Bool
is32Bit (CmmMachOp (MO_Add Width
W64) [CmmReg (CmmGlobal GlobalReg
PicBaseReg),
                                     CmmLit CmmLit
displacement])
 | Bool -> Bool
not Bool
is32Bit =
      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
Any Format
II64 (\Reg
dst -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$
        Format -> Operand -> Operand -> Instr
LEA Format
II64 (AddrMode -> Operand
OpAddr (Imm -> AddrMode
ripRel (CmmLit -> Imm
litToImm CmmLit
displacement))) (Reg -> Operand
OpReg Reg
dst))
getRegister' Platform
platform Bool
is32Bit (CmmMachOp MachOp
mop [CmmExpr
x]) = 
    case MachOp
mop of
      MO_F_Neg Width
w  -> Width -> CmmExpr -> NatM Register
sse2NegCode Width
w CmmExpr
x
      MO_S_Neg Width
w -> (Format -> Operand -> Instr) -> Format -> NatM Register
triv_ucode Format -> Operand -> Instr
NEGI (Width -> Format
intFormat Width
w)
      MO_Not Width
w   -> (Format -> Operand -> Instr) -> Format -> NatM Register
triv_ucode Format -> Operand -> Instr
NOT  (Width -> Format
intFormat Width
w)
      
      MO_UU_Conv Width
W32 Width
W8  -> Width -> CmmExpr -> NatM Register
toI8Reg  Width
W32 CmmExpr
x
      MO_SS_Conv Width
W32 Width
W8  -> Width -> CmmExpr -> NatM Register
toI8Reg  Width
W32 CmmExpr
x
      MO_XX_Conv Width
W32 Width
W8  -> Width -> CmmExpr -> NatM Register
toI8Reg  Width
W32 CmmExpr
x
      MO_UU_Conv Width
W16 Width
W8  -> Width -> CmmExpr -> NatM Register
toI8Reg  Width
W16 CmmExpr
x
      MO_SS_Conv Width
W16 Width
W8  -> Width -> CmmExpr -> NatM Register
toI8Reg  Width
W16 CmmExpr
x
      MO_XX_Conv Width
W16 Width
W8  -> Width -> CmmExpr -> NatM Register
toI8Reg  Width
W16 CmmExpr
x
      MO_UU_Conv Width
W32 Width
W16 -> Width -> CmmExpr -> NatM Register
toI16Reg Width
W32 CmmExpr
x
      MO_SS_Conv Width
W32 Width
W16 -> Width -> CmmExpr -> NatM Register
toI16Reg Width
W32 CmmExpr
x
      MO_XX_Conv Width
W32 Width
W16 -> Width -> CmmExpr -> NatM Register
toI16Reg Width
W32 CmmExpr
x
      MO_UU_Conv Width
W64 Width
W32 | Bool -> Bool
not Bool
is32Bit -> Format -> CmmExpr -> NatM Register
conversionNop Format
II64 CmmExpr
x
      MO_SS_Conv Width
W64 Width
W32 | Bool -> Bool
not Bool
is32Bit -> Format -> CmmExpr -> NatM Register
conversionNop Format
II64 CmmExpr
x
      MO_XX_Conv Width
W64 Width
W32 | Bool -> Bool
not Bool
is32Bit -> Format -> CmmExpr -> NatM Register
conversionNop Format
II64 CmmExpr
x
      MO_UU_Conv Width
W64 Width
W16 | Bool -> Bool
not Bool
is32Bit -> Width -> CmmExpr -> NatM Register
toI16Reg Width
W64 CmmExpr
x
      MO_SS_Conv Width
W64 Width
W16 | Bool -> Bool
not Bool
is32Bit -> Width -> CmmExpr -> NatM Register
toI16Reg Width
W64 CmmExpr
x
      MO_XX_Conv Width
W64 Width
W16 | Bool -> Bool
not Bool
is32Bit -> Width -> CmmExpr -> NatM Register
toI16Reg Width
W64 CmmExpr
x
      MO_UU_Conv Width
W64 Width
W8  | Bool -> Bool
not Bool
is32Bit -> Width -> CmmExpr -> NatM Register
toI8Reg  Width
W64 CmmExpr
x
      MO_SS_Conv Width
W64 Width
W8  | Bool -> Bool
not Bool
is32Bit -> Width -> CmmExpr -> NatM Register
toI8Reg  Width
W64 CmmExpr
x
      MO_XX_Conv Width
W64 Width
W8  | Bool -> Bool
not Bool
is32Bit -> Width -> CmmExpr -> NatM Register
toI8Reg  Width
W64 CmmExpr
x
      MO_UU_Conv Width
rep1 Width
rep2 | Width
rep1 Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
rep2 -> Format -> CmmExpr -> NatM Register
conversionNop (Width -> Format
intFormat Width
rep1) CmmExpr
x
      MO_SS_Conv Width
rep1 Width
rep2 | Width
rep1 Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
rep2 -> Format -> CmmExpr -> NatM Register
conversionNop (Width -> Format
intFormat Width
rep1) CmmExpr
x
      MO_XX_Conv Width
rep1 Width
rep2 | Width
rep1 Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
rep2 -> Format -> CmmExpr -> NatM Register
conversionNop (Width -> Format
intFormat Width
rep1) CmmExpr
x
      
      MO_UU_Conv Width
W8  Width
W32 -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W8  Width
W32 Format -> Operand -> Operand -> Instr
MOVZxL CmmExpr
x
      MO_UU_Conv Width
W16 Width
W32 -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W16 Width
W32 Format -> Operand -> Operand -> Instr
MOVZxL CmmExpr
x
      MO_UU_Conv Width
W8  Width
W16 -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W8  Width
W16 Format -> Operand -> Operand -> Instr
MOVZxL CmmExpr
x
      MO_SS_Conv Width
W8  Width
W32 -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W8  Width
W32 Format -> Operand -> Operand -> Instr
MOVSxL CmmExpr
x
      MO_SS_Conv Width
W16 Width
W32 -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W16 Width
W32 Format -> Operand -> Operand -> Instr
MOVSxL CmmExpr
x
      MO_SS_Conv Width
W8  Width
W16 -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W8  Width
W16 Format -> Operand -> Operand -> Instr
MOVSxL CmmExpr
x
      
      
      
      MO_XX_Conv Width
W8  Width
W32
          | Bool
is32Bit   -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W8 Width
W32 Format -> Operand -> Operand -> Instr
MOVZxL CmmExpr
x
          | Bool
otherwise -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W8 Width
W32 Format -> Operand -> Operand -> Instr
MOV CmmExpr
x
      MO_XX_Conv Width
W8  Width
W16
          | Bool
is32Bit   -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W8 Width
W16 Format -> Operand -> Operand -> Instr
MOVZxL CmmExpr
x
          | Bool
otherwise -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W8 Width
W16 Format -> Operand -> Operand -> Instr
MOV CmmExpr
x
      MO_XX_Conv Width
W16 Width
W32 -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W16 Width
W32 Format -> Operand -> Operand -> Instr
MOV CmmExpr
x
      MO_UU_Conv Width
W8  Width
W64 | Bool -> Bool
not Bool
is32Bit -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W8  Width
W64 Format -> Operand -> Operand -> Instr
MOVZxL CmmExpr
x
      MO_UU_Conv Width
W16 Width
W64 | Bool -> Bool
not Bool
is32Bit -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W16 Width
W64 Format -> Operand -> Operand -> Instr
MOVZxL CmmExpr
x
      MO_UU_Conv Width
W32 Width
W64 | Bool -> Bool
not Bool
is32Bit -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W32 Width
W64 Format -> Operand -> Operand -> Instr
MOVZxL CmmExpr
x
      MO_SS_Conv Width
W8  Width
W64 | Bool -> Bool
not Bool
is32Bit -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W8  Width
W64 Format -> Operand -> Operand -> Instr
MOVSxL CmmExpr
x
      MO_SS_Conv Width
W16 Width
W64 | Bool -> Bool
not Bool
is32Bit -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W16 Width
W64 Format -> Operand -> Operand -> Instr
MOVSxL CmmExpr
x
      MO_SS_Conv Width
W32 Width
W64 | Bool -> Bool
not Bool
is32Bit -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W32 Width
W64 Format -> Operand -> Operand -> Instr
MOVSxL CmmExpr
x
      
      
      
      
      
      
      MO_XX_Conv Width
W8  Width
W64 | Bool -> Bool
not Bool
is32Bit -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W8  Width
W64 Format -> Operand -> Operand -> Instr
MOV CmmExpr
x
      MO_XX_Conv Width
W16 Width
W64 | Bool -> Bool
not Bool
is32Bit -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W16 Width
W64 Format -> Operand -> Operand -> Instr
MOV CmmExpr
x
      MO_XX_Conv Width
W32 Width
W64 | Bool -> Bool
not Bool
is32Bit -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W32 Width
W64 Format -> Operand -> Operand -> Instr
MOV CmmExpr
x
      MO_FF_Conv Width
W32 Width
W64 -> Width -> CmmExpr -> NatM Register
coerceFP2FP Width
W64 CmmExpr
x
      MO_FF_Conv Width
W64 Width
W32 -> Width -> CmmExpr -> NatM Register
coerceFP2FP Width
W32 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_V_Insert {}   -> NatM Register
forall a. NatM a
needLlvm
      MO_V_Extract {}  -> NatM Register
forall a. NatM a
needLlvm
      MO_V_Add {}      -> NatM Register
forall a. NatM a
needLlvm
      MO_V_Sub {}      -> NatM Register
forall a. NatM a
needLlvm
      MO_V_Mul {}      -> NatM Register
forall a. NatM a
needLlvm
      MO_VS_Quot {}    -> NatM Register
forall a. NatM a
needLlvm
      MO_VS_Rem {}     -> NatM Register
forall a. NatM a
needLlvm
      MO_VS_Neg {}     -> NatM Register
forall a. NatM a
needLlvm
      MO_VU_Quot {}    -> NatM Register
forall a. NatM a
needLlvm
      MO_VU_Rem {}     -> NatM Register
forall a. NatM a
needLlvm
      MO_VF_Insert {}  -> NatM Register
forall a. NatM a
needLlvm
      MO_VF_Extract {} -> NatM Register
forall a. NatM a
needLlvm
      MO_VF_Add {}     -> NatM Register
forall a. NatM a
needLlvm
      MO_VF_Sub {}     -> NatM Register
forall a. NatM a
needLlvm
      MO_VF_Mul {}     -> NatM Register
forall a. NatM a
needLlvm
      MO_VF_Quot {}    -> NatM Register
forall a. NatM a
needLlvm
      MO_VF_Neg {}     -> NatM Register
forall a. NatM a
needLlvm
      MachOp
_other -> String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getRegister" (MachOp -> SDoc
pprMachOp MachOp
mop)
   where
        triv_ucode :: (Format -> Operand -> Instr) -> Format -> NatM Register
        triv_ucode :: (Format -> Operand -> Instr) -> Format -> NatM Register
triv_ucode Format -> Operand -> Instr
instr Format
format = Format -> (Operand -> Instr) -> CmmExpr -> NatM Register
trivialUCode Format
format (Format -> Operand -> Instr
instr Format
format) CmmExpr
x
        
        integerExtend :: Width -> Width
                      -> (Format -> Operand -> Operand -> Instr)
                      -> CmmExpr -> NatM Register
        integerExtend :: Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
from Width
to Format -> Operand -> Operand -> Instr
instr CmmExpr
expr = do
            (Reg
reg,OrdList Instr
e_code) <- if Width
from Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W8 then CmmExpr -> NatM (Reg, OrdList Instr)
getByteReg CmmExpr
expr
                                          else CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
expr
            let
                code :: Reg -> OrdList Instr
code Reg
dst =
                  OrdList Instr
e_code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
                  Format -> Operand -> Operand -> Instr
instr (Width -> Format
intFormat Width
from) (Reg -> Operand
OpReg Reg
reg) (Reg -> Operand
OpReg 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 (Width -> Format
intFormat Width
to) Reg -> OrdList Instr
code)
        toI8Reg :: Width -> CmmExpr -> NatM Register
        toI8Reg :: Width -> CmmExpr -> NatM Register
toI8Reg Width
new_rep CmmExpr
expr
            = do Reg -> OrdList Instr
codefn <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
expr
                 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
new_rep) Reg -> OrdList Instr
codefn)
                
                
                
                
                
                
        toI16Reg :: Width -> CmmExpr -> NatM Register
toI16Reg = Width -> CmmExpr -> NatM Register
toI8Reg 
        conversionNop :: Format -> CmmExpr -> NatM Register
        conversionNop :: Format -> CmmExpr -> NatM Register
conversionNop Format
new_format CmmExpr
expr
            = do Register
e_code <- Platform -> Bool -> CmmExpr -> NatM Register
getRegister' Platform
platform Bool
is32Bit 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)
getRegister' Platform
_ Bool
is32Bit (CmmMachOp MachOp
mop [CmmExpr
x, CmmExpr
y]) = 
  case MachOp
mop of
      MO_F_Eq Width
_ -> Bool -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condFltReg Bool
is32Bit Cond
EQQ CmmExpr
x CmmExpr
y
      MO_F_Ne Width
_ -> Bool -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condFltReg Bool
is32Bit Cond
NE  CmmExpr
x CmmExpr
y
      MO_F_Gt Width
_ -> Bool -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condFltReg Bool
is32Bit Cond
GTT CmmExpr
x CmmExpr
y
      MO_F_Ge Width
_ -> Bool -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condFltReg Bool
is32Bit Cond
GE  CmmExpr
x CmmExpr
y
      
      
      MO_F_Lt Width
_ -> Bool -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condFltReg Bool
is32Bit Cond
GTT  CmmExpr
y CmmExpr
x
      MO_F_Le Width
_ -> Bool -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condFltReg Bool
is32Bit Cond
GE   CmmExpr
y CmmExpr
x
      MO_Eq Width
_   -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condIntReg Cond
EQQ CmmExpr
x CmmExpr
y
      MO_Ne Width
_   -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condIntReg Cond
NE  CmmExpr
x CmmExpr
y
      MO_S_Gt Width
_ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condIntReg Cond
GTT CmmExpr
x CmmExpr
y
      MO_S_Ge Width
_ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condIntReg Cond
GE  CmmExpr
x CmmExpr
y
      MO_S_Lt Width
_ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condIntReg Cond
LTT CmmExpr
x CmmExpr
y
      MO_S_Le Width
_ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condIntReg Cond
LE  CmmExpr
x CmmExpr
y
      MO_U_Gt Width
_ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condIntReg Cond
GU  CmmExpr
x CmmExpr
y
      MO_U_Ge Width
_ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condIntReg Cond
GEU CmmExpr
x CmmExpr
y
      MO_U_Lt Width
_ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condIntReg Cond
LU  CmmExpr
x CmmExpr
y
      MO_U_Le Width
_ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condIntReg Cond
LEU CmmExpr
x CmmExpr
y
      MO_F_Add Width
w   -> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialFCode_sse2 Width
w Format -> Operand -> Operand -> Instr
ADD  CmmExpr
x CmmExpr
y
      MO_F_Sub Width
w   -> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialFCode_sse2 Width
w Format -> Operand -> Operand -> Instr
SUB  CmmExpr
x CmmExpr
y
      MO_F_Quot Width
w  -> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialFCode_sse2 Width
w Format -> Operand -> Operand -> Instr
FDIV CmmExpr
x CmmExpr
y
      MO_F_Mul Width
w   -> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialFCode_sse2 Width
w Format -> Operand -> Operand -> Instr
MUL CmmExpr
x CmmExpr
y
      MO_Add Width
rep -> Width -> CmmExpr -> CmmExpr -> NatM Register
add_code Width
rep CmmExpr
x CmmExpr
y
      MO_Sub Width
rep -> Width -> CmmExpr -> CmmExpr -> NatM Register
sub_code Width
rep CmmExpr
x CmmExpr
y
      MO_S_Quot Width
rep -> Width -> Bool -> Bool -> CmmExpr -> CmmExpr -> NatM Register
div_code Width
rep Bool
True  Bool
True  CmmExpr
x CmmExpr
y
      MO_S_Rem  Width
rep -> Width -> Bool -> Bool -> CmmExpr -> CmmExpr -> NatM Register
div_code Width
rep Bool
True  Bool
False CmmExpr
x CmmExpr
y
      MO_U_Quot Width
rep -> Width -> Bool -> Bool -> CmmExpr -> CmmExpr -> NatM Register
div_code Width
rep Bool
False Bool
True  CmmExpr
x CmmExpr
y
      MO_U_Rem  Width
rep -> Width -> Bool -> Bool -> CmmExpr -> CmmExpr -> NatM Register
div_code Width
rep Bool
False Bool
False CmmExpr
x CmmExpr
y
      MO_S_MulMayOflo Width
rep -> Width -> CmmExpr -> CmmExpr -> NatM Register
imulMayOflo Width
rep CmmExpr
x CmmExpr
y
      MO_Mul Width
W8  -> CmmExpr -> CmmExpr -> NatM Register
imulW8 CmmExpr
x CmmExpr
y
      MO_Mul Width
rep -> Width -> (Format -> Operand -> Operand -> Instr) -> NatM Register
triv_op Width
rep Format -> Operand -> Operand -> Instr
IMUL
      MO_And Width
rep -> Width -> (Format -> Operand -> Operand -> Instr) -> NatM Register
triv_op Width
rep Format -> Operand -> Operand -> Instr
AND
      MO_Or  Width
rep -> Width -> (Format -> Operand -> Operand -> Instr) -> NatM Register
triv_op Width
rep Format -> Operand -> Operand -> Instr
OR
      MO_Xor Width
rep -> Width -> (Format -> Operand -> Operand -> Instr) -> NatM Register
triv_op Width
rep Format -> Operand -> Operand -> Instr
XOR
        
      MO_Shl Width
rep   -> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
shift_code Width
rep Format -> Operand -> Operand -> Instr
SHL CmmExpr
x CmmExpr
y 
      MO_U_Shr Width
rep -> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
shift_code Width
rep Format -> Operand -> Operand -> Instr
SHR CmmExpr
x CmmExpr
y 
      MO_S_Shr Width
rep -> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
shift_code Width
rep Format -> Operand -> Operand -> Instr
SAR CmmExpr
x CmmExpr
y 
      MO_V_Insert {}   -> NatM Register
forall a. NatM a
needLlvm
      MO_V_Extract {}  -> NatM Register
forall a. NatM a
needLlvm
      MO_V_Add {}      -> NatM Register
forall a. NatM a
needLlvm
      MO_V_Sub {}      -> NatM Register
forall a. NatM a
needLlvm
      MO_V_Mul {}      -> NatM Register
forall a. NatM a
needLlvm
      MO_VS_Quot {}    -> NatM Register
forall a. NatM a
needLlvm
      MO_VS_Rem {}     -> NatM Register
forall a. NatM a
needLlvm
      MO_VS_Neg {}     -> NatM Register
forall a. NatM a
needLlvm
      MO_VF_Insert {}  -> NatM Register
forall a. NatM a
needLlvm
      MO_VF_Extract {} -> NatM Register
forall a. NatM a
needLlvm
      MO_VF_Add {}     -> NatM Register
forall a. NatM a
needLlvm
      MO_VF_Sub {}     -> NatM Register
forall a. NatM a
needLlvm
      MO_VF_Mul {}     -> NatM Register
forall a. NatM a
needLlvm
      MO_VF_Quot {}    -> NatM Register
forall a. NatM a
needLlvm
      MO_VF_Neg {}     -> NatM Register
forall a. NatM a
needLlvm
      MachOp
_other -> String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getRegister(x86) - binary CmmMachOp (1)" (MachOp -> SDoc
pprMachOp MachOp
mop)
  where
    
    triv_op :: Width -> (Format -> Operand -> Operand -> Instr) -> NatM Register
triv_op Width
width Format -> Operand -> Operand -> Instr
instr = Width
-> (Operand -> Operand -> Instr)
-> Maybe (Operand -> Operand -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialCode Width
width Operand -> Operand -> Instr
op ((Operand -> Operand -> Instr)
-> Maybe (Operand -> Operand -> Instr)
forall a. a -> Maybe a
Just Operand -> Operand -> Instr
op) CmmExpr
x CmmExpr
y
                        where op :: Operand -> Operand -> Instr
op   = Format -> Operand -> Operand -> Instr
instr (Width -> Format
intFormat Width
width)
    
    
    
    imulW8 :: CmmExpr -> CmmExpr -> NatM Register
    imulW8 :: CmmExpr -> CmmExpr -> NatM Register
imulW8 CmmExpr
arg_a CmmExpr
arg_b = do
        (Reg
a_reg, OrdList Instr
a_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getNonClobberedReg CmmExpr
arg_a
        Reg -> OrdList Instr
b_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
arg_b
        let code :: OrdList Instr
code = OrdList Instr
a_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Reg -> OrdList Instr
b_code Reg
eax 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 -> Operand -> Instr
IMUL2 Format
format (Reg -> Operand
OpReg Reg
a_reg) ]
            format :: Format
format = Width -> Format
intFormat Width
W8
        Register -> NatM Register
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> Reg -> OrdList Instr -> Register
Fixed Format
format Reg
eax OrdList Instr
code)
    imulMayOflo :: Width -> CmmExpr -> CmmExpr -> NatM Register
    imulMayOflo :: Width -> CmmExpr -> CmmExpr -> NatM Register
imulMayOflo Width
rep CmmExpr
a CmmExpr
b = do
         (Reg
a_reg, OrdList Instr
a_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getNonClobberedReg CmmExpr
a
         Reg -> OrdList Instr
b_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
b
         let
             shift_amt :: Int
shift_amt  = case Width
rep of
                           Width
W32 -> Int
31
                           Width
W64 -> Int
63
                           Width
_ -> String -> Int
forall a. String -> a
panic String
"shift_amt"
             format :: Format
format = Width -> Format
intFormat Width
rep
             code :: OrdList Instr
code = OrdList Instr
a_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Reg -> OrdList Instr
b_code Reg
eax 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 -> Operand -> Instr
IMUL2 Format
format (Reg -> Operand
OpReg Reg
a_reg),   
                           Format -> Operand -> Operand -> Instr
SAR Format
format (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
shift_amt)) (Reg -> Operand
OpReg Reg
eax),
                                
                           Format -> Operand -> Operand -> Instr
SUB Format
format (Reg -> Operand
OpReg Reg
edx) (Reg -> Operand
OpReg Reg
eax)
                                
                           
                        ]
         Register -> NatM Register
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> Reg -> OrdList Instr -> Register
Fixed Format
format Reg
eax OrdList Instr
code)
    
    shift_code :: Width
               -> (Format -> Operand -> Operand -> Instr)
               -> CmmExpr
               -> CmmExpr
               -> NatM Register
    
    shift_code :: Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
shift_code Width
width Format -> Operand -> Operand -> Instr
instr CmmExpr
x (CmmLit CmmLit
lit)
      
      
      
      
      | CmmInt Integer
n Width
_ <- CmmLit
lit
      , Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Width -> Int
widthInBits Width
width)
      = CmmExpr -> NatM Register
getRegister (CmmExpr -> NatM Register) -> CmmExpr -> NatM Register
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt Integer
0 Width
width
      | Bool
otherwise = do
          Reg -> OrdList Instr
x_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
x
          let
               format :: Format
format = Width -> Format
intFormat Width
width
               code :: Reg -> OrdList Instr
code Reg
dst
                  = Reg -> OrdList Instr
x_code Reg
dst OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
                    Format -> Operand -> Operand -> Instr
instr Format
format (Imm -> Operand
OpImm (CmmLit -> Imm
litToImm CmmLit
lit)) (Reg -> Operand
OpReg 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)
    
    shift_code Width
width Format -> Operand -> Operand -> Instr
instr CmmExpr
x CmmExpr
y = do
        Reg -> OrdList Instr
x_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
x
        let format :: Format
format = Width -> Format
intFormat Width
width
        Reg
tmp <- Format -> NatM Reg
getNewRegNat Format
format
        Reg -> OrdList Instr
y_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
y
        let
           code :: OrdList Instr
code = Reg -> OrdList Instr
x_code Reg
tmp OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                  Reg -> OrdList Instr
y_code Reg
ecx OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
                  Format -> Operand -> Operand -> Instr
instr Format
format (Reg -> Operand
OpReg Reg
ecx) (Reg -> Operand
OpReg Reg
tmp)
        Register -> NatM Register
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> Reg -> OrdList Instr -> Register
Fixed Format
format Reg
tmp OrdList Instr
code)
    
    add_code :: Width -> CmmExpr -> CmmExpr -> NatM Register
    add_code :: Width -> CmmExpr -> CmmExpr -> NatM Register
add_code Width
rep CmmExpr
x (CmmLit (CmmInt Integer
y Width
_))
        | Integer -> Bool
is32BitInteger Integer
y
        , Width
rep Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
/= Width
W8 
        = Width -> CmmExpr -> Integer -> NatM Register
add_int Width
rep CmmExpr
x Integer
y
    add_code Width
rep CmmExpr
x CmmExpr
y = Width
-> (Operand -> Operand -> Instr)
-> Maybe (Operand -> Operand -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialCode Width
rep (Format -> Operand -> Operand -> Instr
ADD Format
format) ((Operand -> Operand -> Instr)
-> Maybe (Operand -> Operand -> Instr)
forall a. a -> Maybe a
Just (Format -> Operand -> Operand -> Instr
ADD Format
format)) CmmExpr
x CmmExpr
y
      where format :: Format
format = Width -> Format
intFormat Width
rep
    
    
    
    sub_code :: Width -> CmmExpr -> CmmExpr -> NatM Register
    sub_code :: Width -> CmmExpr -> CmmExpr -> NatM Register
sub_code Width
rep CmmExpr
x (CmmLit (CmmInt Integer
y Width
_))
        | Integer -> Bool
is32BitInteger (-Integer
y)
        , Width
rep Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
/= Width
W8 
        = Width -> CmmExpr -> Integer -> NatM Register
add_int Width
rep CmmExpr
x (-Integer
y)
    sub_code Width
rep CmmExpr
x CmmExpr
y = Width
-> (Operand -> Operand -> Instr)
-> Maybe (Operand -> Operand -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialCode Width
rep (Format -> Operand -> Operand -> Instr
SUB (Width -> Format
intFormat Width
rep)) Maybe (Operand -> Operand -> Instr)
forall a. Maybe a
Nothing CmmExpr
x CmmExpr
y
    
    add_int :: Width -> CmmExpr -> Integer -> NatM Register
add_int Width
width CmmExpr
x Integer
y = do
        (Reg
x_reg, OrdList Instr
x_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
x
        let
            format :: Format
format = Width -> Format
intFormat Width
width
            imm :: Imm
imm = Int -> Imm
ImmInt (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
y)
            code :: Reg -> OrdList Instr
code Reg
dst
               = OrdList Instr
x_code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
                 Format -> Operand -> Operand -> Instr
LEA Format
format
                        (AddrMode -> Operand
OpAddr (EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex (Reg -> EABase
EABaseReg Reg
x_reg) EAIndex
EAIndexNone Imm
imm))
                        (Reg -> Operand
OpReg 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)
    
    
    div_code :: Width -> Bool -> Bool -> CmmExpr -> CmmExpr -> NatM Register
div_code Width
W8 Bool
signed Bool
quotient CmmExpr
x CmmExpr
y = do
        let widen :: MachOp
widen | Bool
signed    = Width -> Width -> MachOp
MO_SS_Conv Width
W8 Width
W16
                  | Bool
otherwise = Width -> Width -> MachOp
MO_UU_Conv Width
W8 Width
W16
        Width -> Bool -> Bool -> CmmExpr -> CmmExpr -> NatM Register
div_code
            Width
W16
            Bool
signed
            Bool
quotient
            (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp MachOp
widen [CmmExpr
x])
            (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp MachOp
widen [CmmExpr
y])
    div_code Width
width Bool
signed Bool
quotient CmmExpr
x CmmExpr
y = do
           (Operand
y_op, OrdList Instr
y_code) <- CmmExpr -> NatM (Operand, OrdList Instr)
getRegOrMem CmmExpr
y 
           Reg -> OrdList Instr
x_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
x
           let
             format :: Format
format = Width -> Format
intFormat Width
width
             widen :: Instr
widen | Bool
signed    = Format -> Instr
CLTD Format
format
                   | Bool
otherwise = Format -> Operand -> Operand -> Instr
XOR Format
format (Reg -> Operand
OpReg Reg
edx) (Reg -> Operand
OpReg Reg
edx)
             instr :: Format -> Operand -> Instr
instr | Bool
signed    = Format -> Operand -> Instr
IDIV
                   | Bool
otherwise = Format -> Operand -> Instr
DIV
             code :: OrdList Instr
code = OrdList Instr
y_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                    Reg -> OrdList Instr
x_code Reg
eax 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
widen, Format -> Operand -> Instr
instr Format
format Operand
y_op]
             result :: Reg
result | Bool
quotient  = Reg
eax
                    | Bool
otherwise = Reg
edx
           Register -> NatM Register
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> Reg -> OrdList Instr -> Register
Fixed Format
format Reg
result OrdList Instr
code)
getRegister' Platform
_ Bool
_ (CmmLoad CmmExpr
mem CmmType
pk AlignmentSpec
_)
  | CmmType -> Bool
isFloatType CmmType
pk
  = do
    Amode AddrMode
addr OrdList Instr
mem_code <- CmmExpr -> NatM Amode
getAmode CmmExpr
mem
    Width -> AddrMode -> OrdList Instr -> NatM Register
loadFloatAmode  (CmmType -> Width
typeWidth CmmType
pk) AddrMode
addr OrdList Instr
mem_code
getRegister' Platform
_ Bool
is32Bit (CmmLoad CmmExpr
mem CmmType
pk AlignmentSpec
_)
  | Bool
is32Bit Bool -> Bool -> Bool
&& Bool -> Bool
not (CmmType -> Bool
isWord64 CmmType
pk)
  = do
    Reg -> OrdList Instr
code <- (Operand -> Operand -> Instr)
-> CmmExpr -> NatM (Reg -> OrdList Instr)
intLoadCode Operand -> Operand -> Instr
instr 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
format Reg -> OrdList Instr
code)
  where
    width :: Width
width = CmmType -> Width
typeWidth CmmType
pk
    format :: Format
format = Width -> Format
intFormat Width
width
    instr :: Operand -> Operand -> Instr
instr = case Width
width of
                Width
W8     -> Format -> Operand -> Operand -> Instr
MOVZxL Format
II8
                Width
_other -> Format -> Operand -> Operand -> Instr
MOV Format
format
        
        
        
        
        
getRegister' Platform
_ Bool
is32Bit (CmmLoad CmmExpr
mem CmmType
pk AlignmentSpec
_)
 | Bool -> Bool
not Bool
is32Bit
  = do
    Reg -> OrdList Instr
code <- (Operand -> Operand -> Instr)
-> CmmExpr -> NatM (Reg -> OrdList Instr)
intLoadCode (Format -> Operand -> Operand -> Instr
MOV Format
format) 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
format Reg -> OrdList Instr
code)
  where format :: Format
format = Width -> Format
intFormat (Width -> Format) -> Width -> Format
forall a b. (a -> b) -> a -> b
$ CmmType -> Width
typeWidth CmmType
pk
getRegister' Platform
_ Bool
is32Bit (CmmLit (CmmInt Integer
0 Width
width))
  = let
        format :: Format
format = Width -> Format
intFormat Width
width
        
        format1 :: Format
format1 = if Bool
is32Bit then Format
format
                           else case Format
format of
                                Format
II64 -> Format
II32
                                Format
_ -> Format
format
        code :: Reg -> OrdList Instr
code Reg
dst
           = Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
XOR Format
format1 (Reg -> Operand
OpReg Reg
dst) (Reg -> Operand
OpReg Reg
dst))
    in
        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' Platform
platform Bool
is32Bit (CmmLit CmmLit
lit)
  | CmmLit -> Bool
is_label CmmLit
lit
  , Bool -> Bool
not Bool
is32Bit
  = do let format :: Format
format = CmmType -> Format
cmmTypeFormat (Platform -> CmmLit -> CmmType
cmmLitType Platform
platform CmmLit
lit)
           imm :: Imm
imm = CmmLit -> Imm
litToImm CmmLit
lit
           op :: Operand
op = AddrMode -> Operand
OpAddr (EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex EABase
EABaseRip EAIndex
EAIndexNone Imm
imm)
           code :: Reg -> OrdList Instr
code Reg
dst = Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
LEA Format
format Operand
op (Reg -> Operand
OpReg 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)
  where
    is_label :: CmmLit -> Bool
is_label (CmmLabel {})        = Bool
True
    is_label (CmmLabelOff {})     = Bool
True
    is_label (CmmLabelDiffOff {}) = Bool
True
    is_label CmmLit
_                    = Bool
False
  
  
  
getRegister' Platform
platform Bool
is32Bit (CmmLit CmmLit
lit)
  | Bool -> Bool
not Bool
is32Bit, CmmType -> Bool
isWord64 (Platform -> CmmLit -> CmmType
cmmLitType Platform
platform CmmLit
lit), Bool -> Bool
not (CmmLit -> Bool
isBigLit CmmLit
lit)
  = let
        imm :: Imm
imm = CmmLit -> Imm
litToImm CmmLit
lit
        code :: Reg -> OrdList Instr
code Reg
dst = Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOV Format
II32 (Imm -> Operand
OpImm Imm
imm) (Reg -> Operand
OpReg Reg
dst))
    in
        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
   isBigLit :: CmmLit -> Bool
isBigLit (CmmInt Integer
i Width
_) = Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
|| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0xffffffff
   isBigLit CmmLit
_ = Bool
False
        
        
        
        
        
getRegister' Platform
platform Bool
_ (CmmLit CmmLit
lit)
  = do let format :: Format
format = CmmType -> Format
cmmTypeFormat (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
unitOL (Format -> Operand -> Operand -> Instr
MOV Format
format (Imm -> Operand
OpImm Imm
imm) (Reg -> Operand
OpReg 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)
getRegister' Platform
platform Bool
_ CmmExpr
other
    | CmmExpr -> Bool
isVecExpr CmmExpr
other  = NatM Register
forall a. NatM a
needLlvm
    | Bool
otherwise        = String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getRegister(x86)" (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
other)
intLoadCode :: (Operand -> Operand -> Instr) -> CmmExpr
   -> NatM (Reg -> InstrBlock)
intLoadCode :: (Operand -> Operand -> Instr)
-> CmmExpr -> NatM (Reg -> OrdList Instr)
intLoadCode Operand -> Operand -> Instr
instr CmmExpr
mem = do
  Amode AddrMode
src OrdList Instr
mem_code <- CmmExpr -> NatM Amode
getAmode CmmExpr
mem
  (Reg -> OrdList Instr) -> NatM (Reg -> OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (\Reg
dst -> OrdList Instr
mem_code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Operand -> Operand -> Instr
instr (AddrMode -> Operand
OpAddr AddrMode
src) (Reg -> Operand
OpReg Reg
dst))
getAnyReg :: CmmExpr -> NatM (Reg -> InstrBlock)
getAnyReg :: CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
expr = do
  Register
r <- CmmExpr -> NatM Register
getRegister CmmExpr
expr
  Register -> NatM (Reg -> OrdList Instr)
anyReg Register
r
anyReg :: Register -> NatM (Reg -> InstrBlock)
anyReg :: Register -> NatM (Reg -> OrdList Instr)
anyReg (Any Format
_ 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 -> OrdList Instr
code
anyReg (Fixed Format
rep Reg
reg OrdList Instr
fcode) = (Reg -> OrdList Instr) -> NatM (Reg -> OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (\Reg
dst -> OrdList Instr
fcode OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> Reg -> Instr
reg2reg Format
rep Reg
reg Reg
dst)
getByteReg :: CmmExpr -> NatM (Reg, InstrBlock)
getByteReg :: CmmExpr -> NatM (Reg, OrdList Instr)
getByteReg CmmExpr
expr = do
  Bool
is32Bit <- NatM Bool
is32BitPlatform
  if Bool
is32Bit
      then 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
rep Reg
reg OrdList Instr
code
                    | Reg -> Bool
isVirtualReg Reg
reg -> (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)
                    | Bool
otherwise -> 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, OrdList Instr
code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> Reg -> Instr
reg2reg Format
rep Reg
reg Reg
tmp)
                    
                    
                    
      else CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
expr 
getNonClobberedReg :: CmmExpr -> NatM (Reg, InstrBlock)
getNonClobberedReg :: CmmExpr -> NatM (Reg, OrdList Instr)
getNonClobberedReg CmmExpr
expr = do
  Register
r <- CmmExpr -> NatM Register
getRegister CmmExpr
expr
  Platform
platform <- NCGConfig -> Platform
ncgPlatform (NCGConfig -> Platform) -> NatM NCGConfig -> NatM Platform
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NatM NCGConfig
getConfig
  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
rep Reg
reg OrdList Instr
code
        
        | Reg
reg Reg -> [Reg] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Platform -> [Reg]
instrClobberedRegs Platform
platform
        -> 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, OrdList Instr
code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> Reg -> Instr
reg2reg Format
rep Reg
reg Reg
tmp)
        | Bool
otherwise ->
                (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)
reg2reg :: Format -> Reg -> Reg -> Instr
reg2reg :: Format -> Reg -> Reg -> Instr
reg2reg Format
format Reg
src Reg
dst = Format -> Operand -> Operand -> Instr
MOV Format
format (Reg -> Operand
OpReg Reg
src) (Reg -> Operand
OpReg Reg
dst)
getAmode :: CmmExpr -> NatM Amode
getAmode :: CmmExpr -> NatM Amode
getAmode CmmExpr
e = do
   Platform
platform <- NatM Platform
getPlatform
   let is32Bit :: Bool
is32Bit = Platform -> Bool
target32Bit Platform
platform
   case CmmExpr
e of
      CmmRegOff CmmReg
r Int
n
         -> CmmExpr -> NatM Amode
getAmode (CmmExpr -> NatM Amode) -> CmmExpr -> NatM Amode
forall a b. (a -> b) -> a -> b
$ Platform -> CmmReg -> Int -> CmmExpr
mangleIndexTree Platform
platform CmmReg
r Int
n
      CmmMachOp (MO_Add Width
W64) [CmmReg (CmmGlobal GlobalReg
PicBaseReg), CmmLit CmmLit
displacement]
         | Bool -> Bool
not Bool
is32Bit
         -> Amode -> NatM Amode
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Amode -> NatM Amode) -> Amode -> NatM Amode
forall a b. (a -> b) -> a -> b
$ AddrMode -> OrdList Instr -> Amode
Amode (Imm -> AddrMode
ripRel (CmmLit -> Imm
litToImm CmmLit
displacement)) OrdList Instr
forall a. OrdList a
nilOL
      
      
      CmmMachOp (MO_Sub Width
_rep) [CmmExpr
x, CmmLit lit :: CmmLit
lit@(CmmInt Integer
i Width
_)]
         | Platform -> CmmLit -> Bool
is32BitLit Platform
platform CmmLit
lit
         
         -> do
            (Reg
x_reg, OrdList Instr
x_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
x
            let off :: Imm
off = Int -> Imm
ImmInt (-(Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i))
            Amode -> NatM Amode
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (AddrMode -> OrdList Instr -> Amode
Amode (EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex (Reg -> EABase
EABaseReg Reg
x_reg) EAIndex
EAIndexNone Imm
off) OrdList Instr
x_code)
      CmmMachOp (MO_Add Width
_rep) [CmmExpr
x, CmmLit CmmLit
lit]
         | Platform -> CmmLit -> Bool
is32BitLit Platform
platform CmmLit
lit
         
         -> do
            (Reg
x_reg, OrdList Instr
x_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
x
            let off :: Imm
off = CmmLit -> Imm
litToImm CmmLit
lit
            Amode -> NatM Amode
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (AddrMode -> OrdList Instr -> Amode
Amode (EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex (Reg -> EABase
EABaseReg Reg
x_reg) EAIndex
EAIndexNone Imm
off) OrdList Instr
x_code)
      
      
      CmmMachOp (MO_Add Width
rep) [a :: CmmExpr
a@(CmmMachOp (MO_Shl Width
_) [CmmExpr]
_), b :: CmmExpr
b@(CmmLit CmmLit
_)]
         -> CmmExpr -> NatM Amode
getAmode (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Add Width
rep) [CmmExpr
b,CmmExpr
a])
      
      CmmMachOp (MO_Add Width
_) [CmmRegOff CmmReg
x Int
offset, CmmMachOp (MO_Shl Width
_) [CmmExpr
y, CmmLit (CmmInt Integer
shift Width
_)]]
         | Integer
shift Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 Bool -> Bool -> Bool
|| Integer
shift Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 Bool -> Bool -> Bool
|| Integer
shift Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
2 Bool -> Bool -> Bool
|| Integer
shift Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
3
         -> CmmExpr -> CmmExpr -> Integer -> Integer -> NatM Amode
x86_complex_amode (CmmReg -> CmmExpr
CmmReg CmmReg
x) CmmExpr
y Integer
shift (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offset)
      CmmMachOp (MO_Add Width
_) [CmmExpr
x, CmmMachOp (MO_Shl Width
_) [CmmExpr
y, CmmLit (CmmInt Integer
shift Width
_)]]
         | Integer
shift Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 Bool -> Bool -> Bool
|| Integer
shift Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 Bool -> Bool -> Bool
|| Integer
shift Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
2 Bool -> Bool -> Bool
|| Integer
shift Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
3
         -> CmmExpr -> CmmExpr -> Integer -> Integer -> NatM Amode
x86_complex_amode CmmExpr
x CmmExpr
y Integer
shift Integer
0
      CmmMachOp (MO_Add Width
_) [CmmExpr
x, CmmMachOp (MO_Add Width
_) [CmmMachOp (MO_Shl Width
_)
                                                    [CmmExpr
y, CmmLit (CmmInt Integer
shift Width
_)], CmmLit (CmmInt Integer
offset Width
_)]]
         | Integer
shift Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 Bool -> Bool -> Bool
|| Integer
shift Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 Bool -> Bool -> Bool
|| Integer
shift Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
2 Bool -> Bool -> Bool
|| Integer
shift Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
3
         Bool -> Bool -> Bool
&& Integer -> Bool
is32BitInteger Integer
offset
         -> CmmExpr -> CmmExpr -> Integer -> Integer -> NatM Amode
x86_complex_amode CmmExpr
x CmmExpr
y Integer
shift Integer
offset
      CmmMachOp (MO_Add Width
_) [CmmExpr
x,CmmExpr
y]
         | Bool -> Bool
not (CmmExpr -> Bool
isLit CmmExpr
y) 
         -> CmmExpr -> CmmExpr -> Integer -> Integer -> NatM Amode
x86_complex_amode CmmExpr
x CmmExpr
y Integer
0 Integer
0
      
      
      
      CmmLit CmmLit
lit
         | Bool -> Bool
not Bool
is32Bit
         , CmmLit -> Bool
is_label CmmLit
lit
         -> Amode -> NatM Amode
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (AddrMode -> OrdList Instr -> Amode
Amode (EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex EABase
EABaseRip EAIndex
EAIndexNone (CmmLit -> Imm
litToImm CmmLit
lit)) OrdList Instr
forall a. OrdList a
nilOL)
      CmmLit CmmLit
lit
         | Platform -> CmmLit -> Bool
is32BitLit Platform
platform CmmLit
lit
         -> Amode -> NatM Amode
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (AddrMode -> OrdList Instr -> Amode
Amode (Imm -> Int -> AddrMode
ImmAddr (CmmLit -> Imm
litToImm CmmLit
lit) Int
0) OrdList Instr
forall a. OrdList a
nilOL)
      
      
      
      CmmLit (CmmLabelOff CLabel
l Int
off)
         -> CmmExpr -> NatM Amode
getAmode (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Add Width
W64) [ CmmLit -> CmmExpr
CmmLit (CLabel -> CmmLit
CmmLabel CLabel
l)
                                             , CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off) Width
W64)
                                             ])
      CmmLit (CmmLabelDiffOff CLabel
l1 CLabel
l2 Int
off Width
w)
         -> CmmExpr -> NatM Amode
getAmode (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Add Width
W64) [ CmmLit -> CmmExpr
CmmLit (CLabel -> CLabel -> Int -> Width -> CmmLit
CmmLabelDiffOff CLabel
l1 CLabel
l2 Int
0 Width
w)
                                             , CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off) Width
W64)
                                             ])
      
      
      CmmExpr
_ -> do
        (Reg
reg,OrdList Instr
code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
e
        Amode -> NatM Amode
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (AddrMode -> OrdList Instr -> Amode
Amode (EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex (Reg -> EABase
EABaseReg Reg
reg) EAIndex
EAIndexNone (Int -> Imm
ImmInt Int
0)) OrdList Instr
code)
  where
    is_label :: CmmLit -> Bool
is_label (CmmLabel{}) = Bool
True
    is_label (CmmLabelOff{}) = Bool
True
    is_label (CmmLabelDiffOff{}) = Bool
True
    is_label CmmLit
_ = Bool
False
getSimpleAmode :: CmmExpr -> NatM Amode
getSimpleAmode :: CmmExpr -> NatM Amode
getSimpleAmode CmmExpr
addr = NatM Bool
is32BitPlatform NatM Bool -> (Bool -> NatM Amode) -> NatM Amode
forall a b. NatM a -> (a -> NatM b) -> NatM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Bool
False -> CmmExpr -> NatM Amode
getAmode CmmExpr
addr
  Bool
True  -> do
    Reg -> OrdList Instr
addr_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
addr
    NCGConfig
config <- NatM NCGConfig
getConfig
    Reg
addr_r <- Format -> NatM Reg
getNewRegNat (Width -> Format
intFormat (NCGConfig -> Width
ncgWordWidth NCGConfig
config))
    let amode :: AddrMode
amode = EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex (Reg -> EABase
EABaseReg Reg
addr_r) EAIndex
EAIndexNone (Int -> Imm
ImmInt Int
0)
    Amode -> NatM Amode
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Amode -> NatM Amode) -> Amode -> NatM Amode
forall a b. (a -> b) -> a -> b
$! AddrMode -> OrdList Instr -> Amode
Amode AddrMode
amode (Reg -> OrdList Instr
addr_code Reg
addr_r)
x86_complex_amode :: CmmExpr -> CmmExpr -> Integer -> Integer -> NatM Amode
x86_complex_amode :: CmmExpr -> CmmExpr -> Integer -> Integer -> NatM Amode
x86_complex_amode CmmExpr
base CmmExpr
index Integer
shift Integer
offset
  = do (Reg
x_reg, OrdList Instr
x_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getNonClobberedReg CmmExpr
base
        
        
       (Reg
y_reg, OrdList Instr
y_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
index
       let
           code :: OrdList Instr
code = OrdList Instr
x_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
y_code
           base :: Int
base = case Integer
shift of Integer
0 -> Int
1; Integer
1 -> Int
2; Integer
2 -> Int
4; Integer
3 -> Int
8;
                                Integer
n -> String -> Int
forall a. String -> a
panic (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
"x86_complex_amode: unhandled shift! (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
       Amode -> NatM Amode
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (AddrMode -> OrdList Instr -> Amode
Amode (EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex (Reg -> EABase
EABaseReg Reg
x_reg) (Reg -> Int -> EAIndex
EAIndex Reg
y_reg Int
base) (Int -> Imm
ImmInt (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
offset)))
               OrdList Instr
code)
getNonClobberedOperand :: CmmExpr -> NatM (Operand, InstrBlock)
getNonClobberedOperand :: CmmExpr -> NatM (Operand, OrdList Instr)
getNonClobberedOperand (CmmLit CmmLit
lit) =
  if CmmLit -> Bool
isSuitableFloatingPointLit CmmLit
lit
  then do
    let CmmFloat Rational
_ Width
w = CmmLit
lit
    Amode AddrMode
addr OrdList Instr
code <- Alignment -> CmmLit -> NatM Amode
memConstant (Int -> Alignment
mkAlignment (Int -> Alignment) -> Int -> Alignment
forall a b. (a -> b) -> a -> b
$ Width -> Int
widthInBytes Width
w) CmmLit
lit
    (Operand, OrdList Instr) -> NatM (Operand, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (AddrMode -> Operand
OpAddr AddrMode
addr, OrdList Instr
code)
  else do
    Platform
platform <- NatM Platform
getPlatform
    if Platform -> CmmLit -> Bool
is32BitLit Platform
platform CmmLit
lit Bool -> Bool -> Bool
&& Bool -> Bool
not (CmmType -> Bool
isFloatType (Platform -> CmmLit -> CmmType
cmmLitType Platform
platform CmmLit
lit))
    then (Operand, OrdList Instr) -> NatM (Operand, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Imm -> Operand
OpImm (CmmLit -> Imm
litToImm CmmLit
lit), OrdList Instr
forall a. OrdList a
nilOL)
    else CmmExpr -> NatM (Operand, OrdList Instr)
getNonClobberedOperand_generic (CmmLit -> CmmExpr
CmmLit CmmLit
lit)
getNonClobberedOperand (CmmLoad CmmExpr
mem CmmType
pk AlignmentSpec
_) = do
  Bool
is32Bit <- NatM Bool
is32BitPlatform
  
  
  if   (if Bool
is32Bit then Bool -> Bool
not (CmmType -> Bool
isWord64 CmmType
pk) else Bool
True)
      
      
      
    then do
      Platform
platform <- NCGConfig -> Platform
ncgPlatform (NCGConfig -> Platform) -> NatM NCGConfig -> NatM Platform
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NatM NCGConfig
getConfig
      Amode AddrMode
src OrdList Instr
mem_code <- CmmExpr -> NatM Amode
getAmode CmmExpr
mem
      (AddrMode
src',OrdList Instr
save_code) <-
        if (Platform -> AddrMode -> Bool
amodeCouldBeClobbered Platform
platform AddrMode
src)
                then do
                   Reg
tmp <- Format -> NatM Reg
getNewRegNat (Bool -> Format
archWordFormat Bool
is32Bit)
                   (AddrMode, OrdList Instr) -> NatM (AddrMode, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex (Reg -> EABase
EABaseReg Reg
tmp) EAIndex
EAIndexNone (Int -> Imm
ImmInt Int
0),
                           Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
LEA (Bool -> Format
archWordFormat Bool
is32Bit)
                                       (AddrMode -> Operand
OpAddr AddrMode
src)
                                       (Reg -> Operand
OpReg Reg
tmp)))
                else
                   (AddrMode, OrdList Instr) -> NatM (AddrMode, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (AddrMode
src, OrdList Instr
forall a. OrdList a
nilOL)
      (Operand, OrdList Instr) -> NatM (Operand, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (AddrMode -> Operand
OpAddr AddrMode
src', OrdList Instr
mem_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
save_code)
    else
      
      CmmExpr -> NatM (Operand, OrdList Instr)
getNonClobberedOperand_generic (CmmExpr -> CmmType -> AlignmentSpec -> CmmExpr
CmmLoad CmmExpr
mem CmmType
pk AlignmentSpec
NaturallyAligned)
getNonClobberedOperand CmmExpr
e = CmmExpr -> NatM (Operand, OrdList Instr)
getNonClobberedOperand_generic CmmExpr
e
getNonClobberedOperand_generic :: CmmExpr -> NatM (Operand, InstrBlock)
getNonClobberedOperand_generic :: CmmExpr -> NatM (Operand, OrdList Instr)
getNonClobberedOperand_generic CmmExpr
e = do
  (Reg
reg, OrdList Instr
code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getNonClobberedReg CmmExpr
e
  (Operand, OrdList Instr) -> NatM (Operand, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg -> Operand
OpReg Reg
reg, OrdList Instr
code)
amodeCouldBeClobbered :: Platform -> AddrMode -> Bool
amodeCouldBeClobbered :: Platform -> AddrMode -> Bool
amodeCouldBeClobbered Platform
platform AddrMode
amode = (Reg -> Bool) -> [Reg] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Platform -> Reg -> Bool
regClobbered Platform
platform) (AddrMode -> [Reg]
addrModeRegs AddrMode
amode)
regClobbered :: Platform -> Reg -> Bool
regClobbered :: Platform -> Reg -> Bool
regClobbered Platform
platform (RegReal (RealRegSingle Int
rr)) = Platform -> Int -> Bool
freeReg Platform
platform Int
rr
regClobbered Platform
_ Reg
_ = Bool
False
getOperand :: CmmExpr -> NatM (Operand, InstrBlock)
getOperand :: CmmExpr -> NatM (Operand, OrdList Instr)
getOperand (CmmLit CmmLit
lit) = do
  Bool
use_sse2 <- NatM Bool
sse2Enabled
  if (Bool
use_sse2 Bool -> Bool -> Bool
&& CmmLit -> Bool
isSuitableFloatingPointLit CmmLit
lit)
    then do
      let CmmFloat Rational
_ Width
w = CmmLit
lit
      Amode AddrMode
addr OrdList Instr
code <- Alignment -> CmmLit -> NatM Amode
memConstant (Int -> Alignment
mkAlignment (Int -> Alignment) -> Int -> Alignment
forall a b. (a -> b) -> a -> b
$ Width -> Int
widthInBytes Width
w) CmmLit
lit
      (Operand, OrdList Instr) -> NatM (Operand, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (AddrMode -> Operand
OpAddr AddrMode
addr, OrdList Instr
code)
    else do
  Platform
platform <- NatM Platform
getPlatform
  if Platform -> CmmLit -> Bool
is32BitLit Platform
platform CmmLit
lit Bool -> Bool -> Bool
&& Bool -> Bool
not (CmmType -> Bool
isFloatType (Platform -> CmmLit -> CmmType
cmmLitType Platform
platform CmmLit
lit))
    then (Operand, OrdList Instr) -> NatM (Operand, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Imm -> Operand
OpImm (CmmLit -> Imm
litToImm CmmLit
lit), OrdList Instr
forall a. OrdList a
nilOL)
    else CmmExpr -> NatM (Operand, OrdList Instr)
getOperand_generic (CmmLit -> CmmExpr
CmmLit CmmLit
lit)
getOperand (CmmLoad CmmExpr
mem CmmType
pk AlignmentSpec
_) = do
  Bool
is32Bit <- NatM Bool
is32BitPlatform
  Bool
use_sse2 <- NatM Bool
sse2Enabled
  if (Bool -> Bool
not (CmmType -> Bool
isFloatType CmmType
pk) Bool -> Bool -> Bool
|| Bool
use_sse2) Bool -> Bool -> Bool
&& (if Bool
is32Bit then Bool -> Bool
not (CmmType -> Bool
isWord64 CmmType
pk) else Bool
True)
     then do
       Amode AddrMode
src OrdList Instr
mem_code <- CmmExpr -> NatM Amode
getAmode CmmExpr
mem
       (Operand, OrdList Instr) -> NatM (Operand, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (AddrMode -> Operand
OpAddr AddrMode
src, OrdList Instr
mem_code)
     else
       CmmExpr -> NatM (Operand, OrdList Instr)
getOperand_generic (CmmExpr -> CmmType -> AlignmentSpec -> CmmExpr
CmmLoad CmmExpr
mem CmmType
pk AlignmentSpec
NaturallyAligned)
getOperand CmmExpr
e = CmmExpr -> NatM (Operand, OrdList Instr)
getOperand_generic CmmExpr
e
getOperand_generic :: CmmExpr -> NatM (Operand, InstrBlock)
getOperand_generic :: CmmExpr -> NatM (Operand, OrdList Instr)
getOperand_generic CmmExpr
e = do
    (Reg
reg, OrdList Instr
code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
e
    (Operand, OrdList Instr) -> NatM (Operand, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg -> Operand
OpReg Reg
reg, OrdList Instr
code)
isOperand :: Platform -> CmmExpr -> Bool
isOperand :: Platform -> CmmExpr -> Bool
isOperand Platform
_ (CmmLoad CmmExpr
_ CmmType
_ AlignmentSpec
_) = Bool
True
isOperand Platform
platform (CmmLit CmmLit
lit)
                          = Platform -> CmmLit -> Bool
is32BitLit Platform
platform CmmLit
lit
                          Bool -> Bool -> Bool
|| CmmLit -> Bool
isSuitableFloatingPointLit CmmLit
lit
isOperand Platform
_ CmmExpr
_            = Bool
False
addAlignmentCheck :: Int -> Register -> Register
addAlignmentCheck :: Int -> Register -> Register
addAlignmentCheck Int
align Register
reg =
    case Register
reg of
      Fixed Format
fmt Reg
reg OrdList Instr
code -> Format -> Reg -> OrdList Instr -> Register
Fixed Format
fmt Reg
reg (OrdList Instr
code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Format -> Reg -> OrdList Instr
check Format
fmt Reg
reg)
      Any Format
fmt Reg -> OrdList Instr
f          -> Format -> (Reg -> OrdList Instr) -> Register
Any Format
fmt (\Reg
reg -> Reg -> OrdList Instr
f Reg
reg OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Format -> Reg -> OrdList Instr
check Format
fmt Reg
reg)
  where
    check :: Format -> Reg -> InstrBlock
    check :: Format -> Reg -> OrdList Instr
check Format
fmt Reg
reg =
        Bool -> OrdList Instr -> OrdList Instr
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Format -> Bool
isFloatFormat Format
fmt) (OrdList Instr -> OrdList Instr) -> OrdList Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$
        [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Format -> Operand -> Operand -> Instr
TEST Format
fmt (Imm -> Operand
OpImm (Imm -> Operand) -> Imm -> Operand
forall a b. (a -> b) -> a -> b
$ Int -> Imm
ImmInt (Int -> Imm) -> Int -> Imm
forall a b. (a -> b) -> a -> b
$ Int
alignInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Reg -> Operand
OpReg Reg
reg)
             , Cond -> Imm -> Instr
JXX_GBL Cond
NE (Imm -> Instr) -> Imm -> Instr
forall a b. (a -> b) -> a -> b
$ CLabel -> Imm
ImmCLbl CLabel
mkBadAlignmentLabel
             ]
memConstant :: Alignment -> CmmLit -> NatM Amode
memConstant :: Alignment -> CmmLit -> NatM Amode
memConstant Alignment
align CmmLit
lit = do
  CLabel
lbl <- NatM CLabel
getNewLabelNat
  let rosection :: Section
rosection = SectionType -> CLabel -> Section
Section SectionType
ReadOnlyData CLabel
lbl
  NCGConfig
config <- NatM NCGConfig
getConfig
  Platform
platform <- NatM Platform
getPlatform
  (AddrMode
addr, OrdList Instr
addr_code) <- if Platform -> Bool
target32Bit Platform
platform
                       then do 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 <- CmmExpr -> NatM Amode
getAmode CmmExpr
dynRef
                               (AddrMode, OrdList Instr) -> NatM (AddrMode, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (AddrMode
addr, OrdList Instr
addr_code)
                       else (AddrMode, OrdList Instr) -> NatM (AddrMode, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Imm -> AddrMode
ripRel (CLabel -> Imm
ImmCLbl CLabel
lbl), OrdList Instr
forall a. OrdList a
nilOL)
  let code :: OrdList Instr
code =
        Section -> (Alignment, RawCmmStatics) -> Instr
LDATA Section
rosection (Alignment
align, 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
  Amode -> NatM Amode
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (AddrMode -> OrdList Instr -> Amode
Amode AddrMode
addr OrdList Instr
code)
loadFloatAmode :: Width -> AddrMode -> InstrBlock -> NatM Register
loadFloatAmode :: Width -> AddrMode -> OrdList Instr -> NatM Register
loadFloatAmode Width
w AddrMode
addr OrdList Instr
addr_code = do
  let format :: Format
format = Width -> Format
floatFormat Width
w
      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 -> Operand -> Operand -> Instr
MOV Format
format (AddrMode -> Operand
OpAddr AddrMode
addr) (Reg -> Operand
OpReg 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)
isSuitableFloatingPointLit :: CmmLit -> Bool
isSuitableFloatingPointLit :: CmmLit -> Bool
isSuitableFloatingPointLit (CmmFloat Rational
f Width
_) = Rational
f Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
/= Rational
0.0
isSuitableFloatingPointLit CmmLit
_ = Bool
False
getRegOrMem :: CmmExpr -> NatM (Operand, InstrBlock)
getRegOrMem :: CmmExpr -> NatM (Operand, OrdList Instr)
getRegOrMem e :: CmmExpr
e@(CmmLoad CmmExpr
mem CmmType
pk AlignmentSpec
_) = do
  Bool
is32Bit <- NatM Bool
is32BitPlatform
  Bool
use_sse2 <- NatM Bool
sse2Enabled
  if (Bool -> Bool
not (CmmType -> Bool
isFloatType CmmType
pk) Bool -> Bool -> Bool
|| Bool
use_sse2) Bool -> Bool -> Bool
&& (if Bool
is32Bit then Bool -> Bool
not (CmmType -> Bool
isWord64 CmmType
pk) else Bool
True)
     then do
       Amode AddrMode
src OrdList Instr
mem_code <- CmmExpr -> NatM Amode
getAmode CmmExpr
mem
       (Operand, OrdList Instr) -> NatM (Operand, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (AddrMode -> Operand
OpAddr AddrMode
src, OrdList Instr
mem_code)
     else do
       (Reg
reg, OrdList Instr
code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getNonClobberedReg CmmExpr
e
       (Operand, OrdList Instr) -> NatM (Operand, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg -> Operand
OpReg Reg
reg, OrdList Instr
code)
getRegOrMem CmmExpr
e = do
    (Reg
reg, OrdList Instr
code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getNonClobberedReg CmmExpr
e
    (Operand, OrdList Instr) -> NatM (Operand, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg -> Operand
OpReg Reg
reg, OrdList Instr
code)
is32BitLit :: Platform -> CmmLit -> Bool
is32BitLit :: Platform -> CmmLit -> Bool
is32BitLit Platform
platform CmmLit
_lit
   | Platform -> Bool
target32Bit Platform
platform = Bool
True
is32BitLit Platform
platform CmmLit
lit =
   case CmmLit
lit of
      CmmInt Integer
i Width
W64              -> Integer -> Bool
is32BitInteger Integer
i
      
      
      
      CmmLabel CLabel
_                -> Bool
low_image
      
      
      CmmLabelOff CLabel
_ Int
off         -> Bool
low_image Bool -> Bool -> Bool
&& Integer -> Bool
is32BitInteger (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off)
      CmmLabelDiffOff CLabel
_ CLabel
_ Int
off Width
_ -> Bool
low_image Bool -> Bool -> Bool
&& Integer -> Bool
is32BitInteger (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off)
      CmmLit
_                         -> Bool
True
  where
    
    
    low_image :: Bool
low_image =
      case Platform -> OS
platformOS Platform
platform of
        OS
OSMinGW32 -> Bool
False   
        OS
_         -> Bool
True
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
GTT  CmmExpr
y CmmExpr
x
      MO_F_Le Width
W32 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
GE   CmmExpr
y CmmExpr
x
      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
GTT CmmExpr
y CmmExpr
x
      MO_F_Le Width
W64 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
GE  CmmExpr
y CmmExpr
x
      MachOp
_ -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode (MachOp -> Cond
machOpToCond MachOp
mop) CmmExpr
x CmmExpr
y
getCondCode CmmExpr
other = do
   Platform
platform <- NatM Platform
getPlatform
   String -> SDoc -> NatM CondCode
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getCondCode(2)(x86,x86_64)" (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
other)
machOpToCond :: MachOp -> Cond
machOpToCond :: MachOp -> Cond
machOpToCond MachOp
mo = case MachOp
mo of
  MO_Eq Width
_   -> Cond
EQQ
  MO_Ne Width
_   -> Cond
NE
  MO_S_Gt Width
_ -> Cond
GTT
  MO_S_Ge Width
_ -> Cond
GE
  MO_S_Lt Width
_ -> Cond
LTT
  MO_S_Le Width
_ -> Cond
LE
  MO_U_Gt Width
_ -> Cond
GU
  MO_U_Ge Width
_ -> Cond
GEU
  MO_U_Lt Width
_ -> Cond
LU
  MO_U_Le Width
_ -> Cond
LEU
  MachOp
_other -> String -> SDoc -> Cond
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"machOpToCond" (MachOp -> SDoc
pprMachOp MachOp
mo)
condIntCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode Cond
cond CmmExpr
x CmmExpr
y = do Platform
platform <- NatM Platform
getPlatform
                          Platform -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode' Platform
platform Cond
cond CmmExpr
x CmmExpr
y
condIntCode' :: Platform -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode' :: Platform -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode' Platform
platform Cond
cond (CmmLoad CmmExpr
x CmmType
pk AlignmentSpec
_) (CmmLit CmmLit
lit)
 | Platform -> CmmLit -> Bool
is32BitLit Platform
platform CmmLit
lit = do
    Amode AddrMode
x_addr OrdList Instr
x_code <- CmmExpr -> NatM Amode
getAmode CmmExpr
x
    let
        imm :: Imm
imm  = CmmLit -> Imm
litToImm CmmLit
lit
        code :: OrdList Instr
code = OrdList Instr
x_code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
                  Format -> Operand -> Operand -> Instr
CMP (CmmType -> Format
cmmTypeFormat CmmType
pk) (Imm -> Operand
OpImm Imm
imm) (AddrMode -> Operand
OpAddr AddrMode
x_addr)
    
    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' Platform
platform Cond
cond (CmmMachOp (MO_And Width
_) [CmmExpr
x,CmmExpr
o2]) (CmmLit (CmmInt Integer
0 Width
pk))
    | (CmmLit lit :: CmmLit
lit@(CmmInt Integer
mask Width
_)) <- CmmExpr
o2, Platform -> CmmLit -> Bool
is32BitLit Platform
platform CmmLit
lit
    = do
      (Reg
x_reg, OrdList Instr
x_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
x
      let
         code :: OrdList Instr
code = OrdList Instr
x_code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
                Format -> Operand -> Operand -> Instr
TEST (Width -> Format
intFormat Width
pk) (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
mask)) (Reg -> Operand
OpReg Reg
x_reg)
      
      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' Platform
_ Cond
cond CmmExpr
x (CmmLit (CmmInt Integer
0 Width
pk)) = do
    (Reg
x_reg, OrdList Instr
x_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
x
    let
        code :: OrdList Instr
code = OrdList Instr
x_code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
                  Format -> Operand -> Operand -> Instr
TEST (Width -> Format
intFormat Width
pk) (Reg -> Operand
OpReg Reg
x_reg) (Reg -> Operand
OpReg Reg
x_reg)
    
    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' Platform
platform Cond
cond CmmExpr
x CmmExpr
y
 | Platform -> CmmExpr -> Bool
isOperand Platform
platform CmmExpr
y = do
    (Reg
x_reg, OrdList Instr
x_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getNonClobberedReg CmmExpr
x
    (Operand
y_op,  OrdList Instr
y_code) <- CmmExpr -> NatM (Operand, OrdList Instr)
getOperand CmmExpr
y
    let
        code :: OrdList Instr
code = OrdList Instr
x_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
y_code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
                  Format -> Operand -> Operand -> Instr
CMP (CmmType -> Format
cmmTypeFormat (Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
x)) Operand
y_op (Reg -> Operand
OpReg Reg
x_reg)
    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)
 | Platform -> CmmExpr -> Bool
isOperand Platform
platform CmmExpr
x
 , Just Cond
revcond <- Cond -> Maybe Cond
maybeFlipCond Cond
cond = do
    (Reg
y_reg, OrdList Instr
y_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getNonClobberedReg CmmExpr
y
    (Operand
x_op,  OrdList Instr
x_code) <- CmmExpr -> NatM (Operand, OrdList Instr)
getOperand CmmExpr
x
    let
        code :: OrdList Instr
code = 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 -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
                  Format -> Operand -> Operand -> Instr
CMP (CmmType -> Format
cmmTypeFormat (Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
x)) Operand
x_op (Reg -> Operand
OpReg Reg
y_reg)
    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
revcond OrdList Instr
code)
condIntCode' Platform
platform Cond
cond CmmExpr
x CmmExpr
y = do
  (Reg
y_reg, OrdList Instr
y_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getNonClobberedReg CmmExpr
y
  (Operand
x_op, OrdList Instr
x_code) <- CmmExpr -> NatM (Operand, OrdList Instr)
getRegOrMem CmmExpr
x
  let
        code :: OrdList Instr
code = 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 -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
                  Format -> Operand -> Operand -> Instr
CMP (CmmType -> Format
cmmTypeFormat (Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
x)) (Reg -> Operand
OpReg Reg
y_reg) Operand
x_op
  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
  =  NatM CondCode
condFltCode_sse2
  where
  
  
  
  condFltCode_sse2 :: NatM CondCode
condFltCode_sse2 = do
    Platform
platform <- NatM Platform
getPlatform
    (Reg
x_reg, OrdList Instr
x_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getNonClobberedReg CmmExpr
x
    (Operand
y_op, OrdList Instr
y_code) <- CmmExpr -> NatM (Operand, OrdList Instr)
getOperand CmmExpr
y
    let
        code :: OrdList Instr
code = OrdList Instr
x_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
               OrdList Instr
y_code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
                  Format -> Operand -> Operand -> Instr
CMP (Width -> Format
floatFormat (Width -> Format) -> Width -> Format
forall a b. (a -> b) -> a -> b
$ Platform -> CmmExpr -> Width
cmmExprWidth Platform
platform CmmExpr
x) Operand
y_op (Reg -> Operand
OpReg Reg
x_reg)
        
        
    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
condToUnsigned 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 (CmmMachOp MachOp
op [CmmLoad CmmExpr
addr2 CmmType
_ AlignmentSpec
_,
                                                 CmmLit (CmmInt Integer
i Width
_)])
   | CmmExpr
addr CmmExpr -> CmmExpr -> Bool
forall a. Eq a => a -> a -> Bool
== CmmExpr
addr2, Format
pk Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
/= Format
II64 Bool -> Bool -> Bool
|| Integer -> Bool
is32BitInteger Integer
i,
     Just Format -> Operand -> Operand -> Instr
instr <- MachOp -> Maybe (Format -> Operand -> Operand -> Instr)
check MachOp
op
   = do Amode AddrMode
amode OrdList Instr
code_addr <- CmmExpr -> NatM Amode
getAmode CmmExpr
addr
        let code :: OrdList Instr
code = OrdList Instr
code_addr OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
                   Format -> Operand -> Operand -> Instr
instr Format
pk (Imm -> Operand
OpImm (Int -> Imm
ImmInt (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i))) (AddrMode -> Operand
OpAddr AddrMode
amode)
        OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return OrdList Instr
code
   where
        check :: MachOp -> Maybe (Format -> Operand -> Operand -> Instr)
check (MO_Add Width
_) = (Format -> Operand -> Operand -> Instr)
-> Maybe (Format -> Operand -> Operand -> Instr)
forall a. a -> Maybe a
Just Format -> Operand -> Operand -> Instr
ADD
        check (MO_Sub Width
_) = (Format -> Operand -> Operand -> Instr)
-> Maybe (Format -> Operand -> Operand -> Instr)
forall a. a -> Maybe a
Just Format -> Operand -> Operand -> Instr
SUB
        check MachOp
_ = Maybe (Format -> Operand -> Operand -> Instr)
forall a. Maybe a
Nothing
        
assignMem_IntCode Format
pk CmmExpr
addr CmmExpr
src = do
    Platform
platform <- NatM Platform
getPlatform
    Amode AddrMode
addr OrdList Instr
code_addr <- CmmExpr -> NatM Amode
getAmode CmmExpr
addr
    (OrdList Instr
code_src, Operand
op_src)   <- Platform -> CmmExpr -> NatM (OrdList Instr, Operand)
get_op_RI Platform
platform CmmExpr
src
    let
        code :: OrdList Instr
code = OrdList Instr
code_src OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
               OrdList Instr
code_addr OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
                  Format -> Operand -> Operand -> Instr
MOV Format
pk Operand
op_src (AddrMode -> Operand
OpAddr AddrMode
addr)
        
        
        
        
    
    OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return OrdList Instr
code
  where
    get_op_RI :: Platform -> CmmExpr -> NatM (InstrBlock,Operand)   
    get_op_RI :: Platform -> CmmExpr -> NatM (OrdList Instr, Operand)
get_op_RI Platform
platform (CmmLit CmmLit
lit) | Platform -> CmmLit -> Bool
is32BitLit Platform
platform CmmLit
lit
      = (OrdList Instr, Operand) -> NatM (OrdList Instr, Operand)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr
forall a. OrdList a
nilOL, Imm -> Operand
OpImm (CmmLit -> Imm
litToImm CmmLit
lit))
    get_op_RI Platform
_ CmmExpr
op
      = do (Reg
reg,OrdList Instr
code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getNonClobberedReg CmmExpr
op
           (OrdList Instr, Operand) -> NatM (OrdList Instr, Operand)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr
code, Reg -> Operand
OpReg Reg
reg)
assignReg_IntCode :: Format -> CmmReg -> CmmExpr -> NatM (OrdList Instr)
assignReg_IntCode Format
pk CmmReg
reg (CmmLoad CmmExpr
src CmmType
_ AlignmentSpec
_) = do
  Reg -> OrdList Instr
load_code <- (Operand -> Operand -> Instr)
-> CmmExpr -> NatM (Reg -> OrdList Instr)
intLoadCode (Format -> Operand -> Operand -> Instr
MOV Format
pk) CmmExpr
src
  Platform
platform <- NCGConfig -> Platform
ncgPlatform (NCGConfig -> Platform) -> NatM NCGConfig -> NatM Platform
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NatM NCGConfig
getConfig
  OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg -> OrdList Instr
load_code (Platform -> CmmReg -> Reg
getRegisterReg Platform
platform CmmReg
reg))
assignReg_IntCode Format
_ CmmReg
reg CmmExpr
src = do
  Platform
platform <- NCGConfig -> Platform
ncgPlatform (NCGConfig -> Platform) -> NatM NCGConfig -> NatM Platform
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NatM NCGConfig
getConfig
  Reg -> OrdList Instr
code <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
src
  OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg -> OrdList Instr
code (Platform -> CmmReg -> Reg
getRegisterReg Platform
platform CmmReg
reg))
assignMem_FltCode :: Format -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
assignMem_FltCode Format
pk CmmExpr
addr CmmExpr
src = do
  (Reg
src_reg, OrdList Instr
src_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getNonClobberedReg CmmExpr
src
  Amode AddrMode
addr OrdList Instr
addr_code <- CmmExpr -> NatM Amode
getAmode CmmExpr
addr
  let
        code :: OrdList Instr
code = OrdList Instr
src_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 -> Operand -> Operand -> Instr
MOV Format
pk (Reg -> Operand
OpReg Reg
src_reg) (AddrMode -> Operand
OpAddr AddrMode
addr)
  OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return OrdList Instr
code
assignReg_FltCode :: Format -> CmmReg -> CmmExpr -> NatM (OrdList Instr)
assignReg_FltCode Format
_ CmmReg
reg CmmExpr
src = do
  Reg -> OrdList Instr
src_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
src
  Platform
platform <- NCGConfig -> Platform
ncgPlatform (NCGConfig -> Platform) -> NatM NCGConfig -> NatM Platform
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NatM NCGConfig
getConfig
  OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg -> OrdList Instr
src_code (Platform -> CmmReg -> Reg
getRegisterReg Platform
platform CmmReg
reg))
genJump :: CmmExpr -> [Reg] -> NatM InstrBlock
genJump :: CmmExpr -> [Reg] -> NatM (OrdList Instr)
genJump (CmmLoad CmmExpr
mem CmmType
_ AlignmentSpec
_) [Reg]
regs = do
  Amode AddrMode
target OrdList Instr
code <- CmmExpr -> NatM Amode
getAmode CmmExpr
mem
  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` Operand -> [Reg] -> Instr
JMP (AddrMode -> Operand
OpAddr AddrMode
target) [Reg]
regs)
genJump (CmmLit CmmLit
lit) [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 (Operand -> [Reg] -> Instr
JMP (Imm -> Operand
OpImm (CmmLit -> Imm
litToImm CmmLit
lit)) [Reg]
regs))
genJump CmmExpr
expr [Reg]
regs = do
  (Reg
reg,OrdList Instr
code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
expr
  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` Operand -> [Reg] -> Instr
JMP (Reg -> Operand
OpReg Reg
reg) [Reg]
regs)
genBranch :: BlockId -> InstrBlock
genBranch :: Label -> OrdList Instr
genBranch = [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL ([Instr] -> OrdList Instr)
-> (Label -> [Instr]) -> Label -> OrdList Instr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Label -> [Instr]
mkJumpInstr
genCondBranch
    :: BlockId      
    -> BlockId      
    -> BlockId      
    -> CmmExpr      
    -> NatM InstrBlock 
genCondBranch :: Label -> Label -> Label -> CmmExpr -> NatM (OrdList Instr)
genCondBranch Label
bid Label
id Label
false CmmExpr
expr = do
  Bool
is32Bit <- NatM Bool
is32BitPlatform
  Bool -> Label -> Label -> Label -> CmmExpr -> NatM (OrdList Instr)
genCondBranch' Bool
is32Bit Label
bid Label
id Label
false CmmExpr
expr
genCondBranch' :: Bool -> BlockId -> BlockId -> BlockId -> CmmExpr
               -> NatM InstrBlock
genCondBranch' :: Bool -> Label -> Label -> Label -> CmmExpr -> NatM (OrdList Instr)
genCondBranch' Bool
is32Bit Label
_bid Label
true Label
false (CmmMachOp MachOp
mop [CmmExpr
e1,CmmExpr
e2])
  | Bool
is32Bit, Just Width
W64 <- MachOp -> Maybe Width
maybeIntComparison MachOp
mop = do
  RegCode64 OrdList Instr
code1 Reg
r1hi Reg
r1lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
e1
  RegCode64 OrdList Instr
code2 Reg
r2hi Reg
r2lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
e2
  let cond :: Cond
cond = MachOp -> Cond
machOpToCond MachOp
mop :: Cond
  
  Reg
tmp1 <- Format -> NatM Reg
getNewRegNat Format
II32
  Reg
tmp2 <- Format -> NatM Reg
getNewRegNat Format
II32
  let cmpCode :: OrdList Instr
cmpCode = Cond
-> Label
-> Label
-> Reg
-> Reg
-> Reg
-> Reg
-> Reg
-> Reg
-> OrdList Instr
intComparison Cond
cond Label
true Label
false Reg
r1hi Reg
r1lo Reg
r2hi Reg
r2lo Reg
tmp1 Reg
tmp2
  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
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` OrdList Instr
cmpCode
  where
    intComparison :: Cond
-> Label
-> Label
-> Reg
-> Reg
-> Reg
-> Reg
-> Reg
-> Reg
-> OrdList Instr
intComparison Cond
cond Label
true Label
false Reg
r1_hi Reg
r1_lo Reg
r2_hi Reg
r2_lo Reg
tmp1 Reg
tmp2 =
      case Cond
cond of
        
        Cond
ALWAYS  -> String -> OrdList Instr
forall a. String -> a
panic String
"impossible"
        Cond
NEG     -> String -> OrdList Instr
forall a. String -> a
panic String
"impossible"
        Cond
POS     -> String -> OrdList Instr
forall a. String -> a
panic String
"impossible"
        Cond
CARRY   -> String -> OrdList Instr
forall a. String -> a
panic String
"impossible"
        Cond
OFLO    -> String -> OrdList Instr
forall a. String -> a
panic String
"impossible"
        Cond
PARITY  -> String -> OrdList Instr
forall a. String -> a
panic String
"impossible"
        Cond
NOTPARITY -> String -> OrdList Instr
forall a. String -> a
panic String
"impossible"
        
        Cond
EQQ -> OrdList Instr
cmpExact
        Cond
NE  -> OrdList Instr
cmpExact
        
        Cond
GE  -> OrdList Instr
cmpGE
        Cond
GEU -> OrdList Instr
cmpGE
        
        Cond
GTT -> Cond
-> Label
-> Label
-> Reg
-> Reg
-> Reg
-> Reg
-> Reg
-> Reg
-> OrdList Instr
intComparison Cond
GE  Label
false Label
true Reg
r2_hi Reg
r2_lo Reg
r1_hi Reg
r1_lo Reg
tmp1 Reg
tmp2
        Cond
GU  -> Cond
-> Label
-> Label
-> Reg
-> Reg
-> Reg
-> Reg
-> Reg
-> Reg
-> OrdList Instr
intComparison Cond
GEU Label
false Label
true Reg
r2_hi Reg
r2_lo Reg
r1_hi Reg
r1_lo Reg
tmp1 Reg
tmp2
        
        Cond
LE  -> Cond
-> Label
-> Label
-> Reg
-> Reg
-> Reg
-> Reg
-> Reg
-> Reg
-> OrdList Instr
intComparison Cond
GE  Label
true Label
false Reg
r2_hi Reg
r2_lo Reg
r1_hi Reg
r1_lo Reg
tmp1 Reg
tmp2
        Cond
LEU -> Cond
-> Label
-> Label
-> Reg
-> Reg
-> Reg
-> Reg
-> Reg
-> Reg
-> OrdList Instr
intComparison Cond
GEU Label
true Label
false Reg
r2_hi Reg
r2_lo Reg
r1_hi Reg
r1_lo Reg
tmp1 Reg
tmp2
        
        Cond
LTT -> Cond
-> Label
-> Label
-> Reg
-> Reg
-> Reg
-> Reg
-> Reg
-> Reg
-> OrdList Instr
intComparison Cond
GE  Label
false Label
true Reg
r1_hi Reg
r1_lo Reg
r2_hi Reg
r2_lo Reg
tmp1 Reg
tmp2
        Cond
LU  -> Cond
-> Label
-> Label
-> Reg
-> Reg
-> Reg
-> Reg
-> Reg
-> Reg
-> OrdList Instr
intComparison Cond
GEU Label
false Label
true Reg
r1_hi Reg
r1_lo Reg
r2_hi Reg
r2_lo Reg
tmp1 Reg
tmp2
      where
        cmpExact :: OrdList Instr
        cmpExact :: OrdList Instr
cmpExact =
          [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL
            [ Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r1_hi) (Reg -> Operand
OpReg Reg
tmp1)
            , Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r1_lo) (Reg -> Operand
OpReg Reg
tmp2)
            , Format -> Operand -> Operand -> Instr
XOR Format
II32 (Reg -> Operand
OpReg Reg
r2_hi) (Reg -> Operand
OpReg Reg
tmp1)
            , Format -> Operand -> Operand -> Instr
XOR Format
II32 (Reg -> Operand
OpReg Reg
r2_lo) (Reg -> Operand
OpReg Reg
tmp2)
            , Format -> Operand -> Operand -> Instr
OR  Format
II32 (Reg -> Operand
OpReg Reg
tmp1)  (Reg -> Operand
OpReg Reg
tmp2)
            , Cond -> Label -> Instr
JXX Cond
cond Label
true
            , Cond -> Label -> Instr
JXX Cond
ALWAYS Label
false
            ]
        cmpGE :: OrdList Instr
cmpGE = [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL
            [ Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r1_hi) (Reg -> Operand
OpReg Reg
tmp1)
            , Format -> Operand -> Operand -> Instr
CMP Format
II32 (Reg -> Operand
OpReg Reg
r2_lo) (Reg -> Operand
OpReg Reg
r1_lo)
            , Format -> Operand -> Operand -> Instr
SBB Format
II32 (Reg -> Operand
OpReg Reg
r2_hi) (Reg -> Operand
OpReg Reg
tmp1)
            , Cond -> Label -> Instr
JXX Cond
cond Label
true
            , Cond -> Label -> Instr
JXX Cond
ALWAYS Label
false ]
genCondBranch' Bool
_ Label
bid Label
id Label
false CmmExpr
bool = do
  CondCode Bool
is_float Cond
cond OrdList Instr
cond_code <- CmmExpr -> NatM CondCode
getCondCode CmmExpr
bool
  Bool
use_sse2 <- NatM Bool
sse2Enabled
  if Bool -> Bool
not Bool
is_float Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
use_sse2
    then
        OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr
cond_code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Cond -> Label -> Instr
JXX Cond
cond Label
id OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Label -> OrdList Instr
genBranch Label
false)
    else do
        
        let jmpFalse :: OrdList Instr
jmpFalse = Label -> OrdList Instr
genBranch Label
false
            code :: OrdList Instr
code
                = case Cond
cond of
                  Cond
NE  -> OrdList Instr
or_unordered
                  Cond
GU  -> OrdList Instr
plain_test
                  Cond
GEU -> OrdList Instr
plain_test
                  
                  
                  Cond
LTT ->
                    Bool -> SDoc -> OrdList Instr -> OrdList Instr
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr Bool
False (String -> SDoc
forall a. Outputable a => a -> SDoc
ppr String
"Should have been turned into >")
                    OrdList Instr
and_ordered
                  Cond
LE  ->
                    Bool -> SDoc -> OrdList Instr -> OrdList Instr
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr Bool
False (String -> SDoc
forall a. Outputable a => a -> SDoc
ppr String
"Should have been turned into >=")
                    OrdList Instr
and_ordered
                  Cond
_   -> OrdList Instr
and_ordered
            plain_test :: OrdList Instr
plain_test = Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (
                  Cond -> Label -> Instr
JXX Cond
cond Label
id
                ) OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
jmpFalse
            or_unordered :: OrdList Instr
or_unordered = [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [
                  Cond -> Label -> Instr
JXX Cond
cond Label
id,
                  Cond -> Label -> Instr
JXX Cond
PARITY Label
id
                ] OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
jmpFalse
            and_ordered :: OrdList Instr
and_ordered = [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [
                  Cond -> Label -> Instr
JXX Cond
PARITY Label
false,
                  Cond -> Label -> Instr
JXX Cond
cond Label
id,
                  Cond -> Label -> Instr
JXX Cond
ALWAYS Label
false
                ]
        (CFG -> CFG) -> NatM ()
updateCfgNat (\CFG
cfg -> CFG -> (EdgeWeight -> EdgeWeight) -> Label -> Label -> CFG
adjustEdgeWeight CFG
cfg (EdgeWeight -> EdgeWeight -> EdgeWeight
forall a. Num a => a -> a -> a
+EdgeWeight
3) Label
bid Label
false)
        OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr
cond_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code)
genForeignCall
    :: ForeignTarget 
    -> [CmmFormal]   
    -> [CmmActual]   
    -> BlockId       
    -> NatM (InstrBlock, Maybe BlockId)
genForeignCall :: ForeignTarget
-> [LocalReg]
-> [CmmExpr]
-> Label
-> NatM (OrdList Instr, Maybe Label)
genForeignCall ForeignTarget
target [LocalReg]
dst [CmmExpr]
args Label
bid = do
  case ForeignTarget
target of
    PrimTarget CallishMachOp
prim         -> Label
-> CallishMachOp
-> [LocalReg]
-> [CmmExpr]
-> NatM (OrdList Instr, Maybe Label)
genPrim Label
bid CallishMachOp
prim [LocalReg]
dst [CmmExpr]
args
    ForeignTarget CmmExpr
addr ForeignConvention
conv -> (,Maybe Label
forall a. Maybe a
Nothing) (OrdList Instr -> (OrdList Instr, Maybe Label))
-> NatM (OrdList Instr) -> NatM (OrdList Instr, Maybe Label)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Label
-> CmmExpr
-> ForeignConvention
-> [LocalReg]
-> [CmmExpr]
-> NatM (OrdList Instr)
genCCall Label
bid CmmExpr
addr ForeignConvention
conv [LocalReg]
dst [CmmExpr]
args
genPrim
    :: BlockId       
    -> CallishMachOp 
    -> [CmmFormal]   
    -> [CmmActual]   
    -> NatM (InstrBlock, Maybe BlockId)
genPrim :: Label
-> CallishMachOp
-> [LocalReg]
-> [CmmExpr]
-> NatM (OrdList Instr, Maybe Label)
genPrim Label
bid (MO_AtomicRMW Width
width AtomicMachOp
amop) [LocalReg
dst] [CmmExpr
addr, CmmExpr
n]
  = Label
-> Width
-> AtomicMachOp
-> LocalReg
-> CmmExpr
-> CmmExpr
-> NatM (OrdList Instr, Maybe Label)
genAtomicRMW Label
bid Width
width AtomicMachOp
amop LocalReg
dst CmmExpr
addr CmmExpr
n
genPrim Label
bid (MO_Ctz Width
width) [LocalReg
dst] [CmmExpr
src]
  = Label
-> Width
-> LocalReg
-> CmmExpr
-> NatM (OrdList Instr, Maybe Label)
genCtz Label
bid Width
width LocalReg
dst CmmExpr
src
genPrim Label
bid CallishMachOp
prim [LocalReg]
dst [CmmExpr]
args
  = (,Maybe Label
forall a. Maybe a
Nothing) (OrdList Instr -> (OrdList Instr, Maybe Label))
-> NatM (OrdList Instr) -> NatM (OrdList Instr, Maybe Label)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Label
-> CallishMachOp -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genSimplePrim Label
bid CallishMachOp
prim [LocalReg]
dst [CmmExpr]
args
genSimplePrim
    :: BlockId       
    -> CallishMachOp 
    -> [CmmFormal]   
    -> [CmmActual]   
    -> NatM InstrBlock
genSimplePrim :: Label
-> CallishMachOp -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genSimplePrim Label
bid (MO_Memcpy Int
align)    []      [CmmExpr
dst,CmmExpr
src,CmmExpr
n]    = Label
-> Int -> CmmExpr -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genMemCpy  Label
bid Int
align CmmExpr
dst CmmExpr
src CmmExpr
n
genSimplePrim Label
bid (MO_Memmove Int
align)   []      [CmmExpr
dst,CmmExpr
src,CmmExpr
n]    = Label
-> Int -> CmmExpr -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
forall p.
Label -> p -> CmmExpr -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genMemMove Label
bid Int
align CmmExpr
dst CmmExpr
src CmmExpr
n
genSimplePrim Label
bid (MO_Memcmp Int
align)    [LocalReg
res]   [CmmExpr
dst,CmmExpr
src,CmmExpr
n]    = Label
-> Int
-> LocalReg
-> CmmExpr
-> CmmExpr
-> CmmExpr
-> NatM (OrdList Instr)
forall p.
Label
-> p
-> LocalReg
-> CmmExpr
-> CmmExpr
-> CmmExpr
-> NatM (OrdList Instr)
genMemCmp  Label
bid Int
align LocalReg
res CmmExpr
dst CmmExpr
src CmmExpr
n
genSimplePrim Label
bid (MO_Memset Int
align)    []      [CmmExpr
dst,CmmExpr
c,CmmExpr
n]      = Label
-> Int -> CmmExpr -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genMemSet  Label
bid Int
align CmmExpr
dst CmmExpr
c CmmExpr
n
genSimplePrim Label
_   CallishMachOp
MO_ReadBarrier       []      []             = 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 
genSimplePrim Label
_   CallishMachOp
MO_WriteBarrier      []      []             = 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 
genSimplePrim Label
_   CallishMachOp
MO_Touch             []      [CmmExpr
_]            = 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
genSimplePrim Label
_   (MO_Prefetch_Data Int
n) []      [CmmExpr
src]          = Int -> CmmExpr -> NatM (OrdList Instr)
genPrefetchData Int
n CmmExpr
src
genSimplePrim Label
_   (MO_BSwap Width
width)     [LocalReg
dst]   [CmmExpr
src]          = Width -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
genByteSwap Width
width LocalReg
dst CmmExpr
src
genSimplePrim Label
bid (MO_BRev Width
width)      [LocalReg
dst]   [CmmExpr
src]          = Label -> Width -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
genBitRev Label
bid Width
width LocalReg
dst CmmExpr
src
genSimplePrim Label
bid (MO_PopCnt Width
width)    [LocalReg
dst]   [CmmExpr
src]          = Label -> Width -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
genPopCnt Label
bid Width
width LocalReg
dst CmmExpr
src
genSimplePrim Label
bid (MO_Pdep Width
width)      [LocalReg
dst]   [CmmExpr
src,CmmExpr
mask]     = Label
-> Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genPdep Label
bid Width
width LocalReg
dst CmmExpr
src CmmExpr
mask
genSimplePrim Label
bid (MO_Pext Width
width)      [LocalReg
dst]   [CmmExpr
src,CmmExpr
mask]     = Label
-> Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genPext Label
bid Width
width LocalReg
dst CmmExpr
src CmmExpr
mask
genSimplePrim Label
bid (MO_Clz Width
width)       [LocalReg
dst]   [CmmExpr
src]          = Label -> Width -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
genClz Label
bid Width
width LocalReg
dst CmmExpr
src
genSimplePrim Label
bid (MO_UF_Conv Width
width)   [LocalReg
dst]   [CmmExpr
src]          = Label -> Width -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
genWordToFloat Label
bid Width
width LocalReg
dst CmmExpr
src
genSimplePrim Label
_   (MO_AtomicRead Width
w MemoryOrdering
mo)  [LocalReg
dst]  [CmmExpr
addr]         = Width
-> MemoryOrdering -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
genAtomicRead Width
w MemoryOrdering
mo LocalReg
dst CmmExpr
addr
genSimplePrim Label
_   (MO_AtomicWrite Width
w MemoryOrdering
mo) []     [CmmExpr
addr,CmmExpr
val]     = Width
-> MemoryOrdering -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genAtomicWrite Width
w MemoryOrdering
mo CmmExpr
addr CmmExpr
val
genSimplePrim Label
bid (MO_Cmpxchg Width
width)   [LocalReg
dst]   [CmmExpr
addr,CmmExpr
old,CmmExpr
new] = Label
-> Width
-> LocalReg
-> CmmExpr
-> CmmExpr
-> CmmExpr
-> NatM (OrdList Instr)
genCmpXchg Label
bid Width
width LocalReg
dst CmmExpr
addr CmmExpr
old CmmExpr
new
genSimplePrim Label
_   (MO_Xchg Width
width)      [LocalReg
dst]   [CmmExpr
addr, CmmExpr
value]  = Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genXchg Width
width LocalReg
dst CmmExpr
addr CmmExpr
value
genSimplePrim Label
_   (MO_AddWordC Width
w)      [LocalReg
r,LocalReg
c]   [CmmExpr
x,CmmExpr
y]          = Width
-> (Format -> Operand -> Operand -> Instr)
-> (Format -> Maybe (Operand -> Operand -> Instr))
-> Cond
-> LocalReg
-> LocalReg
-> CmmExpr
-> CmmExpr
-> NatM (OrdList Instr)
genAddSubRetCarry Width
w Format -> Operand -> Operand -> Instr
ADD_CC (Maybe (Operand -> Operand -> Instr)
-> Format -> Maybe (Operand -> Operand -> Instr)
forall a b. a -> b -> a
const Maybe (Operand -> Operand -> Instr)
forall a. Maybe a
Nothing) Cond
CARRY LocalReg
r LocalReg
c CmmExpr
x CmmExpr
y
genSimplePrim Label
_   (MO_SubWordC Width
w)      [LocalReg
r,LocalReg
c]   [CmmExpr
x,CmmExpr
y]          = Width
-> (Format -> Operand -> Operand -> Instr)
-> (Format -> Maybe (Operand -> Operand -> Instr))
-> Cond
-> LocalReg
-> LocalReg
-> CmmExpr
-> CmmExpr
-> NatM (OrdList Instr)
genAddSubRetCarry Width
w Format -> Operand -> Operand -> Instr
SUB_CC (Maybe (Operand -> Operand -> Instr)
-> Format -> Maybe (Operand -> Operand -> Instr)
forall a b. a -> b -> a
const Maybe (Operand -> Operand -> Instr)
forall a. Maybe a
Nothing) Cond
CARRY LocalReg
r LocalReg
c CmmExpr
x CmmExpr
y
genSimplePrim Label
_   (MO_AddIntC Width
w)       [LocalReg
r,LocalReg
c]   [CmmExpr
x,CmmExpr
y]          = Width
-> (Format -> Operand -> Operand -> Instr)
-> (Format -> Maybe (Operand -> Operand -> Instr))
-> Cond
-> LocalReg
-> LocalReg
-> CmmExpr
-> CmmExpr
-> NatM (OrdList Instr)
genAddSubRetCarry Width
w Format -> Operand -> Operand -> Instr
ADD_CC ((Operand -> Operand -> Instr)
-> Maybe (Operand -> Operand -> Instr)
forall a. a -> Maybe a
Just ((Operand -> Operand -> Instr)
 -> Maybe (Operand -> Operand -> Instr))
-> (Format -> Operand -> Operand -> Instr)
-> Format
-> Maybe (Operand -> Operand -> Instr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Operand -> Operand -> Instr
ADD_CC) Cond
OFLO  LocalReg
r LocalReg
c CmmExpr
x CmmExpr
y
genSimplePrim Label
_   (MO_SubIntC Width
w)       [LocalReg
r,LocalReg
c]   [CmmExpr
x,CmmExpr
y]          = Width
-> (Format -> Operand -> Operand -> Instr)
-> (Format -> Maybe (Operand -> Operand -> Instr))
-> Cond
-> LocalReg
-> LocalReg
-> CmmExpr
-> CmmExpr
-> NatM (OrdList Instr)
genAddSubRetCarry Width
w Format -> Operand -> Operand -> Instr
SUB_CC (Maybe (Operand -> Operand -> Instr)
-> Format -> Maybe (Operand -> Operand -> Instr)
forall a b. a -> b -> a
const Maybe (Operand -> Operand -> Instr)
forall a. Maybe a
Nothing) Cond
OFLO  LocalReg
r LocalReg
c CmmExpr
x CmmExpr
y
genSimplePrim Label
_   (MO_Add2 Width
w)          [LocalReg
h,LocalReg
l]   [CmmExpr
x,CmmExpr
y]          = Width
-> LocalReg
-> LocalReg
-> CmmExpr
-> CmmExpr
-> NatM (OrdList Instr)
genAddWithCarry Width
w LocalReg
h LocalReg
l CmmExpr
x CmmExpr
y
genSimplePrim Label
_   (MO_U_Mul2 Width
w)        [LocalReg
h,LocalReg
l]   [CmmExpr
x,CmmExpr
y]          = Width
-> LocalReg
-> LocalReg
-> CmmExpr
-> CmmExpr
-> NatM (OrdList Instr)
genUnsignedLargeMul Width
w LocalReg
h LocalReg
l CmmExpr
x CmmExpr
y
genSimplePrim Label
_   (MO_S_Mul2 Width
w)        [LocalReg
c,LocalReg
h,LocalReg
l] [CmmExpr
x,CmmExpr
y]          = Width
-> LocalReg
-> LocalReg
-> LocalReg
-> CmmExpr
-> CmmExpr
-> NatM (OrdList Instr)
genSignedLargeMul Width
w LocalReg
c LocalReg
h LocalReg
l CmmExpr
x CmmExpr
y
genSimplePrim Label
_   (MO_S_QuotRem Width
w)     [LocalReg
q,LocalReg
r]   [CmmExpr
x,CmmExpr
y]          = Width
-> Bool
-> LocalReg
-> LocalReg
-> Maybe CmmExpr
-> CmmExpr
-> CmmExpr
-> NatM (OrdList Instr)
genQuotRem Width
w Bool
True  LocalReg
q LocalReg
r Maybe CmmExpr
forall a. Maybe a
Nothing   CmmExpr
x  CmmExpr
y
genSimplePrim Label
_   (MO_U_QuotRem Width
w)     [LocalReg
q,LocalReg
r]   [CmmExpr
x,CmmExpr
y]          = Width
-> Bool
-> LocalReg
-> LocalReg
-> Maybe CmmExpr
-> CmmExpr
-> CmmExpr
-> NatM (OrdList Instr)
genQuotRem Width
w Bool
False LocalReg
q LocalReg
r Maybe CmmExpr
forall a. Maybe a
Nothing   CmmExpr
x  CmmExpr
y
genSimplePrim Label
_   (MO_U_QuotRem2 Width
w)    [LocalReg
q,LocalReg
r]   [CmmExpr
hx,CmmExpr
lx,CmmExpr
y]      = Width
-> Bool
-> LocalReg
-> LocalReg
-> Maybe CmmExpr
-> CmmExpr
-> CmmExpr
-> NatM (OrdList Instr)
genQuotRem Width
w Bool
False LocalReg
q LocalReg
r (CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
hx) CmmExpr
lx CmmExpr
y
genSimplePrim Label
_   CallishMachOp
MO_F32_Fabs          [LocalReg
dst]   [CmmExpr
src]          = Width -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
genFloatAbs Width
W32 LocalReg
dst CmmExpr
src
genSimplePrim Label
_   CallishMachOp
MO_F64_Fabs          [LocalReg
dst]   [CmmExpr
src]          = Width -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
genFloatAbs Width
W64 LocalReg
dst CmmExpr
src
genSimplePrim Label
_   CallishMachOp
MO_F32_Sqrt          [LocalReg
dst]   [CmmExpr
src]          = Format -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
genFloatSqrt Format
FF32 LocalReg
dst CmmExpr
src
genSimplePrim Label
_   CallishMachOp
MO_F64_Sqrt          [LocalReg
dst]   [CmmExpr
src]          = Format -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
genFloatSqrt Format
FF64 LocalReg
dst CmmExpr
src
genSimplePrim Label
bid CallishMachOp
MO_F32_Sin           [LocalReg
dst]   [CmmExpr
src]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"sinf") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F32_Cos           [LocalReg
dst]   [CmmExpr
src]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"cosf") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F32_Tan           [LocalReg
dst]   [CmmExpr
src]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"tanf") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F32_Exp           [LocalReg
dst]   [CmmExpr
src]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"expf") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F32_ExpM1         [LocalReg
dst]   [CmmExpr
src]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"expm1f") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F32_Log           [LocalReg
dst]   [CmmExpr
src]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"logf") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F32_Log1P         [LocalReg
dst]   [CmmExpr
src]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"log1pf") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F32_Asin          [LocalReg
dst]   [CmmExpr
src]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"asinf") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F32_Acos          [LocalReg
dst]   [CmmExpr
src]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"acosf") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F32_Atan          [LocalReg
dst]   [CmmExpr
src]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"atanf") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F32_Sinh          [LocalReg
dst]   [CmmExpr
src]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"sinhf") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F32_Cosh          [LocalReg
dst]   [CmmExpr
src]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"coshf") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F32_Tanh          [LocalReg
dst]   [CmmExpr
src]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"tanhf") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F32_Pwr           [LocalReg
dst]   [CmmExpr
x,CmmExpr
y]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"powf")  [LocalReg
dst] [CmmExpr
x,CmmExpr
y]
genSimplePrim Label
bid CallishMachOp
MO_F32_Asinh         [LocalReg
dst]   [CmmExpr
src]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"asinhf") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F32_Acosh         [LocalReg
dst]   [CmmExpr
src]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"acoshf") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F32_Atanh         [LocalReg
dst]   [CmmExpr
src]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"atanhf") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F64_Sin           [LocalReg
dst]   [CmmExpr
src]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"sin") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F64_Cos           [LocalReg
dst]   [CmmExpr
src]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"cos") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F64_Tan           [LocalReg
dst]   [CmmExpr
src]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"tan") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F64_Exp           [LocalReg
dst]   [CmmExpr
src]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"exp") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F64_ExpM1         [LocalReg
dst]   [CmmExpr
src]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"expm1") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F64_Log           [LocalReg
dst]   [CmmExpr
src]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"log") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F64_Log1P         [LocalReg
dst]   [CmmExpr
src]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"log1p") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F64_Asin          [LocalReg
dst]   [CmmExpr
src]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"asin") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F64_Acos          [LocalReg
dst]   [CmmExpr
src]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"acos") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F64_Atan          [LocalReg
dst]   [CmmExpr
src]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"atan") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F64_Sinh          [LocalReg
dst]   [CmmExpr
src]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"sinh") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F64_Cosh          [LocalReg
dst]   [CmmExpr
src]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"cosh") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F64_Tanh          [LocalReg
dst]   [CmmExpr
src]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"tanh") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F64_Pwr           [LocalReg
dst]   [CmmExpr
x,CmmExpr
y]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"pow")  [LocalReg
dst] [CmmExpr
x,CmmExpr
y]
genSimplePrim Label
bid CallishMachOp
MO_F64_Asinh         [LocalReg
dst]   [CmmExpr
src]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"asinh") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F64_Acosh         [LocalReg
dst]   [CmmExpr
src]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"acosh") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F64_Atanh         [LocalReg
dst]   [CmmExpr
src]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"atanh") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_SuspendThread     [LocalReg
tok]   [CmmExpr
rs,CmmExpr
i]         = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genRTSCCall Label
bid (String -> FastString
fsLit String
"suspendThread") [LocalReg
tok] [CmmExpr
rs,CmmExpr
i]
genSimplePrim Label
bid CallishMachOp
MO_ResumeThread      [LocalReg
rs]    [CmmExpr
tok]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genRTSCCall Label
bid (String -> FastString
fsLit String
"resumeThread") [LocalReg
rs] [CmmExpr
tok]
genSimplePrim Label
_   CallishMachOp
MO_I64_ToI           [LocalReg
dst]   [CmmExpr
src]          = LocalReg -> CmmExpr -> NatM (OrdList Instr)
genInt64ToInt LocalReg
dst CmmExpr
src
genSimplePrim Label
_   CallishMachOp
MO_I64_FromI         [LocalReg
dst]   [CmmExpr
src]          = LocalReg -> CmmExpr -> NatM (OrdList Instr)
genIntToInt64 LocalReg
dst CmmExpr
src
genSimplePrim Label
_   CallishMachOp
MO_W64_ToW           [LocalReg
dst]   [CmmExpr
src]          = LocalReg -> CmmExpr -> NatM (OrdList Instr)
genWord64ToWord LocalReg
dst CmmExpr
src
genSimplePrim Label
_   CallishMachOp
MO_W64_FromW         [LocalReg
dst]   [CmmExpr
src]          = LocalReg -> CmmExpr -> NatM (OrdList Instr)
genWordToWord64 LocalReg
dst CmmExpr
src
genSimplePrim Label
_   CallishMachOp
MO_x64_Neg           [LocalReg
dst]   [CmmExpr
src]          = LocalReg -> CmmExpr -> NatM (OrdList Instr)
genNeg64 LocalReg
dst CmmExpr
src
genSimplePrim Label
_   CallishMachOp
MO_x64_Add           [LocalReg
dst]   [CmmExpr
x,CmmExpr
y]          = LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genAdd64 LocalReg
dst CmmExpr
x CmmExpr
y
genSimplePrim Label
_   CallishMachOp
MO_x64_Sub           [LocalReg
dst]   [CmmExpr
x,CmmExpr
y]          = LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genSub64 LocalReg
dst CmmExpr
x CmmExpr
y
genSimplePrim Label
bid CallishMachOp
MO_x64_Mul           [LocalReg
dst]   [CmmExpr
x,CmmExpr
y]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genPrimCCall Label
bid (String -> FastString
fsLit String
"hs_mul64") [LocalReg
dst] [CmmExpr
x,CmmExpr
y]
genSimplePrim Label
bid CallishMachOp
MO_I64_Quot          [LocalReg
dst]   [CmmExpr
x,CmmExpr
y]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genPrimCCall Label
bid (String -> FastString
fsLit String
"hs_quotInt64") [LocalReg
dst] [CmmExpr
x,CmmExpr
y]
genSimplePrim Label
bid CallishMachOp
MO_I64_Rem           [LocalReg
dst]   [CmmExpr
x,CmmExpr
y]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genPrimCCall Label
bid (String -> FastString
fsLit String
"hs_remInt64") [LocalReg
dst] [CmmExpr
x,CmmExpr
y]
genSimplePrim Label
bid CallishMachOp
MO_W64_Quot          [LocalReg
dst]   [CmmExpr
x,CmmExpr
y]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genPrimCCall Label
bid (String -> FastString
fsLit String
"hs_quotWord64") [LocalReg
dst] [CmmExpr
x,CmmExpr
y]
genSimplePrim Label
bid CallishMachOp
MO_W64_Rem           [LocalReg
dst]   [CmmExpr
x,CmmExpr
y]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genPrimCCall Label
bid (String -> FastString
fsLit String
"hs_remWord64") [LocalReg
dst] [CmmExpr
x,CmmExpr
y]
genSimplePrim Label
_   CallishMachOp
MO_x64_And           [LocalReg
dst]   [CmmExpr
x,CmmExpr
y]          = LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genAnd64 LocalReg
dst CmmExpr
x CmmExpr
y
genSimplePrim Label
_   CallishMachOp
MO_x64_Or            [LocalReg
dst]   [CmmExpr
x,CmmExpr
y]          = LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genOr64  LocalReg
dst CmmExpr
x CmmExpr
y
genSimplePrim Label
_   CallishMachOp
MO_x64_Xor           [LocalReg
dst]   [CmmExpr
x,CmmExpr
y]          = LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genXor64 LocalReg
dst CmmExpr
x CmmExpr
y
genSimplePrim Label
_   CallishMachOp
MO_x64_Not           [LocalReg
dst]   [CmmExpr
src]          = LocalReg -> CmmExpr -> NatM (OrdList Instr)
genNot64 LocalReg
dst CmmExpr
src
genSimplePrim Label
bid CallishMachOp
MO_x64_Shl           [LocalReg
dst]   [CmmExpr
x,CmmExpr
n]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genPrimCCall Label
bid (String -> FastString
fsLit String
"hs_uncheckedShiftL64") [LocalReg
dst] [CmmExpr
x,CmmExpr
n]
genSimplePrim Label
bid CallishMachOp
MO_I64_Shr           [LocalReg
dst]   [CmmExpr
x,CmmExpr
n]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genPrimCCall Label
bid (String -> FastString
fsLit String
"hs_uncheckedIShiftRA64") [LocalReg
dst] [CmmExpr
x,CmmExpr
n]
genSimplePrim Label
bid CallishMachOp
MO_W64_Shr           [LocalReg
dst]   [CmmExpr
x,CmmExpr
n]          = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genPrimCCall Label
bid (String -> FastString
fsLit String
"hs_uncheckedShiftRL64") [LocalReg
dst] [CmmExpr
x,CmmExpr
n]
genSimplePrim Label
_   CallishMachOp
MO_x64_Eq            [LocalReg
dst]   [CmmExpr
x,CmmExpr
y]          = LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genEq64 LocalReg
dst CmmExpr
x CmmExpr
y
genSimplePrim Label
_   CallishMachOp
MO_x64_Ne            [LocalReg
dst]   [CmmExpr
x,CmmExpr
y]          = LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genNe64 LocalReg
dst CmmExpr
x CmmExpr
y
genSimplePrim Label
_   CallishMachOp
MO_I64_Ge            [LocalReg
dst]   [CmmExpr
x,CmmExpr
y]          = LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genGeInt64 LocalReg
dst CmmExpr
x CmmExpr
y
genSimplePrim Label
_   CallishMachOp
MO_I64_Gt            [LocalReg
dst]   [CmmExpr
x,CmmExpr
y]          = LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genGtInt64 LocalReg
dst CmmExpr
x CmmExpr
y
genSimplePrim Label
_   CallishMachOp
MO_I64_Le            [LocalReg
dst]   [CmmExpr
x,CmmExpr
y]          = LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genLeInt64 LocalReg
dst CmmExpr
x CmmExpr
y
genSimplePrim Label
_   CallishMachOp
MO_I64_Lt            [LocalReg
dst]   [CmmExpr
x,CmmExpr
y]          = LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genLtInt64 LocalReg
dst CmmExpr
x CmmExpr
y
genSimplePrim Label
_   CallishMachOp
MO_W64_Ge            [LocalReg
dst]   [CmmExpr
x,CmmExpr
y]          = LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genGeWord64 LocalReg
dst CmmExpr
x CmmExpr
y
genSimplePrim Label
_   CallishMachOp
MO_W64_Gt            [LocalReg
dst]   [CmmExpr
x,CmmExpr
y]          = LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genGtWord64 LocalReg
dst CmmExpr
x CmmExpr
y
genSimplePrim Label
_   CallishMachOp
MO_W64_Le            [LocalReg
dst]   [CmmExpr
x,CmmExpr
y]          = LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genLeWord64 LocalReg
dst CmmExpr
x CmmExpr
y
genSimplePrim Label
_   CallishMachOp
MO_W64_Lt            [LocalReg
dst]   [CmmExpr
x,CmmExpr
y]          = LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genLtWord64 LocalReg
dst CmmExpr
x CmmExpr
y
genSimplePrim Label
_   CallishMachOp
op                   [LocalReg]
dst     [CmmExpr]
args           = do
  Platform
platform <- NCGConfig -> Platform
ncgPlatform (NCGConfig -> Platform) -> NatM NCGConfig -> NatM Platform
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NatM NCGConfig
getConfig
  String -> SDoc -> NatM (OrdList Instr)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"genSimplePrim: unhandled primop" ((SDoc, [LocalReg], [SDoc]) -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CallishMachOp -> SDoc
pprCallishMachOp CallishMachOp
op, [LocalReg]
dst, (CmmExpr -> SDoc) -> [CmmExpr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform) [CmmExpr]
args))
evalArgs :: BlockId -> [CmmActual] -> NatM (InstrBlock, [CmmActual])
evalArgs :: Label -> [CmmExpr] -> NatM (OrdList Instr, [CmmExpr])
evalArgs Label
bid [CmmExpr]
actuals
  | (CmmExpr -> Bool) -> [CmmExpr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any CmmExpr -> Bool
mightContainMachOp [CmmExpr]
actuals = do
      [(OrdList Instr, CmmExpr)]
regs_blks <- (CmmExpr -> NatM (OrdList Instr, CmmExpr))
-> [CmmExpr] -> NatM [(OrdList Instr, CmmExpr)]
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 CmmExpr -> NatM (OrdList Instr, CmmExpr)
evalArg [CmmExpr]
actuals
      (OrdList Instr, [CmmExpr]) -> NatM (OrdList Instr, [CmmExpr])
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] -> OrdList Instr)
-> [OrdList Instr] -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ ((OrdList Instr, CmmExpr) -> OrdList Instr)
-> [(OrdList Instr, CmmExpr)] -> [OrdList Instr]
forall a b. (a -> b) -> [a] -> [b]
map (OrdList Instr, CmmExpr) -> OrdList Instr
forall a b. (a, b) -> a
fst [(OrdList Instr, CmmExpr)]
regs_blks, ((OrdList Instr, CmmExpr) -> CmmExpr)
-> [(OrdList Instr, CmmExpr)] -> [CmmExpr]
forall a b. (a -> b) -> [a] -> [b]
map (OrdList Instr, CmmExpr) -> CmmExpr
forall a b. (a, b) -> b
snd [(OrdList Instr, CmmExpr)]
regs_blks)
  | Bool
otherwise = (OrdList Instr, [CmmExpr]) -> NatM (OrdList Instr, [CmmExpr])
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr
forall a. OrdList a
nilOL, [CmmExpr]
actuals)
  where
    mightContainMachOp :: CmmExpr -> Bool
mightContainMachOp (CmmReg CmmReg
_)      = Bool
False
    mightContainMachOp (CmmRegOff CmmReg
_ Int
_) = Bool
False
    mightContainMachOp (CmmLit CmmLit
_)      = Bool
False
    mightContainMachOp CmmExpr
_               = Bool
True
    evalArg :: CmmActual -> NatM (InstrBlock, CmmExpr)
    evalArg :: CmmExpr -> NatM (OrdList Instr, CmmExpr)
evalArg CmmExpr
actual = do
        Platform
platform <- NatM Platform
getPlatform
        LocalReg
lreg <- CmmType -> NatM LocalReg
newLocalReg (CmmType -> NatM LocalReg) -> CmmType -> NatM LocalReg
forall a b. (a -> b) -> a -> b
$ Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
actual
        (OrdList Instr
instrs, Maybe Label
bid1) <- Label -> CmmNode O O -> NatM (OrdList Instr, Maybe Label)
forall (e :: Extensibility) (x :: Extensibility).
Label -> CmmNode e x -> NatM (OrdList Instr, Maybe Label)
stmtToInstrs Label
bid (CmmNode O O -> NatM (OrdList Instr, Maybe Label))
-> CmmNode O O -> NatM (OrdList Instr, Maybe Label)
forall a b. (a -> b) -> a -> b
$ CmmReg -> CmmExpr -> CmmNode O O
CmmAssign (LocalReg -> CmmReg
CmmLocal LocalReg
lreg) CmmExpr
actual
        
        Bool -> NatM ()
forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
massert (Maybe Label -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Label
bid1)
        (OrdList Instr, CmmExpr) -> NatM (OrdList Instr, CmmExpr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr
instrs, CmmReg -> CmmExpr
CmmReg (CmmReg -> CmmExpr) -> CmmReg -> CmmExpr
forall a b. (a -> b) -> a -> b
$ LocalReg -> CmmReg
CmmLocal LocalReg
lreg)
    newLocalReg :: CmmType -> NatM LocalReg
    newLocalReg :: CmmType -> NatM LocalReg
newLocalReg CmmType
ty = Unique -> CmmType -> LocalReg
LocalReg (Unique -> CmmType -> LocalReg)
-> NatM Unique -> NatM (CmmType -> LocalReg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NatM Unique
forall (m :: * -> *). MonadUnique m => m Unique
getUniqueM NatM (CmmType -> LocalReg) -> NatM CmmType -> NatM LocalReg
forall a b. NatM (a -> b) -> NatM a -> NatM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CmmType -> NatM CmmType
forall a. a -> NatM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CmmType
ty
genPrimCCall
  :: BlockId
  -> FastString
  -> [CmmFormal]
  -> [CmmActual]
  -> NatM InstrBlock
genPrimCCall :: Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genPrimCCall Label
bid FastString
lbl_txt [LocalReg]
dsts [CmmExpr]
args = do
  NCGConfig
config <- NatM NCGConfig
getConfig
  
  let lbl :: CLabel
lbl = UnitId -> FastString -> CLabel
mkCmmCodeLabel UnitId
primUnitId FastString
lbl_txt
  CmmExpr
addr <- NCGConfig -> ReferenceKind -> CLabel -> NatM CmmExpr
forall (m :: * -> *).
CmmMakeDynamicReferenceM m =>
NCGConfig -> ReferenceKind -> CLabel -> m CmmExpr
cmmMakeDynamicReference NCGConfig
config ReferenceKind
CallReference CLabel
lbl
  let conv :: ForeignConvention
conv = CCallConv
-> [ForeignHint]
-> [ForeignHint]
-> CmmReturnInfo
-> ForeignConvention
ForeignConvention CCallConv
CCallConv [] [] CmmReturnInfo
CmmMayReturn
  Label
-> CmmExpr
-> ForeignConvention
-> [LocalReg]
-> [CmmExpr]
-> NatM (OrdList Instr)
genCCall Label
bid CmmExpr
addr ForeignConvention
conv [LocalReg]
dsts [CmmExpr]
args
genLibCCall
  :: BlockId
  -> FastString
  -> [CmmFormal]
  -> [CmmActual]
  -> NatM InstrBlock
genLibCCall :: Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid FastString
lbl_txt [LocalReg]
dsts [CmmExpr]
args = do
  NCGConfig
config <- NatM NCGConfig
getConfig
  
  
  
  let lbl :: CLabel
lbl = FastString
-> Maybe Int -> ForeignLabelSource -> FunctionOrData -> CLabel
mkForeignLabel FastString
lbl_txt Maybe Int
forall a. Maybe a
Nothing ForeignLabelSource
ForeignLabelInThisPackage FunctionOrData
IsFunction
  CmmExpr
addr <- NCGConfig -> ReferenceKind -> CLabel -> NatM CmmExpr
forall (m :: * -> *).
CmmMakeDynamicReferenceM m =>
NCGConfig -> ReferenceKind -> CLabel -> m CmmExpr
cmmMakeDynamicReference NCGConfig
config ReferenceKind
CallReference CLabel
lbl
  let conv :: ForeignConvention
conv = CCallConv
-> [ForeignHint]
-> [ForeignHint]
-> CmmReturnInfo
-> ForeignConvention
ForeignConvention CCallConv
CCallConv [] [] CmmReturnInfo
CmmMayReturn
  Label
-> CmmExpr
-> ForeignConvention
-> [LocalReg]
-> [CmmExpr]
-> NatM (OrdList Instr)
genCCall Label
bid CmmExpr
addr ForeignConvention
conv [LocalReg]
dsts [CmmExpr]
args
genRTSCCall
  :: BlockId
  -> FastString
  -> [CmmFormal]
  -> [CmmActual]
  -> NatM InstrBlock
genRTSCCall :: Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genRTSCCall Label
bid FastString
lbl_txt [LocalReg]
dsts [CmmExpr]
args = do
  NCGConfig
config <- NatM NCGConfig
getConfig
  
  let lbl :: CLabel
lbl = FastString
-> Maybe Int -> ForeignLabelSource -> FunctionOrData -> CLabel
mkForeignLabel FastString
lbl_txt Maybe Int
forall a. Maybe a
Nothing ForeignLabelSource
ForeignLabelInThisPackage FunctionOrData
IsFunction
  CmmExpr
addr <- NCGConfig -> ReferenceKind -> CLabel -> NatM CmmExpr
forall (m :: * -> *).
CmmMakeDynamicReferenceM m =>
NCGConfig -> ReferenceKind -> CLabel -> m CmmExpr
cmmMakeDynamicReference NCGConfig
config ReferenceKind
CallReference CLabel
lbl
  let conv :: ForeignConvention
conv = CCallConv
-> [ForeignHint]
-> [ForeignHint]
-> CmmReturnInfo
-> ForeignConvention
ForeignConvention CCallConv
CCallConv [] [] CmmReturnInfo
CmmMayReturn
  Label
-> CmmExpr
-> ForeignConvention
-> [LocalReg]
-> [CmmExpr]
-> NatM (OrdList Instr)
genCCall Label
bid CmmExpr
addr ForeignConvention
conv [LocalReg]
dsts [CmmExpr]
args
genCCall
  :: BlockId
  -> CmmExpr
  -> ForeignConvention
  -> [CmmFormal]
  -> [CmmActual]
  -> NatM InstrBlock
genCCall :: Label
-> CmmExpr
-> ForeignConvention
-> [LocalReg]
-> [CmmExpr]
-> NatM (OrdList Instr)
genCCall Label
bid CmmExpr
addr ForeignConvention
conv [LocalReg]
dest_regs [CmmExpr]
args = do
  Bool
is32Bit <- NatM Bool
is32BitPlatform
  (OrdList Instr
instrs0, [CmmExpr]
args') <- Label -> [CmmExpr] -> NatM (OrdList Instr, [CmmExpr])
evalArgs Label
bid [CmmExpr]
args
  OrdList Instr
instrs1 <- if Bool
is32Bit
    then CmmExpr
-> ForeignConvention
-> [LocalReg]
-> [CmmExpr]
-> NatM (OrdList Instr)
genCCall32 CmmExpr
addr ForeignConvention
conv [LocalReg]
dest_regs [CmmExpr]
args'
    else CmmExpr
-> ForeignConvention
-> [LocalReg]
-> [CmmExpr]
-> NatM (OrdList Instr)
genCCall64 CmmExpr
addr ForeignConvention
conv [LocalReg]
dest_regs [CmmExpr]
args'
  OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr
instrs0 OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
instrs1)
genCCall32 :: CmmExpr           
           -> ForeignConvention 
           -> [CmmFormal]       
           -> [CmmActual]       
           -> NatM InstrBlock
genCCall32 :: CmmExpr
-> ForeignConvention
-> [LocalReg]
-> [CmmExpr]
-> NatM (OrdList Instr)
genCCall32 CmmExpr
addr ForeignConvention
conv [LocalReg]
dest_regs [CmmExpr]
args = do
        NCGConfig
config <- NatM NCGConfig
getConfig
        let platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
            prom_args :: [CmmExpr]
prom_args = (CmmExpr -> CmmExpr) -> [CmmExpr] -> [CmmExpr]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> Width -> CmmExpr -> CmmExpr
maybePromoteCArg Platform
platform Width
W32) [CmmExpr]
args
            
            arg_size_bytes :: CmmType -> Int
            arg_size_bytes :: CmmType -> Int
arg_size_bytes CmmType
ty = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Width -> Int
widthInBytes (CmmType -> Width
typeWidth CmmType
ty)) (Width -> Int
widthInBytes (Platform -> Width
wordWidth Platform
platform))
            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)
            push_arg :: CmmActual 
                            -> NatM InstrBlock  
            push_arg :: CmmExpr -> NatM (OrdList Instr)
push_arg  CmmExpr
arg 
              | CmmType -> Bool
isWord64 CmmType
arg_ty = do
                RegCode64 OrdList Instr
code Reg
r_hi Reg
r_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
arg
                Int
delta <- NatM Int
getDeltaNat
                Int -> NatM ()
setDeltaNat (Int
delta Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8)
                OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (       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 [Format -> Operand -> Instr
PUSH Format
II32 (Reg -> Operand
OpReg Reg
r_hi), Int -> Instr
DELTA (Int
delta Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4),
                                     Format -> Operand -> Instr
PUSH Format
II32 (Reg -> Operand
OpReg Reg
r_lo), Int -> Instr
DELTA (Int
delta Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8),
                                     Int -> Instr
DELTA (Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
8)]
                    )
              | CmmType -> Bool
isFloatType CmmType
arg_ty = do
                (Reg
reg, OrdList Instr
code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
arg
                Int
delta <- NatM Int
getDeltaNat
                Int -> NatM ()
setDeltaNat (Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
size)
                OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (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 [Format -> Operand -> Operand -> Instr
SUB Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
size)) (Reg -> Operand
OpReg Reg
esp),
                                      Int -> Instr
DELTA (Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
size),
                                      let addr :: AddrMode
addr = EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex (Reg -> EABase
EABaseReg Reg
esp)
                                                                EAIndex
EAIndexNone
                                                                (Int -> Imm
ImmInt Int
0)
                                          format :: Format
format = Width -> Format
floatFormat (CmmType -> Width
typeWidth CmmType
arg_ty)
                                      in
                                      
                                       Format -> Operand -> Operand -> Instr
MOV Format
format (Reg -> Operand
OpReg Reg
reg) (AddrMode -> Operand
OpAddr AddrMode
addr)
                                     ]
                               )
              | Bool
otherwise = do
                
                
                
                Bool -> NatM ()
forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
massert ((CmmType -> Width
typeWidth CmmType
arg_ty) Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
<= Width
W32)
                (Operand
operand, OrdList Instr
code) <- CmmExpr -> NatM (Operand, OrdList Instr)
getOperand CmmExpr
arg
                Int
delta <- NatM Int
getDeltaNat
                Int -> NatM ()
setDeltaNat (Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
size)
                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 -> Operand -> Instr
PUSH Format
II32 Operand
operand OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
                        Int -> Instr
DELTA (Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
size))
              where
                 arg_ty :: CmmType
arg_ty = Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
arg
                 size :: Int
size = CmmType -> Int
arg_size_bytes CmmType
arg_ty 
        let
            
            
            
            sizes :: [Int]
sizes               = (CmmExpr -> Int) -> [CmmExpr] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (CmmType -> Int
arg_size_bytes (CmmType -> Int) -> (CmmExpr -> CmmType) -> CmmExpr -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform) ([CmmExpr] -> [CmmExpr]
forall a. [a] -> [a]
reverse [CmmExpr]
args)
            raw_arg_size :: Int
raw_arg_size        = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
sizes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Platform -> Int
platformWordSizeInBytes Platform
platform
            arg_pad_size :: Int
arg_pad_size        = (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
raw_arg_size) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
raw_arg_size
            tot_arg_size :: Int
tot_arg_size        = Int
raw_arg_size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
arg_pad_size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Platform -> Int
platformWordSizeInBytes Platform
platform
        Int
delta0 <- NatM Int
getDeltaNat
        Int -> NatM ()
setDeltaNat (Int
delta0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
arg_pad_size)
        [OrdList Instr]
push_codes <- (CmmExpr -> NatM (OrdList Instr))
-> [CmmExpr] -> 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 CmmExpr -> NatM (OrdList Instr)
push_arg ([CmmExpr] -> [CmmExpr]
forall a. [a] -> [a]
reverse [CmmExpr]
prom_args)
        Int
delta <- NatM Int
getDeltaNat
        Bool -> NatM ()
forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
massert (Int
delta Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
delta0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
tot_arg_size)
        
        (OrdList Instr
callinsns,ForeignConvention
cconv) <-
          case CmmExpr
addr of
            CmmLit (CmmLabel CLabel
lbl)
               -> 
                  (OrdList Instr, ForeignConvention)
-> NatM (OrdList Instr, ForeignConvention)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Either Imm Reg -> [Reg] -> Instr
CALL (Imm -> Either Imm Reg
forall a b. a -> Either a b
Left Imm
fn_imm) []), ForeignConvention
conv)
               where fn_imm :: Imm
fn_imm = CLabel -> Imm
ImmCLbl CLabel
lbl
            CmmExpr
_
               -> do { (Reg
dyn_r, OrdList Instr
dyn_c) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
addr
                     ; Bool -> NatM ()
forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
massert (CmmType -> Bool
isWord32 (Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
addr))
                     ; (OrdList Instr, ForeignConvention)
-> NatM (OrdList Instr, ForeignConvention)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr
dyn_c OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Either Imm Reg -> [Reg] -> Instr
CALL (Reg -> Either Imm Reg
forall a b. b -> Either a b
Right Reg
dyn_r) [], ForeignConvention
conv) }
        let push_code :: OrdList Instr
push_code
                | Int
arg_pad_size Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
                = [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [Format -> Operand -> Operand -> Instr
SUB Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
arg_pad_size)) (Reg -> Operand
OpReg Reg
esp),
                        Int -> Instr
DELTA (Int
delta0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
arg_pad_size)]
                  OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [OrdList Instr] -> OrdList Instr
forall a. [OrdList a] -> OrdList a
concatOL [OrdList Instr]
push_codes
                | Bool
otherwise
                = [OrdList Instr] -> OrdList Instr
forall a. [OrdList a] -> OrdList a
concatOL [OrdList Instr]
push_codes
              
              
              
              
              
            pop_size :: Int
pop_size
               | ForeignConvention CCallConv
StdCallConv [ForeignHint]
_ [ForeignHint]
_ CmmReturnInfo
_ <- ForeignConvention
cconv = Int
arg_pad_size
               | Bool
otherwise = Int
tot_arg_size
            call :: OrdList Instr
call = OrdList Instr
callinsns OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                   [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL (
                      (if Int
pop_sizeInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0 then [] else
                       [Format -> Operand -> Operand -> Instr
ADD Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
pop_size)) (Reg -> Operand
OpReg Reg
esp)])
                      [Instr] -> [Instr] -> [Instr]
forall a. [a] -> [a] -> [a]
++
                      [Int -> Instr
DELTA Int
delta0]
                   )
        Int -> NatM ()
setDeltaNat Int
delta0
        let
            
            assign_code :: [LocalReg] -> OrdList Instr
assign_code []     = OrdList Instr
forall a. OrdList a
nilOL
            assign_code [LocalReg
dest]
              | CmmType -> Bool
isFloatType CmmType
ty =
                  
                  let tmp_amode :: AddrMode
tmp_amode = EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex (Reg -> EABase
EABaseReg Reg
esp)
                                                       EAIndex
EAIndexNone
                                                       (Int -> Imm
ImmInt Int
0)
                      fmt :: Format
fmt = Width -> Format
floatFormat Width
w
                         in [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Format -> Operand -> Operand -> Instr
SUB Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
b)) (Reg -> Operand
OpReg Reg
esp),
                                   Int -> Instr
DELTA (Int
delta0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
b),
                                   Format -> AddrMode -> Instr
X87Store Format
fmt  AddrMode
tmp_amode,
                                   
                                   
                                   
                                   
                                   Format -> Operand -> Operand -> Instr
MOV Format
fmt (AddrMode -> Operand
OpAddr AddrMode
tmp_amode) (Reg -> Operand
OpReg Reg
r_dest),
                                   Format -> Operand -> Operand -> Instr
ADD Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
b)) (Reg -> Operand
OpReg Reg
esp),
                                   Int -> Instr
DELTA Int
delta0]
              | CmmType -> Bool
isWord64 CmmType
ty    = [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
eax) (Reg -> Operand
OpReg Reg
r_dest),
                                        Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
edx) (Reg -> Operand
OpReg Reg
r_dest_hi)]
              | Bool
otherwise      = Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOV (Width -> Format
intFormat Width
w)
                                             (Reg -> Operand
OpReg Reg
eax)
                                             (Reg -> Operand
OpReg Reg
r_dest))
              where
                    ty :: CmmType
ty = LocalReg -> CmmType
localRegType LocalReg
dest
                    w :: Width
w  = CmmType -> Width
typeWidth CmmType
ty
                    b :: Int
b  = Width -> Int
widthInBytes Width
w
                    r_dest_hi :: Reg
r_dest_hi = Reg -> Reg
getHiVRegFromLo Reg
r_dest
                    r_dest :: Reg
r_dest    = LocalReg -> Reg
getLocalRegReg LocalReg
dest
            assign_code [LocalReg]
many = String -> SDoc -> OrdList Instr
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"genForeignCall.assign_code - too many return values:" ([LocalReg] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [LocalReg]
many)
        OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr
push_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                OrdList Instr
call OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                [LocalReg] -> OrdList Instr
assign_code [LocalReg]
dest_regs)
genCCall64 :: CmmExpr           
           -> ForeignConvention 
           -> [CmmFormal]       
           -> [CmmActual]       
           -> NatM InstrBlock
genCCall64 :: CmmExpr
-> ForeignConvention
-> [LocalReg]
-> [CmmExpr]
-> NatM (OrdList Instr)
genCCall64 CmmExpr
addr ForeignConvention
conv [LocalReg]
dest_regs [CmmExpr]
args = do
    Platform
platform <- NatM Platform
getPlatform
    
    let prom_args :: [CmmExpr]
prom_args = (CmmExpr -> CmmExpr) -> [CmmExpr] -> [CmmExpr]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> Width -> CmmExpr -> CmmExpr
maybePromoteCArg Platform
platform Width
W32) [CmmExpr]
args
    let load_args :: [CmmExpr]
                  -> [Reg]         
                  -> [Reg]         
                  -> InstrBlock    
                  -> InstrBlock    
                  -> NatM ([CmmExpr],[Reg],[Reg],InstrBlock,InstrBlock)
        
        load_args :: [CmmExpr]
-> [Reg]
-> [Reg]
-> OrdList Instr
-> OrdList Instr
-> NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
load_args [CmmExpr]
args [] [] OrdList Instr
code OrdList Instr
acode     =
            ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
-> NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([CmmExpr]
args, [], [], OrdList Instr
code, OrdList Instr
acode)
        
        load_args [] [Reg]
aregs [Reg]
fregs OrdList Instr
code OrdList Instr
acode =
            ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
-> NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [Reg]
aregs, [Reg]
fregs, OrdList Instr
code, OrdList Instr
acode)
        load_args (CmmExpr
arg : [CmmExpr]
rest) [Reg]
aregs [Reg]
fregs OrdList Instr
code OrdList Instr
acode
            | CmmType -> Bool
isFloatType CmmType
arg_rep = case [Reg]
fregs of
                 []     -> NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
push_this_arg
                 (Reg
r:[Reg]
rs) -> do
                    (OrdList Instr
code',OrdList Instr
acode') <- Reg -> NatM (OrdList Instr, OrdList Instr)
reg_this_arg Reg
r
                    [CmmExpr]
-> [Reg]
-> [Reg]
-> OrdList Instr
-> OrdList Instr
-> NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
load_args [CmmExpr]
rest [Reg]
aregs [Reg]
rs OrdList Instr
code' OrdList Instr
acode'
            | Bool
otherwise           = case [Reg]
aregs of
                 []     -> NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
push_this_arg
                 (Reg
r:[Reg]
rs) -> do
                    (OrdList Instr
code',OrdList Instr
acode') <- Reg -> NatM (OrdList Instr, OrdList Instr)
reg_this_arg Reg
r
                    [CmmExpr]
-> [Reg]
-> [Reg]
-> OrdList Instr
-> OrdList Instr
-> NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
load_args [CmmExpr]
rest [Reg]
rs [Reg]
fregs OrdList Instr
code' OrdList Instr
acode'
            where
              
              push_this_arg :: NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
push_this_arg = do
                 ([CmmExpr]
args',[Reg]
ars,[Reg]
frs,OrdList Instr
code',OrdList Instr
acode')
                     <- [CmmExpr]
-> [Reg]
-> [Reg]
-> OrdList Instr
-> OrdList Instr
-> NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
load_args [CmmExpr]
rest [Reg]
aregs [Reg]
fregs OrdList Instr
code OrdList Instr
acode
                 ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
-> NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (CmmExpr
argCmmExpr -> [CmmExpr] -> [CmmExpr]
forall a. a -> [a] -> [a]
:[CmmExpr]
args', [Reg]
ars, [Reg]
frs, OrdList Instr
code', OrdList Instr
acode')
              
              reg_this_arg :: Reg -> NatM (OrdList Instr, OrdList Instr)
reg_this_arg Reg
r
                
                | Platform -> CmmExpr -> Bool
isOperand Platform
platform CmmExpr
arg = do
                    Reg -> OrdList Instr
arg_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
arg
                    (OrdList Instr, OrdList Instr)
-> NatM (OrdList Instr, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr
code, (OrdList Instr
acode OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Reg -> OrdList Instr
arg_code Reg
r))
                
                
                | (CmmExpr -> Bool) -> [CmmExpr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Platform -> CmmExpr -> Bool
isOperand Platform
platform) [CmmExpr]
rest = do
                    Reg -> OrdList Instr
arg_code   <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
arg
                    (OrdList Instr, OrdList Instr)
-> NatM (OrdList Instr, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr
code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Reg -> OrdList Instr
arg_code Reg
r,OrdList Instr
acode)
                
                
                
                
                
                | Bool
otherwise     = do
                    Reg -> OrdList Instr
arg_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
arg
                    Reg
tmp      <- Format -> NatM Reg
getNewRegNat Format
arg_fmt
                    let
                      code' :: OrdList Instr
code'  = OrdList Instr
code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Reg -> OrdList Instr
arg_code Reg
tmp
                      acode' :: OrdList Instr
acode' = OrdList Instr
acode OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> Reg -> Instr
reg2reg Format
arg_fmt Reg
tmp Reg
r
                    (OrdList Instr, OrdList Instr)
-> NatM (OrdList Instr, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr
code',OrdList Instr
acode')
              arg_rep :: CmmType
arg_rep = Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
arg
              arg_fmt :: Format
arg_fmt = CmmType -> Format
cmmTypeFormat CmmType
arg_rep
        load_args_win :: [CmmExpr]
                      -> [Reg]        
                      -> [Reg]        
                      -> [(Reg, Reg)] 
                      -> InstrBlock
                      -> NatM ([CmmExpr],[Reg],[Reg],InstrBlock,InstrBlock)
        load_args_win :: [CmmExpr]
-> [Reg]
-> [Reg]
-> [(Reg, Reg)]
-> OrdList Instr
-> NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
load_args_win [CmmExpr]
args [Reg]
usedInt [Reg]
usedFP [] OrdList Instr
code
            = ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
-> NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([CmmExpr]
args, [Reg]
usedInt, [Reg]
usedFP, OrdList Instr
code, OrdList Instr
forall a. OrdList a
nilOL)
            
        load_args_win [] [Reg]
usedInt [Reg]
usedFP [(Reg, Reg)]
_ OrdList Instr
code
            = ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
-> NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [Reg]
usedInt, [Reg]
usedFP, OrdList Instr
code, OrdList Instr
forall a. OrdList a
nilOL)
            
        load_args_win (CmmExpr
arg : [CmmExpr]
rest) [Reg]
usedInt [Reg]
usedFP
                      ((Reg
ireg, Reg
freg) : [(Reg, Reg)]
regs) OrdList Instr
code
            | CmmType -> Bool
isFloatType CmmType
arg_rep = do
                 Reg -> OrdList Instr
arg_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
arg
                 [CmmExpr]
-> [Reg]
-> [Reg]
-> [(Reg, Reg)]
-> OrdList Instr
-> NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
load_args_win [CmmExpr]
rest (Reg
ireg Reg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
: [Reg]
usedInt) (Reg
freg Reg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
: [Reg]
usedFP) [(Reg, Reg)]
regs
                               (OrdList Instr
code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                                Reg -> OrdList Instr
arg_code Reg
freg OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
                                
                                
                                
                                Format -> Operand -> Operand -> Instr
MOV Format
II64 (Reg -> Operand
OpReg Reg
freg) (Reg -> Operand
OpReg Reg
ireg))
            | Bool
otherwise = do
                 Reg -> OrdList Instr
arg_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
arg
                 [CmmExpr]
-> [Reg]
-> [Reg]
-> [(Reg, Reg)]
-> OrdList Instr
-> NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
load_args_win [CmmExpr]
rest (Reg
ireg Reg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
: [Reg]
usedInt) [Reg]
usedFP [(Reg, Reg)]
regs
                               (OrdList Instr
code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Reg -> OrdList Instr
arg_code Reg
ireg)
            where
              arg_rep :: CmmType
arg_rep = Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
arg
        arg_size :: Int
arg_size = Int
8 
        push_args :: [CmmExpr] -> OrdList Instr -> NatM (OrdList Instr)
push_args [] OrdList Instr
code = OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return OrdList Instr
code
        push_args (CmmExpr
arg:[CmmExpr]
rest) OrdList Instr
code
           | CmmType -> Bool
isFloatType CmmType
arg_rep = do
             (Reg
arg_reg, OrdList Instr
arg_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
arg
             Int
delta <- NatM Int
getDeltaNat
             Int -> NatM ()
setDeltaNat (Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
arg_size)
             let code' :: OrdList Instr
code' = OrdList Instr
code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
arg_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 -> Operand -> Operand -> Instr
SUB (Width -> Format
intFormat (Platform -> Width
wordWidth Platform
platform)) (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
arg_size)) (Reg -> Operand
OpReg Reg
rsp),
                            Int -> Instr
DELTA (Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
arg_size),
                            Format -> Operand -> Operand -> Instr
MOV (Width -> Format
floatFormat Width
width) (Reg -> Operand
OpReg Reg
arg_reg) (AddrMode -> Operand
OpAddr (Platform -> Int -> AddrMode
spRel Platform
platform Int
0))]
             [CmmExpr] -> OrdList Instr -> NatM (OrdList Instr)
push_args [CmmExpr]
rest OrdList Instr
code'
           | Bool
otherwise = do
             
             
             
             Bool -> NatM ()
forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
massert (Width
width Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
<= Width
W64)
             (Operand
arg_op, OrdList Instr
arg_code) <- CmmExpr -> NatM (Operand, OrdList Instr)
getOperand CmmExpr
arg
             Int
delta <- NatM Int
getDeltaNat
             Int -> NatM ()
setDeltaNat (Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
arg_size)
             let code' :: OrdList Instr
code' = OrdList Instr
code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
arg_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 -> Operand -> Instr
PUSH Format
II64 Operand
arg_op,
                                    Int -> Instr
DELTA (Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
arg_size)]
             [CmmExpr] -> OrdList Instr -> NatM (OrdList Instr)
push_args [CmmExpr]
rest OrdList Instr
code'
            where
              arg_rep :: CmmType
arg_rep = Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
arg
              width :: Width
width = CmmType -> Width
typeWidth CmmType
arg_rep
        leaveStackSpace :: Int -> NatM (OrdList Instr)
leaveStackSpace Int
n = do
             Int
delta <- NatM Int
getDeltaNat
             Int -> NatM ()
setDeltaNat (Int
delta Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
arg_size)
             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 [
                         Format -> Operand -> Operand -> Instr
SUB Format
II64 (Imm -> Operand
OpImm (Int -> Imm
ImmInt (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Platform -> Int
platformWordSizeInBytes Platform
platform))) (Reg -> Operand
OpReg Reg
rsp),
                         Int -> Instr
DELTA (Int
delta Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
arg_size)]
    ([CmmExpr]
stack_args, [Reg]
int_regs_used, [Reg]
fp_regs_used, OrdList Instr
load_args_code, OrdList Instr
assign_args_code)
         <-
        if Platform -> OS
platformOS Platform
platform OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSMinGW32
        then [CmmExpr]
-> [Reg]
-> [Reg]
-> [(Reg, Reg)]
-> OrdList Instr
-> NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
load_args_win [CmmExpr]
prom_args [] [] (Platform -> [(Reg, Reg)]
allArgRegs Platform
platform) OrdList Instr
forall a. OrdList a
nilOL
        else do
           ([CmmExpr]
stack_args, [Reg]
aregs, [Reg]
fregs, OrdList Instr
load_args_code, OrdList Instr
assign_args_code)
               <- [CmmExpr]
-> [Reg]
-> [Reg]
-> OrdList Instr
-> OrdList Instr
-> NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
load_args [CmmExpr]
prom_args (Platform -> [Reg]
allIntArgRegs Platform
platform)
                                      (Platform -> [Reg]
allFPArgRegs Platform
platform)
                                      OrdList Instr
forall a. OrdList a
nilOL OrdList Instr
forall a. OrdList a
nilOL
           let used_regs :: t a -> [a] -> [a]
used_regs t a
rs [a]
as = [a] -> [a]
forall a. [a] -> [a]
reverse (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (t a -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
rs) ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
as))
               fregs_used :: [Reg]
fregs_used      = [Reg] -> [Reg] -> [Reg]
forall {t :: * -> *} {a} {a}. Foldable t => t a -> [a] -> [a]
used_regs [Reg]
fregs (Platform -> [Reg]
allFPArgRegs Platform
platform)
               aregs_used :: [Reg]
aregs_used      = [Reg] -> [Reg] -> [Reg]
forall {t :: * -> *} {a} {a}. Foldable t => t a -> [a] -> [a]
used_regs [Reg]
aregs (Platform -> [Reg]
allIntArgRegs Platform
platform)
           ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
-> NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([CmmExpr]
stack_args, [Reg]
aregs_used, [Reg]
fregs_used, OrdList Instr
load_args_code
                                                      , OrdList Instr
assign_args_code)
    let
        arg_regs_used :: [Reg]
arg_regs_used = [Reg]
int_regs_used [Reg] -> [Reg] -> [Reg]
forall a. [a] -> [a] -> [a]
++ [Reg]
fp_regs_used
        arg_regs :: [Reg]
arg_regs = [Reg
eax] [Reg] -> [Reg] -> [Reg]
forall a. [a] -> [a] -> [a]
++ [Reg]
arg_regs_used
                
        sse_regs :: Int
sse_regs = [Reg] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Reg]
fp_regs_used
        arg_stack_slots :: Int
arg_stack_slots = if Platform -> OS
platformOS Platform
platform OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSMinGW32
                          then [CmmExpr] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CmmExpr]
stack_args Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [(Reg, Reg)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Platform -> [(Reg, Reg)]
allArgRegs Platform
platform)
                          else [CmmExpr] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CmmExpr]
stack_args
        tot_arg_size :: Int
tot_arg_size = Int
arg_size Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
arg_stack_slots
    
    
    
    let word_size :: Int
word_size = Platform -> Int
platformWordSizeInBytes Platform
platform
    (Int
real_size, OrdList Instr
adjust_rsp) <-
        if (Int
tot_arg_size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
word_size) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
16 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
            then (Int, OrdList Instr) -> NatM (Int, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
tot_arg_size, OrdList Instr
forall a. OrdList a
nilOL)
            else do 
                Int
delta <- NatM Int
getDeltaNat
                Int -> NatM ()
setDeltaNat (Int
delta Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
word_size)
                (Int, OrdList Instr) -> NatM (Int, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
tot_arg_size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
word_size, [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [
                                Format -> Operand -> Operand -> Instr
SUB Format
II64 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
word_size)) (Reg -> Operand
OpReg Reg
rsp),
                                Int -> Instr
DELTA (Int
delta Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
word_size) ])
    
    OrdList Instr
push_code <- [CmmExpr] -> OrdList Instr -> NatM (OrdList Instr)
push_args ([CmmExpr] -> [CmmExpr]
forall a. [a] -> [a]
reverse [CmmExpr]
stack_args) OrdList Instr
forall a. OrdList a
nilOL
    
    
    OrdList Instr
lss_code <- if Platform -> OS
platformOS Platform
platform OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSMinGW32
                then Int -> NatM (OrdList Instr)
leaveStackSpace ([(Reg, Reg)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Platform -> [(Reg, Reg)]
allArgRegs Platform
platform))
                else 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
    Int
delta <- NatM Int
getDeltaNat
    
    (OrdList Instr
callinsns,ForeignConvention
_cconv) <- case CmmExpr
addr of
      CmmLit (CmmLabel CLabel
lbl) ->
        
        (OrdList Instr, ForeignConvention)
-> NatM (OrdList Instr, ForeignConvention)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Either Imm Reg -> [Reg] -> Instr
CALL (Imm -> Either Imm Reg
forall a b. a -> Either a b
Left (CLabel -> Imm
ImmCLbl CLabel
lbl)) [Reg]
arg_regs), ForeignConvention
conv)
      CmmExpr
_ -> do
        (Reg
dyn_r, OrdList Instr
dyn_c) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
addr
        (OrdList Instr, ForeignConvention)
-> NatM (OrdList Instr, ForeignConvention)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr
dyn_c OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Either Imm Reg -> [Reg] -> Instr
CALL (Reg -> Either Imm Reg
forall a b. b -> Either a b
Right Reg
dyn_r) [Reg]
arg_regs, ForeignConvention
conv)
    let
        
        
        
        
        
        
        
        
        assign_eax :: Int -> OrdList Instr
assign_eax Int
n = Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOV Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
n)) (Reg -> Operand
OpReg Reg
eax))
    let call :: OrdList Instr
call = OrdList Instr
callinsns OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
               [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL (
                    
                    
                    
                  (if Int
real_sizeInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0 then [] else
                   [Format -> Operand -> Operand -> Instr
ADD (Width -> Format
intFormat (Platform -> Width
platformWordWidth Platform
platform)) (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
real_size)) (Reg -> Operand
OpReg Reg
esp)])
                  [Instr] -> [Instr] -> [Instr]
forall a. [a] -> [a] -> [a]
++
                  [Int -> Instr
DELTA (Int
delta Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
real_size)]
               )
    Int -> NatM ()
setDeltaNat (Int
delta Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
real_size)
    let
        
        assign_code :: [LocalReg] -> OrdList Instr
assign_code []     = OrdList Instr
forall a. OrdList a
nilOL
        assign_code [LocalReg
dest] =
          case CmmType -> Width
typeWidth CmmType
rep of
                Width
W32 | CmmType -> Bool
isFloatType CmmType
rep -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOV (Width -> Format
floatFormat Width
W32)
                                                     (Reg -> Operand
OpReg Reg
xmm0)
                                                     (Reg -> Operand
OpReg Reg
r_dest))
                Width
W64 | CmmType -> Bool
isFloatType CmmType
rep -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOV (Width -> Format
floatFormat Width
W64)
                                                     (Reg -> Operand
OpReg Reg
xmm0)
                                                     (Reg -> Operand
OpReg Reg
r_dest))
                Width
_ -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOV (CmmType -> Format
cmmTypeFormat CmmType
rep) (Reg -> Operand
OpReg Reg
rax) (Reg -> Operand
OpReg Reg
r_dest))
          where
                rep :: CmmType
rep = LocalReg -> CmmType
localRegType LocalReg
dest
                r_dest :: Reg
r_dest = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform  (LocalReg -> CmmReg
CmmLocal LocalReg
dest)
        assign_code [LocalReg]
_many = String -> OrdList Instr
forall a. String -> a
panic String
"genForeignCall.assign_code many"
    OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr
adjust_rsp          OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
            OrdList Instr
push_code           OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
            OrdList Instr
load_args_code      OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
            OrdList Instr
assign_args_code    OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
            OrdList Instr
lss_code            OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
            Int -> OrdList Instr
assign_eax Int
sse_regs OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
            OrdList Instr
call                OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
            [LocalReg] -> OrdList Instr
assign_code [LocalReg]
dest_regs)
maybePromoteCArg :: Platform -> Width -> CmmExpr -> CmmExpr
maybePromoteCArg :: Platform -> Width -> CmmExpr -> CmmExpr
maybePromoteCArg Platform
platform Width
wto CmmExpr
arg
 | Width
wfrom Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
< Width
wto = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> Width -> MachOp
MO_UU_Conv Width
wfrom Width
wto) [CmmExpr
arg]
 | Bool
otherwise   = CmmExpr
arg
 where
   wfrom :: Width
wfrom = Platform -> CmmExpr -> Width
cmmExprWidth Platform
platform CmmExpr
arg
genSwitch :: CmmExpr -> SwitchTargets -> NatM InstrBlock
genSwitch :: CmmExpr -> SwitchTargets -> NatM (OrdList Instr)
genSwitch CmmExpr
expr SwitchTargets
targets = do
  NCGConfig
config <- NatM NCGConfig
getConfig
  let platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
      expr_w :: Width
expr_w = Platform -> CmmExpr -> Width
cmmExprWidth Platform
platform CmmExpr
expr
      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]
  if NCGConfig -> Bool
ncgPIC NCGConfig
config
  then do
        (Reg
reg,OrdList Instr
e_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getNonClobberedReg CmmExpr
indexExpr
           
        CLabel
lbl <- NatM CLabel
getNewLabelNat
        let is32bit :: Bool
is32bit = Platform -> Bool
target32Bit Platform
platform
            os :: OS
os = Platform -> OS
platformOS Platform
platform
            
            
            
            rosection :: Section
rosection = case OS
os of
              
              
              
              
              
              OS
OSDarwin | Bool -> Bool
not Bool
is32bit -> SectionType -> CLabel -> Section
Section SectionType
Text CLabel
lbl
              OS
_ -> SectionType -> CLabel -> Section
Section SectionType
ReadOnlyData CLabel
lbl
        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 op :: Operand
op = AddrMode -> Operand
OpAddr (EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex (Reg -> EABase
EABaseReg Reg
tableReg)
                                       (Reg -> Int -> EAIndex
EAIndex Reg
reg (Platform -> Int
platformWordSizeInBytes Platform
platform)) (Int -> Imm
ImmInt Int
0))
        Reg
offsetReg <- Format -> NatM Reg
getNewRegNat (Width -> Format
intFormat (Platform -> Width
platformWordWidth Platform
platform))
        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
$ if Bool
is32bit Bool -> Bool -> Bool
|| OS
os OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSDarwin
                 then 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 -> Operand -> Operand -> Instr
ADD (Width -> Format
intFormat (Platform -> Width
platformWordWidth Platform
platform)) Operand
op (Reg -> Operand
OpReg Reg
tableReg),
                                Operand -> [Maybe JumpDest] -> Section -> CLabel -> Instr
JMP_TBL (Reg -> Operand
OpReg Reg
tableReg) [Maybe JumpDest]
ids Section
rosection CLabel
lbl
                       ]
                 else 
                      
                      
                      
                      
                      
                      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 -> Operand -> Operand -> Instr
MOVSxL Format
II32 Operand
op (Reg -> Operand
OpReg Reg
offsetReg),
                               Format -> Operand -> Operand -> Instr
ADD (Width -> Format
intFormat (Platform -> Width
platformWordWidth Platform
platform))
                                   (Reg -> Operand
OpReg Reg
offsetReg)
                                   (Reg -> Operand
OpReg Reg
tableReg),
                               Operand -> [Maybe JumpDest] -> Section -> CLabel -> Instr
JMP_TBL (Reg -> Operand
OpReg Reg
tableReg) [Maybe JumpDest]
ids Section
rosection CLabel
lbl
                       ]
  else do
        (Reg
reg,OrdList Instr
e_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
indexExpr
        CLabel
lbl <- NatM CLabel
getNewLabelNat
        let is32bit :: Bool
is32bit = Platform -> Bool
target32Bit Platform
platform
        if Bool
is32bit
          then let op :: Operand
op = AddrMode -> Operand
OpAddr (EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex EABase
EABaseNone (Reg -> Int -> EAIndex
EAIndex Reg
reg (Platform -> Int
platformWordSizeInBytes Platform
platform)) (CLabel -> Imm
ImmCLbl CLabel
lbl))
                   jmp_code :: Instr
jmp_code = Operand -> [Maybe JumpDest] -> Section -> CLabel -> Instr
JMP_TBL Operand
op [Maybe JumpDest]
ids (SectionType -> CLabel -> Section
Section SectionType
ReadOnlyData CLabel
lbl) CLabel
lbl
               in 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
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
unitOL Instr
jmp_code
          else do
            
            Reg
tableReg <- Format -> NatM Reg
getNewRegNat (Width -> Format
intFormat (Platform -> Width
platformWordWidth Platform
platform))
            Reg
targetReg <- Format -> NatM Reg
getNewRegNat (Width -> Format
intFormat (Platform -> Width
platformWordWidth Platform
platform))
            let op :: Operand
op = AddrMode -> Operand
OpAddr (EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex (Reg -> EABase
EABaseReg Reg
tableReg) (Reg -> Int -> EAIndex
EAIndex Reg
reg (Platform -> Int
platformWordSizeInBytes Platform
platform)) (Int -> Imm
ImmInt Int
0))
                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 -> Operand -> Operand -> Instr
LEA (Bool -> Format
archWordFormat Bool
is32bit) (AddrMode -> Operand
OpAddr (EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex EABase
EABaseRip EAIndex
EAIndexNone (CLabel -> Imm
ImmCLbl CLabel
lbl))) (Reg -> Operand
OpReg Reg
tableReg)
                    , Format -> Operand -> Operand -> Instr
MOV (Bool -> Format
archWordFormat Bool
is32bit) Operand
op (Reg -> Operand
OpReg Reg
targetReg)
                    , Operand -> [Maybe JumpDest] -> Section -> CLabel -> Instr
JMP_TBL (Reg -> Operand
OpReg Reg
targetReg) [Maybe JumpDest]
ids (SectionType -> CLabel -> Section
Section SectionType
ReadOnlyData CLabel
lbl) 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
    (Int
offset, [Maybe Label]
blockIds) = SwitchTargets -> (Int, [Maybe Label])
switchTargetsToTable SwitchTargets
targets
    ids :: [Maybe JumpDest]
ids = (Maybe Label -> Maybe JumpDest)
-> [Maybe Label] -> [Maybe JumpDest]
forall a b. (a -> b) -> [a] -> [b]
map ((Label -> JumpDest) -> Maybe Label -> Maybe JumpDest
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Label -> JumpDest
DestBlockId) [Maybe Label]
blockIds
generateJumpTableForInstr :: NCGConfig -> Instr -> Maybe (NatCmmDecl (Alignment, RawCmmStatics) Instr)
generateJumpTableForInstr :: NCGConfig
-> Instr -> Maybe (NatCmmDecl (Alignment, RawCmmStatics) Instr)
generateJumpTableForInstr NCGConfig
config (JMP_TBL Operand
_ [Maybe JumpDest]
ids Section
section CLabel
lbl)
    = let getBlockId :: JumpDest -> Label
getBlockId (DestBlockId Label
id) = Label
id
          getBlockId JumpDest
_ = String -> Label
forall a. String -> a
panic String
"Non-Label target in Jump Table"
          blockIds :: [Maybe Label]
blockIds = (Maybe JumpDest -> Maybe Label)
-> [Maybe JumpDest] -> [Maybe Label]
forall a b. (a -> b) -> [a] -> [b]
map ((JumpDest -> Label) -> Maybe JumpDest -> Maybe Label
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JumpDest -> Label
getBlockId) [Maybe JumpDest]
ids
      in NatCmmDecl (Alignment, RawCmmStatics) Instr
-> Maybe (NatCmmDecl (Alignment, RawCmmStatics) Instr)
forall a. a -> Maybe a
Just (NCGConfig
-> [Maybe Label]
-> Section
-> CLabel
-> NatCmmDecl (Alignment, RawCmmStatics) Instr
forall h g.
NCGConfig
-> [Maybe Label]
-> Section
-> CLabel
-> GenCmmDecl (Alignment, RawCmmStatics) h g
createJumpTable NCGConfig
config [Maybe Label]
blockIds Section
section CLabel
lbl)
generateJumpTableForInstr NCGConfig
_ Instr
_ = Maybe (NatCmmDecl (Alignment, RawCmmStatics) Instr)
forall a. Maybe a
Nothing
createJumpTable :: NCGConfig -> [Maybe BlockId] -> Section -> CLabel
                -> GenCmmDecl (Alignment, RawCmmStatics) h g
createJumpTable :: forall h g.
NCGConfig
-> [Maybe Label]
-> Section
-> CLabel
-> GenCmmDecl (Alignment, RawCmmStatics) h g
createJumpTable NCGConfig
config [Maybe Label]
ids Section
section CLabel
lbl
    = let jumpTable :: [CmmStatic]
jumpTable
            | NCGConfig -> Bool
ncgPIC NCGConfig
config =
                  let ww :: Width
ww = NCGConfig -> Width
ncgWordWidth NCGConfig
config
                      jumpTableEntryRel :: Maybe Label -> CmmStatic
jumpTableEntryRel Maybe Label
Nothing
                          = CmmLit -> CmmStatic
CmmStaticLit (Integer -> Width -> CmmLit
CmmInt Integer
0 Width
ww)
                      jumpTableEntryRel (Just Label
blockid)
                          = CmmLit -> CmmStatic
CmmStaticLit (CLabel -> CLabel -> Int -> Width -> CmmLit
CmmLabelDiffOff CLabel
blockLabel CLabel
lbl Int
0 Width
ww)
                          where blockLabel :: CLabel
blockLabel = Label -> CLabel
blockLbl Label
blockid
                  in (Maybe Label -> CmmStatic) -> [Maybe Label] -> [CmmStatic]
forall a b. (a -> b) -> [a] -> [b]
map Maybe Label -> CmmStatic
jumpTableEntryRel [Maybe Label]
ids
            | Bool
otherwise = (Maybe Label -> CmmStatic) -> [Maybe Label] -> [CmmStatic]
forall a b. (a -> b) -> [a] -> [b]
map (NCGConfig -> Maybe Label -> CmmStatic
jumpTableEntry NCGConfig
config) [Maybe Label]
ids
      in Section
-> (Alignment, RawCmmStatics)
-> GenCmmDecl (Alignment, RawCmmStatics) h g
forall d h g. Section -> d -> GenCmmDecl d h g
CmmData Section
section (Int -> Alignment
mkAlignment Int
1, CLabel -> [CmmStatic] -> RawCmmStatics
forall (rawOnly :: Bool).
CLabel -> [CmmStatic] -> GenCmmStatics rawOnly
CmmStaticsRaw CLabel
lbl [CmmStatic]
jumpTable)
extractUnwindPoints :: [Instr] -> [UnwindPoint]
 [Instr]
instrs =
    [ CLabel -> Map GlobalReg (Maybe UnwindExpr) -> UnwindPoint
UnwindPoint CLabel
lbl Map GlobalReg (Maybe UnwindExpr)
unwinds | UNWIND CLabel
lbl Map GlobalReg (Maybe UnwindExpr)
unwinds <- [Instr]
instrs]
condIntReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register
condIntReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register
condIntReg Cond
cond CmmExpr
x CmmExpr
y = do
  CondCode Bool
_ Cond
cond OrdList Instr
cond_code <- Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode Cond
cond CmmExpr
x CmmExpr
y
  Reg
tmp <- Format -> NatM Reg
getNewRegNat Format
II8
  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` [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [
                    Cond -> Operand -> Instr
SETCC Cond
cond (Reg -> Operand
OpReg Reg
tmp),
                    Format -> Operand -> Operand -> Instr
MOVZxL Format
II8 (Reg -> Operand
OpReg Reg
tmp) (Reg -> Operand
OpReg 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
II32 Reg -> OrdList Instr
code)
condFltReg :: Bool -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condFltReg :: Bool -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condFltReg Bool
is32Bit Cond
cond CmmExpr
x CmmExpr
y = NatM Register
condFltReg_sse2
 where
  condFltReg_sse2 :: NatM Register
condFltReg_sse2 = do
    CondCode Bool
_ Cond
cond OrdList Instr
cond_code <- Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
cond CmmExpr
x CmmExpr
y
    Reg
tmp1 <- Format -> NatM Reg
getNewRegNat (Bool -> Format
archWordFormat Bool
is32Bit)
    Reg
tmp2 <- Format -> NatM Reg
getNewRegNat (Bool -> Format
archWordFormat Bool
is32Bit)
    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`
             (case Cond
cond of
                Cond
NE  -> Reg -> OrdList Instr
or_unordered Reg
dst
                Cond
GU  -> Reg -> OrdList Instr
plain_test   Reg
dst
                Cond
GEU -> Reg -> OrdList Instr
plain_test   Reg
dst
                
                Cond
LTT -> Bool -> SDoc -> OrdList Instr -> OrdList Instr
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr Bool
False (String -> SDoc
forall a. Outputable a => a -> SDoc
ppr String
"Should have been turned into >") (OrdList Instr -> OrdList Instr) -> OrdList Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$
                       Reg -> OrdList Instr
and_ordered  Reg
dst
                Cond
LE  -> Bool -> SDoc -> OrdList Instr -> OrdList Instr
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr Bool
False (String -> SDoc
forall a. Outputable a => a -> SDoc
ppr String
"Should have been turned into >=") (OrdList Instr -> OrdList Instr) -> OrdList Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$
                       Reg -> OrdList Instr
and_ordered  Reg
dst
                Cond
_   -> Reg -> OrdList Instr
and_ordered  Reg
dst)
        plain_test :: Reg -> OrdList Instr
plain_test Reg
dst = [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [
                    Cond -> Operand -> Instr
SETCC Cond
cond (Reg -> Operand
OpReg Reg
tmp1),
                    Format -> Operand -> Operand -> Instr
MOVZxL Format
II8 (Reg -> Operand
OpReg Reg
tmp1) (Reg -> Operand
OpReg Reg
dst)
                 ]
        or_unordered :: Reg -> OrdList Instr
or_unordered Reg
dst = [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [
                    Cond -> Operand -> Instr
SETCC Cond
cond (Reg -> Operand
OpReg Reg
tmp1),
                    Cond -> Operand -> Instr
SETCC Cond
PARITY (Reg -> Operand
OpReg Reg
tmp2),
                    Format -> Operand -> Operand -> Instr
OR Format
II8 (Reg -> Operand
OpReg Reg
tmp1) (Reg -> Operand
OpReg Reg
tmp2),
                    Format -> Operand -> Operand -> Instr
MOVZxL Format
II8 (Reg -> Operand
OpReg Reg
tmp2) (Reg -> Operand
OpReg Reg
dst)
                  ]
        and_ordered :: Reg -> OrdList Instr
and_ordered Reg
dst = [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [
                    Cond -> Operand -> Instr
SETCC Cond
cond (Reg -> Operand
OpReg Reg
tmp1),
                    Cond -> Operand -> Instr
SETCC Cond
NOTPARITY (Reg -> Operand
OpReg Reg
tmp2),
                    Format -> Operand -> Operand -> Instr
AND Format
II8 (Reg -> Operand
OpReg Reg
tmp1) (Reg -> Operand
OpReg Reg
tmp2),
                    Format -> Operand -> Operand -> Instr
MOVZxL Format
II8 (Reg -> Operand
OpReg Reg
tmp2) (Reg -> Operand
OpReg 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
II32 Reg -> OrdList Instr
code)
trivialCode :: Width -> (Operand -> Operand -> Instr)
            -> Maybe (Operand -> Operand -> Instr)
            -> CmmExpr -> CmmExpr -> NatM Register
trivialCode :: Width
-> (Operand -> Operand -> Instr)
-> Maybe (Operand -> Operand -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialCode Width
width Operand -> Operand -> Instr
instr Maybe (Operand -> Operand -> Instr)
m CmmExpr
a CmmExpr
b
    = do Platform
platform <- NatM Platform
getPlatform
         Platform
-> Width
-> (Operand -> Operand -> Instr)
-> Maybe (Operand -> Operand -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialCode' Platform
platform Width
width Operand -> Operand -> Instr
instr Maybe (Operand -> Operand -> Instr)
m CmmExpr
a CmmExpr
b
trivialCode' :: Platform -> Width -> (Operand -> Operand -> Instr)
             -> Maybe (Operand -> Operand -> Instr)
             -> CmmExpr -> CmmExpr -> NatM Register
trivialCode' :: Platform
-> Width
-> (Operand -> Operand -> Instr)
-> Maybe (Operand -> Operand -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialCode' Platform
platform Width
width Operand -> Operand -> Instr
_ (Just Operand -> Operand -> Instr
revinstr) (CmmLit CmmLit
lit_a) CmmExpr
b
  | Platform -> CmmLit -> Bool
is32BitLit Platform
platform CmmLit
lit_a = do
  Reg -> OrdList Instr
b_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
b
  let
       code :: Reg -> OrdList Instr
code Reg
dst
         = Reg -> OrdList Instr
b_code Reg
dst OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
           Operand -> Operand -> Instr
revinstr (Imm -> Operand
OpImm (CmmLit -> Imm
litToImm CmmLit
lit_a)) (Reg -> Operand
OpReg 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 (Width -> Format
intFormat Width
width) Reg -> OrdList Instr
code)
trivialCode' Platform
_ Width
width Operand -> Operand -> Instr
instr Maybe (Operand -> Operand -> Instr)
_ CmmExpr
a CmmExpr
b
  = Format
-> (Operand -> Operand -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
genTrivialCode (Width -> Format
intFormat Width
width) Operand -> Operand -> Instr
instr CmmExpr
a CmmExpr
b
genTrivialCode :: Format -> (Operand -> Operand -> Instr)
               -> CmmExpr -> CmmExpr -> NatM Register
genTrivialCode :: Format
-> (Operand -> Operand -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
genTrivialCode Format
rep Operand -> Operand -> Instr
instr CmmExpr
a CmmExpr
b = do
  (Operand
b_op, OrdList Instr
b_code) <- CmmExpr -> NatM (Operand, OrdList Instr)
getNonClobberedOperand CmmExpr
b
  Reg -> OrdList Instr
a_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
a
  Reg
tmp <- Format -> NatM Reg
getNewRegNat Format
rep
  let
     
     
     
     
     
     
     code :: Reg -> OrdList Instr
code Reg
dst
        | Reg
dst Reg -> Operand -> Bool
`regClashesWithOp` Operand
b_op =
                OrdList Instr
b_code 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 -> Operand -> Operand -> Instr
MOV Format
rep Operand
b_op (Reg -> Operand
OpReg Reg
tmp)) OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                Reg -> OrdList Instr
a_code Reg
dst OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
                Operand -> Operand -> Instr
instr (Reg -> Operand
OpReg Reg
tmp) (Reg -> Operand
OpReg Reg
dst)
        | Bool
otherwise =
                OrdList Instr
b_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                Reg -> OrdList Instr
a_code Reg
dst OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
                Operand -> Operand -> Instr
instr Operand
b_op (Reg -> Operand
OpReg 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
rep Reg -> OrdList Instr
code)
regClashesWithOp :: Reg -> Operand -> Bool
Reg
reg regClashesWithOp :: Reg -> Operand -> Bool
`regClashesWithOp` OpReg Reg
reg2   = Reg
reg Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
reg2
Reg
reg `regClashesWithOp` OpAddr AddrMode
amode = (Reg -> Bool) -> [Reg] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
==Reg
reg) (AddrMode -> [Reg]
addrModeRegs AddrMode
amode)
Reg
_   `regClashesWithOp` Operand
_            = Bool
False
trivialUCode :: Format -> (Operand -> Instr)
             -> CmmExpr -> NatM Register
trivialUCode :: Format -> (Operand -> Instr) -> CmmExpr -> NatM Register
trivialUCode Format
rep Operand -> Instr
instr CmmExpr
x = do
  Reg -> OrdList Instr
x_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
x
  let
     code :: Reg -> OrdList Instr
code Reg
dst =
        Reg -> OrdList Instr
x_code Reg
dst OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
        Operand -> Instr
instr (Reg -> Operand
OpReg 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
rep Reg -> OrdList Instr
code)
trivialFCode_sse2 :: Width -> (Format -> Operand -> Operand -> Instr)
                  -> CmmExpr -> CmmExpr -> NatM Register
trivialFCode_sse2 :: Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialFCode_sse2 Width
pk Format -> Operand -> Operand -> Instr
instr CmmExpr
x CmmExpr
y
    = Format
-> (Operand -> Operand -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
genTrivialCode Format
format (Format -> Operand -> Operand -> Instr
instr Format
format) CmmExpr
x CmmExpr
y
    where format :: Format
format = Width -> Format
floatFormat Width
pk
coerceInt2FP :: Width -> Width -> CmmExpr -> NatM Register
coerceInt2FP :: Width -> Width -> CmmExpr -> NatM Register
coerceInt2FP Width
from Width
to CmmExpr
x =  NatM Register
coerce_sse2
 where
   coerce_sse2 :: NatM Register
coerce_sse2 = do
     (Operand
x_op, OrdList Instr
x_code) <- CmmExpr -> NatM (Operand, OrdList Instr)
getOperand CmmExpr
x  
     let
           opc :: Format -> Operand -> Reg -> Instr
opc  = case Width
to of Width
W32 -> Format -> Operand -> Reg -> Instr
CVTSI2SS; Width
W64 -> Format -> Operand -> Reg -> Instr
CVTSI2SD
                             Width
n -> String -> Format -> Operand -> Reg -> Instr
forall a. String -> a
panic (String -> Format -> Operand -> Reg -> Instr)
-> String -> Format -> Operand -> Reg -> Instr
forall a b. (a -> b) -> a -> b
$ String
"coerceInt2FP.sse: unhandled width ("
                                         String -> String -> String
forall a. [a] -> [a] -> [a]
++ Width -> String
forall a. Show a => a -> String
show Width
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
           code :: Reg -> OrdList Instr
code Reg
dst = OrdList Instr
x_code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Operand -> Reg -> Instr
opc (Width -> Format
intFormat Width
from) Operand
x_op 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 (Width -> Format
floatFormat Width
to) Reg -> OrdList Instr
code)
        
coerceFP2Int :: Width -> Width -> CmmExpr -> NatM Register
coerceFP2Int :: Width -> Width -> CmmExpr -> NatM Register
coerceFP2Int Width
from Width
to CmmExpr
x =  NatM Register
coerceFP2Int_sse2
 where
   coerceFP2Int_sse2 :: NatM Register
coerceFP2Int_sse2 = do
     (Operand
x_op, OrdList Instr
x_code) <- CmmExpr -> NatM (Operand, OrdList Instr)
getOperand CmmExpr
x  
     let
           opc :: Format -> Operand -> Reg -> Instr
opc  = case Width
from of Width
W32 -> Format -> Operand -> Reg -> Instr
CVTTSS2SIQ; Width
W64 -> Format -> Operand -> Reg -> Instr
CVTTSD2SIQ;
                               Width
n -> String -> Format -> Operand -> Reg -> Instr
forall a. String -> a
panic (String -> Format -> Operand -> Reg -> Instr)
-> String -> Format -> Operand -> Reg -> Instr
forall a b. (a -> b) -> a -> b
$ String
"coerceFP2Init.sse: unhandled width ("
                                           String -> String -> String
forall a. [a] -> [a] -> [a]
++ Width -> String
forall a. Show a => a -> String
show Width
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
           code :: Reg -> OrdList Instr
code Reg
dst = OrdList Instr
x_code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Operand -> Reg -> Instr
opc (Width -> Format
intFormat Width
to) Operand
x_op 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 (Width -> Format
intFormat Width
to) Reg -> OrdList Instr
code)
         
coerceFP2FP :: Width -> CmmExpr -> NatM Register
coerceFP2FP :: Width -> CmmExpr -> NatM Register
coerceFP2FP Width
to CmmExpr
x = do
  (Reg
x_reg, OrdList Instr
x_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
x
  let
        opc :: Reg -> Reg -> Instr
opc  = case Width
to of Width
W32 -> Reg -> Reg -> Instr
CVTSD2SS; Width
W64 -> Reg -> Reg -> Instr
CVTSS2SD;
                                     Width
n -> String -> Reg -> Reg -> Instr
forall a. String -> a
panic (String -> Reg -> Reg -> Instr) -> String -> Reg -> Reg -> Instr
forall a b. (a -> b) -> a -> b
$ String
"coerceFP2FP: unhandled width ("
                                                 String -> String -> String
forall a. [a] -> [a] -> [a]
++ Width -> String
forall a. Show a => a -> String
show Width
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
        code :: Reg -> OrdList Instr
code Reg
dst = OrdList Instr
x_code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Reg -> Instr
opc Reg
x_reg 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 ( Width -> Format
floatFormat Width
to) Reg -> OrdList Instr
code)
sse2NegCode :: Width -> CmmExpr -> NatM Register
sse2NegCode :: Width -> CmmExpr -> NatM Register
sse2NegCode Width
w CmmExpr
x = do
  let fmt :: Format
fmt = Width -> Format
floatFormat Width
w
  Reg -> OrdList Instr
x_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
x
  
  let
    const :: CmmLit
const = case Format
fmt of
      Format
FF32 -> Integer -> Width -> CmmLit
CmmInt Integer
0x80000000 Width
W32
      Format
FF64 -> Integer -> Width -> CmmLit
CmmInt Integer
0x8000000000000000 Width
W64
      x :: Format
x@Format
II8  -> Format -> CmmLit
forall {a} {a}. Show a => a -> a
wrongFmt Format
x
      x :: Format
x@Format
II16 -> Format -> CmmLit
forall {a} {a}. Show a => a -> a
wrongFmt Format
x
      x :: Format
x@Format
II32 -> Format -> CmmLit
forall {a} {a}. Show a => a -> a
wrongFmt Format
x
      x :: Format
x@Format
II64 -> Format -> CmmLit
forall {a} {a}. Show a => a -> a
wrongFmt Format
x
      where
        wrongFmt :: a -> a
wrongFmt a
x = String -> a
forall a. String -> a
panic (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"sse2NegCode: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x
  Amode AddrMode
amode OrdList Instr
amode_code <- Alignment -> CmmLit -> NatM Amode
memConstant (Int -> Alignment
mkAlignment (Int -> Alignment) -> Int -> Alignment
forall a b. (a -> b) -> a -> b
$ Width -> Int
widthInBytes Width
w) CmmLit
const
  Reg
tmp <- Format -> NatM Reg
getNewRegNat Format
fmt
  let
    code :: Reg -> OrdList Instr
code Reg
dst = Reg -> OrdList Instr
x_code Reg
dst OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
amode_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 -> Operand -> Operand -> Instr
MOV Format
fmt (AddrMode -> Operand
OpAddr AddrMode
amode) (Reg -> Operand
OpReg Reg
tmp),
        Format -> Operand -> Operand -> Instr
XOR Format
fmt (Reg -> Operand
OpReg Reg
tmp) (Reg -> Operand
OpReg 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
fmt Reg -> OrdList Instr
code)
isVecExpr :: CmmExpr -> Bool
isVecExpr :: CmmExpr -> Bool
isVecExpr (CmmMachOp (MO_V_Insert {}) [CmmExpr]
_)   = Bool
True
isVecExpr (CmmMachOp (MO_V_Extract {}) [CmmExpr]
_)  = Bool
True
isVecExpr (CmmMachOp (MO_V_Add {}) [CmmExpr]
_)      = Bool
True
isVecExpr (CmmMachOp (MO_V_Sub {}) [CmmExpr]
_)      = Bool
True
isVecExpr (CmmMachOp (MO_V_Mul {}) [CmmExpr]
_)      = Bool
True
isVecExpr (CmmMachOp (MO_VS_Quot {}) [CmmExpr]
_)    = Bool
True
isVecExpr (CmmMachOp (MO_VS_Rem {}) [CmmExpr]
_)     = Bool
True
isVecExpr (CmmMachOp (MO_VS_Neg {}) [CmmExpr]
_)     = Bool
True
isVecExpr (CmmMachOp (MO_VF_Insert {}) [CmmExpr]
_)  = Bool
True
isVecExpr (CmmMachOp (MO_VF_Extract {}) [CmmExpr]
_) = Bool
True
isVecExpr (CmmMachOp (MO_VF_Add {}) [CmmExpr]
_)     = Bool
True
isVecExpr (CmmMachOp (MO_VF_Sub {}) [CmmExpr]
_)     = Bool
True
isVecExpr (CmmMachOp (MO_VF_Mul {}) [CmmExpr]
_)     = Bool
True
isVecExpr (CmmMachOp (MO_VF_Quot {}) [CmmExpr]
_)    = Bool
True
isVecExpr (CmmMachOp (MO_VF_Neg {}) [CmmExpr]
_)     = Bool
True
isVecExpr (CmmMachOp MachOp
_ [CmmExpr
e])                = CmmExpr -> Bool
isVecExpr CmmExpr
e
isVecExpr CmmExpr
_                                = Bool
False
needLlvm :: NatM a
needLlvm :: forall a. NatM a
needLlvm =
    String -> NatM a
forall a. String -> a
sorry (String -> NatM a) -> String -> NatM a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String
"The native code generator does not support vector"
                    ,String
"instructions. Please use -fllvm."]
invertCondBranches :: Maybe CFG  
                   -> LabelMap a 
                   -> [NatBasicBlock Instr] 
                   -> [NatBasicBlock Instr]
invertCondBranches :: forall a.
Maybe CFG
-> LabelMap a -> [NatBasicBlock Instr] -> [NatBasicBlock Instr]
invertCondBranches Maybe CFG
Nothing LabelMap a
_       [NatBasicBlock Instr]
bs = [NatBasicBlock Instr]
bs
invertCondBranches (Just CFG
cfg) LabelMap a
keep [NatBasicBlock Instr]
bs =
    [NatBasicBlock Instr] -> [NatBasicBlock Instr]
invert [NatBasicBlock Instr]
bs
  where
    invert :: [NatBasicBlock Instr] -> [NatBasicBlock Instr]
    invert :: [NatBasicBlock Instr] -> [NatBasicBlock Instr]
invert ((BasicBlock Label
lbl1 ins :: [Instr]
ins@(Instr
_:Instr
_:[Instr]
_xs)):b2 :: NatBasicBlock Instr
b2@(BasicBlock Label
lbl2 [Instr]
_):[NatBasicBlock Instr]
bs)
      | 
        (Instr
jmp1,Instr
jmp2) <- [Instr] -> (Instr, Instr)
forall a. [a] -> (a, a)
last2 [Instr]
ins
      , JXX Cond
cond1 Label
target1 <- Instr
jmp1
      , Label
target1 Label -> Label -> Bool
forall a. Eq a => a -> a -> Bool
== Label
lbl2
      
      , JXX Cond
ALWAYS Label
target2 <- Instr
jmp2
      
      
      
      
      , Just EdgeInfo
edgeInfo1 <- Label -> Label -> CFG -> Maybe EdgeInfo
getEdgeInfo Label
lbl1 Label
target1 CFG
cfg
      , Just EdgeInfo
edgeInfo2 <- Label -> Label -> CFG -> Maybe EdgeInfo
getEdgeInfo Label
lbl1 Label
target2 CFG
cfg
      
      , EdgeInfo -> TransitionSource
transitionSource EdgeInfo
edgeInfo1 TransitionSource -> TransitionSource -> Bool
forall a. Eq a => a -> a -> Bool
== EdgeInfo -> TransitionSource
transitionSource EdgeInfo
edgeInfo2
      , CmmSource {trans_cmmNode :: TransitionSource -> CmmNode O C
trans_cmmNode = CmmNode O C
cmmCondBranch} <- EdgeInfo -> TransitionSource
transitionSource EdgeInfo
edgeInfo1
      
      , CmmCondBranch (CmmMachOp MachOp
op [CmmExpr]
_args) Label
_ Label
_ Maybe Bool
_ <- CmmNode O C
cmmCondBranch
      , Just Width
_ <- MachOp -> Maybe Width
maybeIntComparison MachOp
op
      , Just Cond
invCond <- Cond -> Maybe Cond
maybeInvertCond Cond
cond1
      
      = let jumps :: [Instr]
jumps =
              case () of
                
                ()
_ | Bool -> Bool
not (KeyOf LabelMap -> LabelMap a -> Bool
forall a. KeyOf LabelMap -> LabelMap a -> Bool
forall (map :: * -> *) a. IsMap map => KeyOf map -> map a -> Bool
mapMember KeyOf LabelMap
Label
target1 LabelMap a
keep)
                    -> [Cond -> Label -> Instr
JXX Cond
invCond Label
target2]
                
                
                  | EdgeInfo -> EdgeWeight
edgeWeight EdgeInfo
edgeInfo2 EdgeWeight -> EdgeWeight -> Bool
forall a. Ord a => a -> a -> Bool
> EdgeInfo -> EdgeWeight
edgeWeight EdgeInfo
edgeInfo1
                    -> [Cond -> Label -> Instr
JXX Cond
invCond Label
target2, Cond -> Label -> Instr
JXX Cond
ALWAYS Label
target1]
                
                  | Bool
otherwise
                    -> [Instr
jmp1, Instr
jmp2]
        in 
           (Label -> [Instr] -> NatBasicBlock Instr
forall i. Label -> [i] -> GenBasicBlock i
BasicBlock Label
lbl1
            (Int -> [Instr] -> [Instr]
forall a. Int -> [a] -> [a]
dropTail Int
2 [Instr]
ins [Instr] -> [Instr] -> [Instr]
forall a. [a] -> [a] -> [a]
++ [Instr]
jumps))
            NatBasicBlock Instr
-> [NatBasicBlock Instr] -> [NatBasicBlock Instr]
forall a. a -> [a] -> [a]
: [NatBasicBlock Instr] -> [NatBasicBlock Instr]
invert (NatBasicBlock Instr
b2NatBasicBlock Instr
-> [NatBasicBlock Instr] -> [NatBasicBlock Instr]
forall a. a -> [a] -> [a]
:[NatBasicBlock Instr]
bs)
    invert (NatBasicBlock Instr
b:[NatBasicBlock Instr]
bs) = NatBasicBlock Instr
b NatBasicBlock Instr
-> [NatBasicBlock Instr] -> [NatBasicBlock Instr]
forall a. a -> [a] -> [a]
: [NatBasicBlock Instr] -> [NatBasicBlock Instr]
invert [NatBasicBlock Instr]
bs
    invert [] = []
genAtomicRMW
  :: BlockId
  -> Width
  -> AtomicMachOp
  -> LocalReg
  -> CmmExpr
  -> CmmExpr
  -> NatM (InstrBlock, Maybe BlockId)
genAtomicRMW :: Label
-> Width
-> AtomicMachOp
-> LocalReg
-> CmmExpr
-> CmmExpr
-> NatM (OrdList Instr, Maybe Label)
genAtomicRMW Label
bid Width
width AtomicMachOp
amop LocalReg
dst CmmExpr
addr CmmExpr
n = do
    Amode AddrMode
amode OrdList Instr
addr_code <-
        if AtomicMachOp
amop AtomicMachOp -> [AtomicMachOp] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [AtomicMachOp
AMO_Add, AtomicMachOp
AMO_Sub]
        then CmmExpr -> NatM Amode
getAmode CmmExpr
addr
        else CmmExpr -> NatM Amode
getSimpleAmode CmmExpr
addr  
    Reg
arg <- Format -> NatM Reg
getNewRegNat Format
format
    Reg -> OrdList Instr
arg_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
n
    Platform
platform <- NCGConfig -> Platform
ncgPlatform (NCGConfig -> Platform) -> NatM NCGConfig -> NatM Platform
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NatM NCGConfig
getConfig
    let dst_r :: Reg
dst_r    = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform  (LocalReg -> CmmReg
CmmLocal LocalReg
dst)
    (OrdList Instr
code, Label
lbl) <- Reg -> Reg -> AddrMode -> NatM (OrdList Instr, Label)
op_code Reg
dst_r Reg
arg AddrMode
amode
    (OrdList Instr, Maybe Label) -> NatM (OrdList Instr, Maybe Label)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr
addr_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Reg -> OrdList Instr
arg_code Reg
arg OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code, Label -> Maybe Label
forall a. a -> Maybe a
Just Label
lbl)
  where
    
    op_code :: Reg       
            -> Reg       
            -> AddrMode  
            -> NatM (OrdList Instr,BlockId) 
    op_code :: Reg -> Reg -> AddrMode -> NatM (OrdList Instr, Label)
op_code Reg
dst_r Reg
arg AddrMode
amode = case AtomicMachOp
amop of
        
        
        
        AtomicMachOp
AMO_Add  -> (OrdList Instr, Label) -> NatM (OrdList Instr, Label)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return ((OrdList Instr, Label) -> NatM (OrdList Instr, Label))
-> (OrdList Instr, Label) -> NatM (OrdList Instr, Label)
forall a b. (a -> b) -> a -> b
$ ([Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Instr -> Instr
LOCK (Format -> Operand -> Operand -> Instr
XADD Format
format (Reg -> Operand
OpReg Reg
arg) (AddrMode -> Operand
OpAddr AddrMode
amode))
                                   , Format -> Operand -> Operand -> Instr
MOV Format
format (Reg -> Operand
OpReg Reg
arg) (Reg -> Operand
OpReg Reg
dst_r)
                                   ], Label
bid)
        AtomicMachOp
AMO_Sub  -> (OrdList Instr, Label) -> NatM (OrdList Instr, Label)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return ((OrdList Instr, Label) -> NatM (OrdList Instr, Label))
-> (OrdList Instr, Label) -> NatM (OrdList Instr, Label)
forall a b. (a -> b) -> a -> b
$ ([Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Format -> Operand -> Instr
NEGI Format
format (Reg -> Operand
OpReg Reg
arg)
                                   , Instr -> Instr
LOCK (Format -> Operand -> Operand -> Instr
XADD Format
format (Reg -> Operand
OpReg Reg
arg) (AddrMode -> Operand
OpAddr AddrMode
amode))
                                   , Format -> Operand -> Operand -> Instr
MOV Format
format (Reg -> Operand
OpReg Reg
arg) (Reg -> Operand
OpReg Reg
dst_r)
                                   ], Label
bid)
        
        
        AtomicMachOp
AMO_And  -> (Operand -> Operand -> OrdList Instr)
-> NatM (OrdList Instr, Label)
cmpxchg_code (\ Operand
src Operand
dst -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ Format -> Operand -> Operand -> Instr
AND Format
format Operand
src Operand
dst)
        AtomicMachOp
AMO_Nand -> (Operand -> Operand -> OrdList Instr)
-> NatM (OrdList Instr, Label)
cmpxchg_code (\ Operand
src Operand
dst -> [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Format -> Operand -> Operand -> Instr
AND Format
format Operand
src Operand
dst
                                                    , Format -> Operand -> Instr
NOT Format
format Operand
dst
                                                    ])
        AtomicMachOp
AMO_Or   -> (Operand -> Operand -> OrdList Instr)
-> NatM (OrdList Instr, Label)
cmpxchg_code (\ Operand
src Operand
dst -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ Format -> Operand -> Operand -> Instr
OR Format
format Operand
src Operand
dst)
        AtomicMachOp
AMO_Xor  -> (Operand -> Operand -> OrdList Instr)
-> NatM (OrdList Instr, Label)
cmpxchg_code (\ Operand
src Operand
dst -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ Format -> Operand -> Operand -> Instr
XOR Format
format Operand
src Operand
dst)
      where
        
        
        cmpxchg_code :: (Operand -> Operand -> OrdList Instr)
                     -> NatM (OrdList Instr, BlockId)
        cmpxchg_code :: (Operand -> Operand -> OrdList Instr)
-> NatM (OrdList Instr, Label)
cmpxchg_code Operand -> Operand -> OrdList Instr
instrs = do
            Label
lbl1 <- NatM Label
getBlockIdNat
            Label
lbl2 <- NatM Label
getBlockIdNat
            Reg
tmp <- Format -> NatM Reg
getNewRegNat Format
format
            
            
            
            Label -> Label -> NatM ()
addImmediateSuccessorNat Label
bid Label
lbl1
            Label -> Label -> NatM ()
addImmediateSuccessorNat Label
lbl1 Label
lbl2
            (CFG -> CFG) -> NatM ()
updateCfgNat (Label -> Label -> EdgeWeight -> CFG -> CFG
addWeightEdge Label
lbl1 Label
lbl1 EdgeWeight
0)
            (OrdList Instr, Label) -> NatM (OrdList Instr, Label)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return ((OrdList Instr, Label) -> NatM (OrdList Instr, Label))
-> (OrdList Instr, Label) -> NatM (OrdList Instr, Label)
forall a b. (a -> b) -> a -> b
$ ([Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL
                [ Format -> Operand -> Operand -> Instr
MOV Format
format (AddrMode -> Operand
OpAddr AddrMode
amode) (Reg -> Operand
OpReg Reg
eax)
                , Cond -> Label -> Instr
JXX Cond
ALWAYS Label
lbl1
                , Label -> Instr
NEWBLOCK Label
lbl1
                  
                , Format -> Operand -> Operand -> Instr
MOV Format
format (Reg -> Operand
OpReg Reg
eax) (Reg -> Operand
OpReg Reg
dst_r)
                , Format -> Operand -> Operand -> Instr
MOV Format
format (Reg -> Operand
OpReg Reg
eax) (Reg -> Operand
OpReg Reg
tmp)
                ]
                OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Operand -> Operand -> OrdList Instr
instrs (Reg -> Operand
OpReg Reg
arg) (Reg -> Operand
OpReg Reg
tmp) 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 -> Instr
LOCK (Format -> Operand -> Operand -> Instr
CMPXCHG Format
format (Reg -> Operand
OpReg Reg
tmp) (AddrMode -> Operand
OpAddr AddrMode
amode))
                , Cond -> Label -> Instr
JXX Cond
NE Label
lbl1
                
                
                , Cond -> Label -> Instr
JXX Cond
ALWAYS Label
lbl2
                , Label -> Instr
NEWBLOCK Label
lbl2
                ],
                Label
lbl2)
    format :: Format
format = Width -> Format
intFormat Width
width
genCtz :: BlockId -> Width -> LocalReg -> CmmExpr -> NatM (InstrBlock, Maybe BlockId)
genCtz :: Label
-> Width
-> LocalReg
-> CmmExpr
-> NatM (OrdList Instr, Maybe Label)
genCtz Label
bid Width
width LocalReg
dst CmmExpr
src = do
  Bool
is32Bit <- NatM Bool
is32BitPlatform
  if Bool
is32Bit Bool -> Bool -> Bool
&& Width
width Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W64
    then Label -> LocalReg -> CmmExpr -> NatM (OrdList Instr, Maybe Label)
genCtz64_32 Label
bid LocalReg
dst CmmExpr
src
    else (,Maybe Label
forall a. Maybe a
Nothing) (OrdList Instr -> (OrdList Instr, Maybe Label))
-> NatM (OrdList Instr) -> NatM (OrdList Instr, Maybe Label)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Width -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
genCtzGeneric Width
width LocalReg
dst CmmExpr
src
genCtz64_32
  :: BlockId
  -> LocalReg
  -> CmmExpr
  -> NatM (InstrBlock, Maybe BlockId)
genCtz64_32 :: Label -> LocalReg -> CmmExpr -> NatM (OrdList Instr, Maybe Label)
genCtz64_32 Label
bid LocalReg
dst CmmExpr
src = do
  RegCode64 OrdList Instr
vcode Reg
rhi Reg
rlo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
src
  let dst_r :: Reg
dst_r = LocalReg -> Reg
getLocalRegReg LocalReg
dst
  Label
lbl1 <- NatM Label
getBlockIdNat
  Label
lbl2 <- NatM Label
getBlockIdNat
  Reg
tmp_r <- Format -> NatM Reg
getNewRegNat Format
II64
  
  
  
  
  Weights
weights <- NatM Weights
getCfgWeights
  (CFG -> CFG) -> NatM ()
updateCfgNat (Label -> Label -> EdgeWeight -> CFG -> CFG
addWeightEdge Label
bid Label
lbl1 EdgeWeight
110 (CFG -> CFG) -> (CFG -> CFG) -> CFG -> CFG
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Label -> Label -> EdgeWeight -> CFG -> CFG
addWeightEdge Label
lbl1 Label
lbl2 EdgeWeight
110 (CFG -> CFG) -> (CFG -> CFG) -> CFG -> CFG
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Weights -> Label -> Label -> CFG -> CFG
addImmediateSuccessor Weights
weights Label
bid Label
lbl2)
  
  
  
  
  
  
  
  let instrs :: OrdList Instr
instrs = OrdList Instr
vcode 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 -> Operand -> Operand -> Instr
MOV      Format
II32 (Reg -> Operand
OpReg Reg
rhi)         (Reg -> Operand
OpReg Reg
tmp_r)
            , Format -> Operand -> Operand -> Instr
OR       Format
II32 (Reg -> Operand
OpReg Reg
rlo)         (Reg -> Operand
OpReg Reg
tmp_r)
            , Format -> Operand -> Operand -> Instr
MOV      Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
64)) (Reg -> Operand
OpReg Reg
dst_r)
            , Cond -> Label -> Instr
JXX Cond
EQQ    Label
lbl2
            , Cond -> Label -> Instr
JXX Cond
ALWAYS Label
lbl1
            , Label -> Instr
NEWBLOCK   Label
lbl1
            , Format -> Operand -> Reg -> Instr
BSF     Format
II32 (Reg -> Operand
OpReg Reg
rhi)         Reg
dst_r
            , Format -> Operand -> Operand -> Instr
ADD     Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
32)) (Reg -> Operand
OpReg Reg
dst_r)
            , Format -> Operand -> Reg -> Instr
BSF     Format
II32 (Reg -> Operand
OpReg Reg
rlo)         Reg
tmp_r
            , Cond -> Format -> Operand -> Reg -> Instr
CMOV Cond
NE Format
II32 (Reg -> Operand
OpReg Reg
tmp_r)       Reg
dst_r
            , Cond -> Label -> Instr
JXX Cond
ALWAYS Label
lbl2
            , Label -> Instr
NEWBLOCK   Label
lbl2
            ])
  (OrdList Instr, Maybe Label) -> NatM (OrdList Instr, Maybe Label)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr
instrs, Label -> Maybe Label
forall a. a -> Maybe a
Just Label
lbl2)
genCtzGeneric :: Width -> LocalReg -> CmmExpr -> NatM InstrBlock
genCtzGeneric :: Width -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
genCtzGeneric Width
width LocalReg
dst CmmExpr
src = do
  Reg -> OrdList Instr
code_src <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
src
  NCGConfig
config <- NatM NCGConfig
getConfig
  let bw :: Int
bw = Width -> Int
widthInBits Width
width
  let dst_r :: Reg
dst_r = LocalReg -> Reg
getLocalRegReg LocalReg
dst
  if NCGConfig -> Maybe BmiVersion
ncgBmiVersion NCGConfig
config Maybe BmiVersion -> Maybe BmiVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= BmiVersion -> Maybe BmiVersion
forall a. a -> Maybe a
Just BmiVersion
BMI2
  then do
      Reg
src_r <- Format -> NatM Reg
getNewRegNat (Width -> Format
intFormat Width
width)
      let instrs :: OrdList Instr
instrs = OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
appOL (Reg -> OrdList Instr
code_src Reg
src_r) (OrdList Instr -> OrdList Instr) -> OrdList Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ case Width
width of
              Width
W8 -> [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL
                  [ Format -> Operand -> Operand -> Instr
OR    Format
II32 (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
0xFFFFFF00)) (Reg -> Operand
OpReg Reg
src_r)
                  , Format -> Operand -> Reg -> Instr
TZCNT Format
II32 (Reg -> Operand
OpReg Reg
src_r) Reg
dst_r
                  ]
              Width
W16 -> [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL
                  [ Format -> Operand -> Reg -> Instr
TZCNT  Format
II16 (Reg -> Operand
OpReg Reg
src_r) Reg
dst_r
                  , Format -> Operand -> Operand -> Instr
MOVZxL Format
II16 (Reg -> Operand
OpReg Reg
dst_r) (Reg -> Operand
OpReg Reg
dst_r)
                  ]
              Width
_ -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ Format -> Operand -> Reg -> Instr
TZCNT (Width -> Format
intFormat Width
width) (Reg -> Operand
OpReg Reg
src_r) Reg
dst_r
      OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return OrdList Instr
instrs
  else do
      
      
      let format :: Format
format = if Width
width Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W8 then Format
II16 else Width -> Format
intFormat Width
width
      Reg
src_r <- Format -> NatM Reg
getNewRegNat Format
format
      Reg
tmp_r <- Format -> NatM Reg
getNewRegNat Format
format
      let instrs :: OrdList Instr
instrs = Reg -> OrdList Instr
code_src Reg
src_r 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 -> Operand -> Operand -> Instr
MOVZxL  Format
II8    (Reg -> Operand
OpReg Reg
src_r) (Reg -> Operand
OpReg Reg
src_r) | Width
width Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W8 ] [Instr] -> [Instr] -> [Instr]
forall a. [a] -> [a] -> [a]
++
                [ Format -> Operand -> Reg -> Instr
BSF     Format
format (Reg -> Operand
OpReg Reg
src_r) Reg
tmp_r
                , Format -> Operand -> Operand -> Instr
MOV     Format
II32   (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
bw)) (Reg -> Operand
OpReg Reg
dst_r)
                , Cond -> Format -> Operand -> Reg -> Instr
CMOV Cond
NE Format
format (Reg -> Operand
OpReg Reg
tmp_r) Reg
dst_r
                ]) 
                   
                   
      OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return OrdList Instr
instrs
genMemCpy
  :: BlockId
  -> Int
  -> CmmExpr
  -> CmmExpr
  -> CmmExpr
  -> NatM InstrBlock
genMemCpy :: Label
-> Int -> CmmExpr -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genMemCpy Label
bid Int
align CmmExpr
dst CmmExpr
src CmmExpr
arg_n = do
  let libc_memcpy :: NatM (OrdList Instr)
libc_memcpy = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"memcpy") [] [CmmExpr
dst,CmmExpr
src,CmmExpr
arg_n]
  case CmmExpr
arg_n of
    CmmLit (CmmInt Integer
n Width
_) -> do
      
      Maybe (OrdList Instr)
mcode <- Int
-> CmmExpr -> CmmExpr -> Integer -> NatM (Maybe (OrdList Instr))
genMemCpyInlineMaybe Int
align CmmExpr
dst CmmExpr
src Integer
n
      
      case Maybe (OrdList Instr)
mcode of
        Maybe (OrdList Instr)
Nothing -> NatM (OrdList Instr)
libc_memcpy
        Just OrdList Instr
c  -> OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OrdList Instr
c
    
    CmmExpr
_ -> NatM (OrdList Instr)
libc_memcpy
genMemCpyInlineMaybe
  :: Int
  -> CmmExpr
  -> CmmExpr
  -> Integer
  -> NatM (Maybe InstrBlock)
genMemCpyInlineMaybe :: Int
-> CmmExpr -> CmmExpr -> Integer -> NatM (Maybe (OrdList Instr))
genMemCpyInlineMaybe Int
align CmmExpr
dst CmmExpr
src Integer
n = do
  NCGConfig
config <- NatM NCGConfig
getConfig
  let
    platform :: Platform
platform     = NCGConfig -> Platform
ncgPlatform NCGConfig
config
    maxAlignment :: Alignment
maxAlignment = Platform -> Alignment
wordAlignment Platform
platform
                   
    effectiveAlignment :: Alignment
effectiveAlignment = Alignment -> Alignment -> Alignment
forall a. Ord a => a -> a -> a
min (Int -> Alignment
alignmentOf Int
align) Alignment
maxAlignment
    format :: Format
format = Width -> Format
intFormat (Width -> Format) -> (Int -> Width) -> Int -> Format
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Width
widthFromBytes (Int -> Format) -> Int -> Format
forall a b. (a -> b) -> a -> b
$ Alignment -> Int
alignmentBytes Alignment
effectiveAlignment
  
  let sizeBytes :: Integer
      sizeBytes :: Integer
sizeBytes = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Format -> Int
formatInBytes Format
format)
  
  
  let insns :: Integer
insns = Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* ((Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
sizeBytes Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
sizeBytes)
      go :: Reg -> Reg -> Reg -> Integer -> OrdList Instr
      go :: Reg -> Reg -> Reg -> Integer -> OrdList Instr
go Reg
dst Reg
src Reg
tmp Integer
i
          | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
sizeBytes =
              Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOV Format
format (AddrMode -> Operand
OpAddr AddrMode
src_addr) (Reg -> Operand
OpReg Reg
tmp)) 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 -> Operand -> Operand -> Instr
MOV Format
format (Reg -> Operand
OpReg Reg
tmp) (AddrMode -> Operand
OpAddr AddrMode
dst_addr)) OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
              Reg -> Reg -> Reg -> Integer -> OrdList Instr
go Reg
dst Reg
src Reg
tmp (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
sizeBytes)
          
          | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
4 =  
              Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOV Format
II32 (AddrMode -> Operand
OpAddr AddrMode
src_addr) (Reg -> Operand
OpReg Reg
tmp)) 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 -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
tmp) (AddrMode -> Operand
OpAddr AddrMode
dst_addr)) OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
              Reg -> Reg -> Reg -> Integer -> OrdList Instr
go Reg
dst Reg
src Reg
tmp (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
4)
          | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
2 =
              Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOVZxL Format
II16 (AddrMode -> Operand
OpAddr AddrMode
src_addr) (Reg -> Operand
OpReg Reg
tmp)) 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 -> Operand -> Operand -> Instr
MOV Format
II16 (Reg -> Operand
OpReg Reg
tmp) (AddrMode -> Operand
OpAddr AddrMode
dst_addr)) OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
              Reg -> Reg -> Reg -> Integer -> OrdList Instr
go Reg
dst Reg
src Reg
tmp (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
2)
          | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
1 =
              Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOVZxL Format
II8 (AddrMode -> Operand
OpAddr AddrMode
src_addr) (Reg -> Operand
OpReg Reg
tmp)) 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 -> Operand -> Operand -> Instr
MOV Format
II8 (Reg -> Operand
OpReg Reg
tmp) (AddrMode -> Operand
OpAddr AddrMode
dst_addr)) OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
              Reg -> Reg -> Reg -> Integer -> OrdList Instr
go Reg
dst Reg
src Reg
tmp (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
          | Bool
otherwise = OrdList Instr
forall a. OrdList a
nilOL
        where
          src_addr :: AddrMode
src_addr = EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex (Reg -> EABase
EABaseReg Reg
src) EAIndex
EAIndexNone
                       (Integer -> Imm
ImmInteger (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
i))
          dst_addr :: AddrMode
dst_addr = EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex (Reg -> EABase
EABaseReg Reg
dst) EAIndex
EAIndexNone
                       (Integer -> Imm
ImmInteger (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
i))
  if Integer
insns Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Word -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NCGConfig -> Word
ncgInlineThresholdMemcpy NCGConfig
config)
    then Maybe (OrdList Instr) -> NatM (Maybe (OrdList Instr))
forall a. a -> NatM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (OrdList Instr)
forall a. Maybe a
Nothing
    else do
      Reg -> OrdList Instr
code_dst <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
dst
      Reg
dst_r <- Format -> NatM Reg
getNewRegNat Format
format
      Reg -> OrdList Instr
code_src <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
src
      Reg
src_r <- Format -> NatM Reg
getNewRegNat Format
format
      Reg
tmp_r <- Format -> NatM Reg
getNewRegNat Format
format
      Maybe (OrdList Instr) -> NatM (Maybe (OrdList Instr))
forall a. a -> NatM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (OrdList Instr) -> NatM (Maybe (OrdList Instr)))
-> Maybe (OrdList Instr) -> NatM (Maybe (OrdList Instr))
forall a b. (a -> b) -> a -> b
$ OrdList Instr -> Maybe (OrdList Instr)
forall a. a -> Maybe a
Just (OrdList Instr -> Maybe (OrdList Instr))
-> OrdList Instr -> Maybe (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ Reg -> OrdList Instr
code_dst Reg
dst_r OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Reg -> OrdList Instr
code_src Reg
src_r OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                      Reg -> Reg -> Reg -> Integer -> OrdList Instr
go Reg
dst_r Reg
src_r Reg
tmp_r (Integer -> Integer
forall a. Num a => Integer -> a
fromInteger Integer
n)
genMemSet
  :: BlockId
  -> Int
  -> CmmExpr
  -> CmmExpr
  -> CmmExpr
  -> NatM InstrBlock
genMemSet :: Label
-> Int -> CmmExpr -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genMemSet Label
bid Int
align CmmExpr
dst CmmExpr
arg_c CmmExpr
arg_n = do
  let libc_memset :: NatM (OrdList Instr)
libc_memset = Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"memset") [] [CmmExpr
dst,CmmExpr
arg_c,CmmExpr
arg_n]
  case (CmmExpr
arg_c,CmmExpr
arg_n) of
    (CmmLit (CmmInt Integer
c Width
_), CmmLit (CmmInt Integer
n Width
_)) -> do
      
      Maybe (OrdList Instr)
mcode <- Int
-> CmmExpr -> Integer -> Integer -> NatM (Maybe (OrdList Instr))
genMemSetInlineMaybe Int
align CmmExpr
dst Integer
c Integer
n
      
      case Maybe (OrdList Instr)
mcode of
        Maybe (OrdList Instr)
Nothing -> NatM (OrdList Instr)
libc_memset
        Just OrdList Instr
c  -> OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OrdList Instr
c
    
    (CmmExpr, CmmExpr)
_ -> NatM (OrdList Instr)
libc_memset
genMemSetInlineMaybe
  :: Int
  -> CmmExpr
  -> Integer
  -> Integer
  -> NatM (Maybe InstrBlock)
genMemSetInlineMaybe :: Int
-> CmmExpr -> Integer -> Integer -> NatM (Maybe (OrdList Instr))
genMemSetInlineMaybe Int
align CmmExpr
dst Integer
c Integer
n = do
  NCGConfig
config <- NatM NCGConfig
getConfig
  let
    platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
    maxAlignment :: Alignment
maxAlignment = Platform -> Alignment
wordAlignment Platform
platform 
    effectiveAlignment :: Alignment
effectiveAlignment = Alignment -> Alignment -> Alignment
forall a. Ord a => a -> a -> a
min (Int -> Alignment
alignmentOf Int
align) Alignment
maxAlignment
    format :: Format
format = Width -> Format
intFormat (Width -> Format) -> (Int -> Width) -> Int -> Format
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Width
widthFromBytes (Int -> Format) -> Int -> Format
forall a b. (a -> b) -> a -> b
$ Alignment -> Int
alignmentBytes Alignment
effectiveAlignment
    c2 :: Integer
c2 = Integer
c Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
8 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
c
    c4 :: Integer
c4 = Integer
c2 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
16 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
c2
    c8 :: Integer
c8 = Integer
c4 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
32 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
c4
    
    
    insns :: Integer
insns = (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
sizeBytes Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
sizeBytes
    
    sizeBytes :: Integer
    sizeBytes :: Integer
sizeBytes = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Format -> Int
formatInBytes Format
format)
    
    
    gen4 :: AddrMode -> Integer -> (InstrBlock, Integer)
    gen4 :: AddrMode -> Integer -> (OrdList Instr, Integer)
gen4 AddrMode
addr Integer
size
        | Integer
size Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
4 =
            (Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOV Format
II32 (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
c4)) (AddrMode -> Operand
OpAddr AddrMode
addr)), Integer
4)
        | Integer
size Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
2 =
            (Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOV Format
II16 (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
c2)) (AddrMode -> Operand
OpAddr AddrMode
addr)), Integer
2)
        | Integer
size Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
1 =
            (Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOV Format
II8 (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
c)) (AddrMode -> Operand
OpAddr AddrMode
addr)), Integer
1)
        | Bool
otherwise = (OrdList Instr
forall a. OrdList a
nilOL, Integer
0)
    
    gen8 :: AddrMode -> Reg -> InstrBlock
    gen8 :: AddrMode -> Reg -> OrdList Instr
gen8 AddrMode
addr Reg
reg8byte =
      Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOV Format
format (Reg -> Operand
OpReg Reg
reg8byte) (AddrMode -> Operand
OpAddr AddrMode
addr))
    
    go4 :: Reg -> Integer -> InstrBlock
    go4 :: Reg -> Integer -> OrdList Instr
go4 Reg
dst Integer
left =
      if Integer
left Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 then OrdList Instr
forall a. OrdList a
nilOL
      else OrdList Instr
curMov OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Reg -> Integer -> OrdList Instr
go4 Reg
dst (Integer
left Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
curWidth)
      where
        possibleWidth :: Integer
possibleWidth = [Integer] -> Integer
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Integer
left, Integer
sizeBytes]
        dst_addr :: AddrMode
dst_addr = EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex (Reg -> EABase
EABaseReg Reg
dst) EAIndex
EAIndexNone (Integer -> Imm
ImmInteger (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
left))
        (OrdList Instr
curMov, Integer
curWidth) = AddrMode -> Integer -> (OrdList Instr, Integer)
gen4 AddrMode
dst_addr Integer
possibleWidth
    
    
    
    go8 :: Reg -> Reg -> Integer -> InstrBlock
    go8 :: Reg -> Reg -> Integer -> OrdList Instr
go8 Reg
dst Reg
reg8byte Integer
left =
      if Integer
possibleWidth Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
8 then
        let curMov :: OrdList Instr
curMov = AddrMode -> Reg -> OrdList Instr
gen8 AddrMode
dst_addr Reg
reg8byte
        in  OrdList Instr
curMov OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Reg -> Reg -> Integer -> OrdList Instr
go8 Reg
dst Reg
reg8byte (Integer
left Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
8)
      else Reg -> Integer -> OrdList Instr
go4 Reg
dst Integer
left
      where
        possibleWidth :: Integer
possibleWidth = [Integer] -> Integer
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Integer
left, Integer
sizeBytes]
        dst_addr :: AddrMode
dst_addr = EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex (Reg -> EABase
EABaseReg Reg
dst) EAIndex
EAIndexNone (Integer -> Imm
ImmInteger (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
left))
  if Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
insns Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> NCGConfig -> Word
ncgInlineThresholdMemset NCGConfig
config
    then Maybe (OrdList Instr) -> NatM (Maybe (OrdList Instr))
forall a. a -> NatM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (OrdList Instr)
forall a. Maybe a
Nothing
    else do
        Reg -> OrdList Instr
code_dst <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
dst
        Reg
dst_r <- Format -> NatM Reg
getNewRegNat Format
format
        if Format
format Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
II64 Bool -> Bool -> Bool
&& Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
8
          then do
            Reg -> OrdList Instr
code_imm8byte <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg (CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt Integer
c8 Width
W64))
            Reg
imm8byte_r <- Format -> NatM Reg
getNewRegNat Format
II64
            Maybe (OrdList Instr) -> NatM (Maybe (OrdList Instr))
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (OrdList Instr) -> NatM (Maybe (OrdList Instr)))
-> Maybe (OrdList Instr) -> NatM (Maybe (OrdList Instr))
forall a b. (a -> b) -> a -> b
$ OrdList Instr -> Maybe (OrdList Instr)
forall a. a -> Maybe a
Just (OrdList Instr -> Maybe (OrdList Instr))
-> OrdList Instr -> Maybe (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ Reg -> OrdList Instr
code_dst Reg
dst_r OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                              Reg -> OrdList Instr
code_imm8byte Reg
imm8byte_r OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                              Reg -> Reg -> Integer -> OrdList Instr
go8 Reg
dst_r Reg
imm8byte_r (Integer -> Integer
forall a. Num a => Integer -> a
fromInteger Integer
n)
          else
            Maybe (OrdList Instr) -> NatM (Maybe (OrdList Instr))
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (OrdList Instr) -> NatM (Maybe (OrdList Instr)))
-> Maybe (OrdList Instr) -> NatM (Maybe (OrdList Instr))
forall a b. (a -> b) -> a -> b
$ OrdList Instr -> Maybe (OrdList Instr)
forall a. a -> Maybe a
Just (OrdList Instr -> Maybe (OrdList Instr))
-> OrdList Instr -> Maybe (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ Reg -> OrdList Instr
code_dst Reg
dst_r OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                              Reg -> Integer -> OrdList Instr
go4 Reg
dst_r (Integer -> Integer
forall a. Num a => Integer -> a
fromInteger Integer
n)
genMemMove :: BlockId -> p -> CmmActual -> CmmActual -> CmmActual -> NatM InstrBlock
genMemMove :: forall p.
Label -> p -> CmmExpr -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genMemMove Label
bid p
_align CmmExpr
dst CmmExpr
src CmmExpr
n = do
  
  
  Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"memmove") [] [CmmExpr
dst,CmmExpr
src,CmmExpr
n]
genMemCmp :: BlockId -> p -> CmmFormal -> CmmActual -> CmmActual -> CmmActual -> NatM InstrBlock
genMemCmp :: forall p.
Label
-> p
-> LocalReg
-> CmmExpr
-> CmmExpr
-> CmmExpr
-> NatM (OrdList Instr)
genMemCmp Label
bid p
_align LocalReg
res CmmExpr
dst CmmExpr
src CmmExpr
n = do
  
  
  Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genLibCCall Label
bid (String -> FastString
fsLit String
"memcmp") [LocalReg
res] [CmmExpr
dst,CmmExpr
src,CmmExpr
n]
genPrefetchData :: Int -> CmmExpr -> NatM (OrdList Instr)
genPrefetchData :: Int -> CmmExpr -> NatM (OrdList Instr)
genPrefetchData Int
n CmmExpr
src = do
  Bool
is32Bit <- NatM Bool
is32BitPlatform
  let
    format :: Format
format = Bool -> Format
archWordFormat Bool
is32Bit
    
    genPrefetch :: CmmExpr -> (Operand -> Instr) -> NatM (OrdList Instr)
genPrefetch CmmExpr
inRegSrc Operand -> Instr
prefetchCTor = do
      Reg -> OrdList Instr
code_src <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
inRegSrc
      Reg
src_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
$ Reg -> OrdList Instr
code_src Reg
src_r OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
        (Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Operand -> Instr
prefetchCTor  (AddrMode -> Operand
OpAddr
                    ((EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex (Reg -> EABase
EABaseReg Reg
src_r )   EAIndex
EAIndexNone (Int -> Imm
ImmInt Int
0))))  ))
        
  
  
  case Int
n of
      Int
0 -> CmmExpr -> (Operand -> Instr) -> NatM (OrdList Instr)
genPrefetch CmmExpr
src ((Operand -> Instr) -> NatM (OrdList Instr))
-> (Operand -> Instr) -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ PrefetchVariant -> Format -> Operand -> Instr
PREFETCH PrefetchVariant
NTA  Format
format
      Int
1 -> CmmExpr -> (Operand -> Instr) -> NatM (OrdList Instr)
genPrefetch CmmExpr
src ((Operand -> Instr) -> NatM (OrdList Instr))
-> (Operand -> Instr) -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ PrefetchVariant -> Format -> Operand -> Instr
PREFETCH PrefetchVariant
Lvl2 Format
format
      Int
2 -> CmmExpr -> (Operand -> Instr) -> NatM (OrdList Instr)
genPrefetch CmmExpr
src ((Operand -> Instr) -> NatM (OrdList Instr))
-> (Operand -> Instr) -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ PrefetchVariant -> Format -> Operand -> Instr
PREFETCH PrefetchVariant
Lvl1 Format
format
      Int
3 -> CmmExpr -> (Operand -> Instr) -> NatM (OrdList Instr)
genPrefetch CmmExpr
src ((Operand -> Instr) -> NatM (OrdList Instr))
-> (Operand -> Instr) -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ PrefetchVariant -> Format -> Operand -> Instr
PREFETCH PrefetchVariant
Lvl0 Format
format
      Int
l -> String -> SDoc -> NatM (OrdList Instr)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"genPrefetchData: unexpected prefetch level" (Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
l)
genByteSwap :: Width -> LocalReg -> CmmExpr -> NatM InstrBlock
genByteSwap :: Width -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
genByteSwap Width
width LocalReg
dst CmmExpr
src = do
  Bool
is32Bit <- NatM Bool
is32BitPlatform
  let format :: Format
format = Width -> Format
intFormat Width
width
  case Width
width of
      Width
W64 | Bool
is32Bit -> do
        let Reg64 Reg
dst_hi Reg
dst_lo = (() :: Constraint) => LocalReg -> Reg64
LocalReg -> Reg64
localReg64 LocalReg
dst
        RegCode64 OrdList Instr
vcode Reg
rhi Reg
rlo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 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
$ OrdList Instr
vcode 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 -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
rlo) (Reg -> Operand
OpReg Reg
dst_hi),
                        Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
rhi) (Reg -> Operand
OpReg Reg
dst_lo),
                        Format -> Reg -> Instr
BSWAP Format
II32 Reg
dst_hi,
                        Format -> Reg -> Instr
BSWAP Format
II32 Reg
dst_lo ]
      Width
W16 -> do
        let dst_r :: Reg
dst_r = LocalReg -> Reg
getLocalRegReg LocalReg
dst
        Reg -> OrdList Instr
code_src <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg 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
$ Reg -> OrdList Instr
code_src Reg
dst_r 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 -> Instr
BSWAP Format
II32 Reg
dst_r) 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 -> Operand -> Operand -> Instr
SHR Format
II32 (Imm -> Operand
OpImm (Imm -> Operand) -> Imm -> Operand
forall a b. (a -> b) -> a -> b
$ Int -> Imm
ImmInt Int
16) (Reg -> Operand
OpReg Reg
dst_r))
      Width
_   -> do
        let dst_r :: Reg
dst_r = LocalReg -> Reg
getLocalRegReg LocalReg
dst
        Reg -> OrdList Instr
code_src <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg 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
$ Reg -> OrdList Instr
code_src Reg
dst_r 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 -> Instr
BSWAP Format
format Reg
dst_r)
genBitRev :: BlockId -> Width -> CmmFormal -> CmmActual -> NatM InstrBlock
genBitRev :: Label -> Width -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
genBitRev Label
bid Width
width LocalReg
dst CmmExpr
src = do
  
  
  Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genPrimCCall Label
bid (Width -> FastString
bRevLabel Width
width) [LocalReg
dst] [CmmExpr
src]
genPopCnt :: BlockId -> Width -> LocalReg -> CmmExpr -> NatM InstrBlock
genPopCnt :: Label -> Width -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
genPopCnt Label
bid Width
width LocalReg
dst CmmExpr
src = do
  NCGConfig
config <- NatM NCGConfig
getConfig
  let
    platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
    format :: Format
format = Width -> Format
intFormat Width
width
  NatM Bool
sse4_2Enabled NatM Bool -> (Bool -> NatM (OrdList Instr)) -> NatM (OrdList Instr)
forall a b. NatM a -> (a -> NatM b) -> NatM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
True -> do
      Reg -> OrdList Instr
code_src <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
src
      Reg
src_r <- Format -> NatM Reg
getNewRegNat Format
format
      let dst_r :: Reg
dst_r = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform  (LocalReg -> CmmReg
CmmLocal LocalReg
dst)
      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
$ Reg -> OrdList Instr
code_src Reg
src_r OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
          (if Width
width Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W8 then
               
               Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOVZxL Format
II8 (Reg -> Operand
OpReg Reg
src_r) (Reg -> Operand
OpReg Reg
src_r)) 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 -> Operand -> Reg -> Instr
POPCNT Format
II16 (Reg -> Operand
OpReg Reg
src_r) Reg
dst_r)
           else
               Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Format -> Operand -> Reg -> Instr
POPCNT Format
format (Reg -> Operand
OpReg Reg
src_r) Reg
dst_r)) OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
          (if Width
width Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W8 Bool -> Bool -> Bool
|| Width
width Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W16 then
               
               
               Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOVZxL Format
II16 (Reg -> Operand
OpReg Reg
dst_r) (Reg -> Operand
OpReg Reg
dst_r))
           else OrdList Instr
forall a. OrdList a
nilOL)
    Bool
False ->
      
      
      
      Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genPrimCCall Label
bid (Width -> FastString
popCntLabel Width
width) [LocalReg
dst] [CmmExpr
src]
genPdep :: BlockId -> Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
genPdep :: Label
-> Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genPdep Label
bid Width
width LocalReg
dst CmmExpr
src CmmExpr
mask = do
  NCGConfig
config <- NatM NCGConfig
getConfig
  let
    platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
    format :: Format
format = Width -> Format
intFormat Width
width
  if NCGConfig -> Maybe BmiVersion
ncgBmiVersion NCGConfig
config Maybe BmiVersion -> Maybe BmiVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= BmiVersion -> Maybe BmiVersion
forall a. a -> Maybe a
Just BmiVersion
BMI2
    then do
      Reg -> OrdList Instr
code_src  <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
src
      Reg -> OrdList Instr
code_mask <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
mask
      Reg
src_r     <- Format -> NatM Reg
getNewRegNat Format
format
      Reg
mask_r    <- Format -> NatM Reg
getNewRegNat Format
format
      let dst_r :: Reg
dst_r = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform  (LocalReg -> CmmReg
CmmLocal LocalReg
dst)
      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
$ Reg -> OrdList Instr
code_src Reg
src_r OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Reg -> OrdList Instr
code_mask Reg
mask_r OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
          
          ( if Width
width Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W8 Bool -> Bool -> Bool
|| Width
width Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W16 then
              [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL
                [ Format -> Operand -> Operand -> Instr
MOVZxL Format
format (Reg -> Operand
OpReg Reg
src_r ) (Reg -> Operand
OpReg Reg
src_r )
                , Format -> Operand -> Operand -> Instr
MOVZxL Format
format (Reg -> Operand
OpReg Reg
mask_r) (Reg -> Operand
OpReg Reg
mask_r)
                , Format -> Operand -> Operand -> Reg -> Instr
PDEP   Format
II32 (Reg -> Operand
OpReg Reg
mask_r) (Reg -> Operand
OpReg Reg
src_r ) Reg
dst_r
                , Format -> Operand -> Operand -> Instr
MOVZxL Format
format (Reg -> Operand
OpReg Reg
dst_r) (Reg -> Operand
OpReg Reg
dst_r) 
                ]
            else
              Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Reg -> Instr
PDEP Format
format (Reg -> Operand
OpReg Reg
mask_r) (Reg -> Operand
OpReg Reg
src_r) Reg
dst_r)
          )
    else
      
      Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genPrimCCall Label
bid (Width -> FastString
pdepLabel Width
width) [LocalReg
dst] [CmmExpr
src,CmmExpr
mask]
genPext :: BlockId -> Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
genPext :: Label
-> Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genPext Label
bid Width
width LocalReg
dst CmmExpr
src CmmExpr
mask = do
  NCGConfig
config <- NatM NCGConfig
getConfig
  if NCGConfig -> Maybe BmiVersion
ncgBmiVersion NCGConfig
config Maybe BmiVersion -> Maybe BmiVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= BmiVersion -> Maybe BmiVersion
forall a. a -> Maybe a
Just BmiVersion
BMI2
    then do
      let format :: Format
format   = Width -> Format
intFormat Width
width
      let dst_r :: Reg
dst_r    = LocalReg -> Reg
getLocalRegReg LocalReg
dst
      Reg -> OrdList Instr
code_src  <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
src
      Reg -> OrdList Instr
code_mask <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
mask
      Reg
src_r     <- Format -> NatM Reg
getNewRegNat Format
format
      Reg
mask_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
$ Reg -> OrdList Instr
code_src Reg
src_r OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Reg -> OrdList Instr
code_mask Reg
mask_r OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
          (if Width
width Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W8 Bool -> Bool -> Bool
|| Width
width Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W16 then
               
              [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL
                [ Format -> Operand -> Operand -> Instr
MOVZxL Format
format (Reg -> Operand
OpReg Reg
src_r ) (Reg -> Operand
OpReg Reg
src_r )
                , Format -> Operand -> Operand -> Instr
MOVZxL Format
format (Reg -> Operand
OpReg Reg
mask_r) (Reg -> Operand
OpReg Reg
mask_r)
                , Format -> Operand -> Operand -> Reg -> Instr
PEXT   Format
II32 (Reg -> Operand
OpReg Reg
mask_r) (Reg -> Operand
OpReg Reg
src_r ) Reg
dst_r
                , Format -> Operand -> Operand -> Instr
MOVZxL Format
format (Reg -> Operand
OpReg Reg
dst_r) (Reg -> Operand
OpReg Reg
dst_r) 
                ]
            else
              Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Reg -> Instr
PEXT Format
format (Reg -> Operand
OpReg Reg
mask_r) (Reg -> Operand
OpReg Reg
src_r) Reg
dst_r)
          )
    else
      
      Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genPrimCCall Label
bid (Width -> FastString
pextLabel Width
width) [LocalReg
dst] [CmmExpr
src,CmmExpr
mask]
genClz :: BlockId -> Width -> CmmFormal -> CmmActual -> NatM InstrBlock
genClz :: Label -> Width -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
genClz Label
bid Width
width LocalReg
dst CmmExpr
src = do
  Bool
is32Bit <- NatM Bool
is32BitPlatform
  NCGConfig
config <- NatM NCGConfig
getConfig
  if Bool
is32Bit Bool -> Bool -> Bool
&& Width
width Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W64
    then
      
      Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genPrimCCall Label
bid (Width -> FastString
clzLabel Width
width) [LocalReg
dst] [CmmExpr
src]
    else do
      Reg -> OrdList Instr
code_src <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
src
      let dst_r :: Reg
dst_r = LocalReg -> Reg
getLocalRegReg LocalReg
dst
      if NCGConfig -> Maybe BmiVersion
ncgBmiVersion NCGConfig
config Maybe BmiVersion -> Maybe BmiVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= BmiVersion -> Maybe BmiVersion
forall a. a -> Maybe a
Just BmiVersion
BMI2
        then do
          Reg
src_r <- Format -> NatM Reg
getNewRegNat (Width -> Format
intFormat Width
width)
          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 -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
appOL (Reg -> OrdList Instr
code_src Reg
src_r) (OrdList Instr -> OrdList Instr) -> OrdList Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ case Width
width of
            Width
W8 -> [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL
                [ Format -> Operand -> Operand -> Instr
MOVZxL Format
II8  (Reg -> Operand
OpReg Reg
src_r)       (Reg -> Operand
OpReg Reg
src_r) 
                , Format -> Operand -> Reg -> Instr
LZCNT  Format
II32 (Reg -> Operand
OpReg Reg
src_r)       Reg
dst_r         
                , Format -> Operand -> Operand -> Instr
SUB    Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
24)) (Reg -> Operand
OpReg Reg
dst_r) 
                ]
            Width
W16 -> [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL
                [ Format -> Operand -> Reg -> Instr
LZCNT  Format
II16 (Reg -> Operand
OpReg Reg
src_r) Reg
dst_r
                , Format -> Operand -> Operand -> Instr
MOVZxL Format
II16 (Reg -> Operand
OpReg Reg
dst_r) (Reg -> Operand
OpReg Reg
dst_r) 
                ]
            Width
_ -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Format -> Operand -> Reg -> Instr
LZCNT (Width -> Format
intFormat Width
width) (Reg -> Operand
OpReg Reg
src_r) Reg
dst_r)
        else do
          let format :: Format
format = if Width
width Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W8 then Format
II16 else Width -> Format
intFormat Width
width
          let bw :: Int
bw = Width -> Int
widthInBits Width
width
          Reg
src_r <- Format -> NatM Reg
getNewRegNat Format
format
          Reg
tmp_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
$ Reg -> OrdList Instr
code_src Reg
src_r 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 -> Operand -> Operand -> Instr
MOVZxL  Format
II8    (Reg -> Operand
OpReg Reg
src_r) (Reg -> Operand
OpReg Reg
src_r) | Width
width Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W8 ] [Instr] -> [Instr] -> [Instr]
forall a. [a] -> [a] -> [a]
++
                    [ Format -> Operand -> Reg -> Instr
BSR     Format
format (Reg -> Operand
OpReg Reg
src_r) Reg
tmp_r
                    , Format -> Operand -> Operand -> Instr
MOV     Format
II32   (Imm -> Operand
OpImm (Int -> Imm
ImmInt (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
bwInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))) (Reg -> Operand
OpReg Reg
dst_r)
                    , Cond -> Format -> Operand -> Reg -> Instr
CMOV Cond
NE Format
format (Reg -> Operand
OpReg Reg
tmp_r) Reg
dst_r
                    , Format -> Operand -> Operand -> Instr
XOR     Format
format (Imm -> Operand
OpImm (Int -> Imm
ImmInt (Int
bwInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))) (Reg -> Operand
OpReg Reg
dst_r)
                    ]) 
                       
                       
genWordToFloat :: BlockId -> Width -> CmmFormal -> CmmActual -> NatM InstrBlock
genWordToFloat :: Label -> Width -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
genWordToFloat Label
bid Width
width LocalReg
dst CmmExpr
src =
  
  Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genPrimCCall Label
bid (Width -> FastString
word2FloatLabel Width
width) [LocalReg
dst] [CmmExpr
src]
genAtomicRead :: Width -> MemoryOrdering -> LocalReg -> CmmExpr -> NatM InstrBlock
genAtomicRead :: Width
-> MemoryOrdering -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
genAtomicRead Width
width MemoryOrdering
_mord LocalReg
dst CmmExpr
addr = do
  Reg -> OrdList Instr
load_code <- (Operand -> Operand -> Instr)
-> CmmExpr -> NatM (Reg -> OrdList Instr)
intLoadCode (Format -> Operand -> Operand -> Instr
MOV (Width -> Format
intFormat Width
width)) CmmExpr
addr
  OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg -> OrdList Instr
load_code (LocalReg -> Reg
getLocalRegReg LocalReg
dst))
genAtomicWrite :: Width -> MemoryOrdering -> CmmExpr -> CmmExpr -> NatM InstrBlock
genAtomicWrite :: Width
-> MemoryOrdering -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genAtomicWrite Width
width MemoryOrdering
mord 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
  let needs_fence :: Bool
needs_fence = case MemoryOrdering
mord of
        MemoryOrdering
MemOrderSeqCst  -> Bool
True
        MemoryOrdering
MemOrderRelease -> Bool
False
        MemoryOrdering
MemOrderAcquire -> String -> SDoc -> Bool
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"genAtomicWrite: acquire ordering on write" SDoc
empty
        MemoryOrdering
MemOrderRelaxed -> Bool
False
  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
$ if Bool
needs_fence then OrdList Instr
code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Instr
MFENCE else OrdList Instr
code
genCmpXchg
  :: BlockId
  -> Width
  -> LocalReg
  -> CmmExpr
  -> CmmExpr
  -> CmmExpr
  -> NatM InstrBlock
genCmpXchg :: Label
-> Width
-> LocalReg
-> CmmExpr
-> CmmExpr
-> CmmExpr
-> NatM (OrdList Instr)
genCmpXchg Label
bid Width
width LocalReg
dst CmmExpr
addr CmmExpr
old CmmExpr
new = do
  Bool
is32Bit <- NatM Bool
is32BitPlatform
  
  
  
  if Bool -> Bool
not (Bool
is32Bit Bool -> Bool -> Bool
&& Width
width Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W64)
    then do
      let format :: Format
format = Width -> Format
intFormat Width
width
      Amode AddrMode
amode OrdList Instr
addr_code <- CmmExpr -> NatM Amode
getSimpleAmode CmmExpr
addr
      Reg
newval <- Format -> NatM Reg
getNewRegNat Format
format
      Reg -> OrdList Instr
newval_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
new
      Reg
oldval <- Format -> NatM Reg
getNewRegNat Format
format
      Reg -> OrdList Instr
oldval_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
old
      Platform
platform <- NatM Platform
getPlatform
      let dst_r :: Reg
dst_r    = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform  (LocalReg -> CmmReg
CmmLocal LocalReg
dst)
          code :: OrdList Instr
code     = [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL
                     [ Format -> Operand -> Operand -> Instr
MOV Format
format (Reg -> Operand
OpReg Reg
oldval) (Reg -> Operand
OpReg Reg
eax)
                     , Instr -> Instr
LOCK (Format -> Operand -> Operand -> Instr
CMPXCHG Format
format (Reg -> Operand
OpReg Reg
newval) (AddrMode -> Operand
OpAddr AddrMode
amode))
                     , Format -> Operand -> Operand -> Instr
MOV Format
format (Reg -> Operand
OpReg Reg
eax) (Reg -> Operand
OpReg Reg
dst_r)
                     ]
      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` Reg -> OrdList Instr
newval_code Reg
newval OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Reg -> OrdList Instr
oldval_code Reg
oldval
          OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code
    else
      
      Label
-> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
genPrimCCall Label
bid (Width -> FastString
cmpxchgLabel Width
width) [LocalReg
dst] [CmmExpr
addr,CmmExpr
old,CmmExpr
new]
      
genXchg :: Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
genXchg :: Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genXchg Width
width LocalReg
dst CmmExpr
addr CmmExpr
value = do
  Bool
is32Bit <- NatM Bool
is32BitPlatform
  Bool -> NatM () -> NatM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
is32Bit Bool -> Bool -> Bool
&& Width
width Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W64) (NatM () -> NatM ()) -> NatM () -> NatM ()
forall a b. (a -> b) -> a -> b
$
    String -> NatM ()
forall a. String -> a
panic String
"genXchg: 64bit atomic exchange not supported on 32bit platforms"
  Amode AddrMode
amode OrdList Instr
addr_code <- CmmExpr -> NatM Amode
getSimpleAmode CmmExpr
addr
  (Reg
newval, OrdList Instr
newval_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
value
  let format :: Format
format   = Width -> Format
intFormat Width
width
  let dst_r :: Reg
dst_r    = LocalReg -> Reg
getLocalRegReg LocalReg
dst
  
  let code :: OrdList Instr
code     = [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL
                 [ Format -> Operand -> Operand -> Instr
MOV Format
format (Reg -> Operand
OpReg Reg
newval) (Reg -> Operand
OpReg Reg
dst_r)
                  
                  
                 , Format -> Operand -> Reg -> Instr
XCHG Format
format (AddrMode -> Operand
OpAddr AddrMode
amode) Reg
dst_r
                 ]
  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
newval_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code
genFloatAbs :: Width -> LocalReg -> CmmExpr -> NatM InstrBlock
genFloatAbs :: Width -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
genFloatAbs Width
width LocalReg
dst CmmExpr
src = do
  let
    format :: Format
format = Width -> Format
floatFormat Width
width
    const :: CmmLit
const = case Width
width of
      Width
W32 -> Integer -> Width -> CmmLit
CmmInt Integer
0x7fffffff Width
W32
      Width
W64 -> Integer -> Width -> CmmLit
CmmInt Integer
0x7fffffffffffffff Width
W64
      Width
_   -> String -> SDoc -> CmmLit
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"genFloatAbs: invalid width" (Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
width)
  Reg -> OrdList Instr
src_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
src
  Amode AddrMode
amode OrdList Instr
amode_code <- Alignment -> CmmLit -> NatM Amode
memConstant (Int -> Alignment
mkAlignment (Int -> Alignment) -> Int -> Alignment
forall a b. (a -> b) -> a -> b
$ Width -> Int
widthInBytes Width
width) CmmLit
const
  Reg
tmp <- Format -> NatM Reg
getNewRegNat Format
format
  let dst_r :: Reg
dst_r = LocalReg -> Reg
getLocalRegReg LocalReg
dst
  OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ Reg -> OrdList Instr
src_code Reg
dst_r OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
amode_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 -> Operand -> Operand -> Instr
MOV Format
format (AddrMode -> Operand
OpAddr AddrMode
amode) (Reg -> Operand
OpReg Reg
tmp)
           , Format -> Operand -> Operand -> Instr
AND Format
format (Reg -> Operand
OpReg Reg
tmp) (Reg -> Operand
OpReg Reg
dst_r)
           ]
genFloatSqrt :: Format -> LocalReg -> CmmExpr -> NatM InstrBlock
genFloatSqrt :: Format -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
genFloatSqrt Format
format LocalReg
dst CmmExpr
src = do
  let dst_r :: Reg
dst_r = LocalReg -> Reg
getLocalRegReg LocalReg
dst
  Reg -> OrdList Instr
src_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
src
  OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ Reg -> OrdList Instr
src_code Reg
dst_r OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Operand -> Reg -> Instr
SQRT Format
format (Reg -> Operand
OpReg Reg
dst_r) Reg
dst_r
genAddSubRetCarry
  :: Width
  -> (Format -> Operand -> Operand -> Instr)
  -> (Format -> Maybe (Operand -> Operand -> Instr))
  -> Cond
  -> LocalReg
  -> LocalReg
  -> CmmExpr
  -> CmmExpr
  -> NatM InstrBlock
genAddSubRetCarry :: Width
-> (Format -> Operand -> Operand -> Instr)
-> (Format -> Maybe (Operand -> Operand -> Instr))
-> Cond
-> LocalReg
-> LocalReg
-> CmmExpr
-> CmmExpr
-> NatM (OrdList Instr)
genAddSubRetCarry Width
width Format -> Operand -> Operand -> Instr
instr Format -> Maybe (Operand -> Operand -> Instr)
mrevinstr Cond
cond LocalReg
res_r LocalReg
res_c CmmExpr
arg_x CmmExpr
arg_y = do
  Platform
platform <- NCGConfig -> Platform
ncgPlatform (NCGConfig -> Platform) -> NatM NCGConfig -> NatM Platform
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NatM NCGConfig
getConfig
  let format :: Format
format = Width -> Format
intFormat Width
width
  Reg -> OrdList Instr
rCode <- Register -> NatM (Reg -> OrdList Instr)
anyReg (Register -> NatM (Reg -> OrdList Instr))
-> NatM Register -> NatM (Reg -> OrdList Instr)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Width
-> (Operand -> Operand -> Instr)
-> Maybe (Operand -> Operand -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialCode Width
width (Format -> Operand -> Operand -> Instr
instr Format
format)
                        (Format -> Maybe (Operand -> Operand -> Instr)
mrevinstr Format
format) CmmExpr
arg_x CmmExpr
arg_y
  Reg
reg_tmp <- Format -> NatM Reg
getNewRegNat Format
II8
  let reg_c :: Reg
reg_c = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform  (LocalReg -> CmmReg
CmmLocal LocalReg
res_c)
      reg_r :: Reg
reg_r = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform  (LocalReg -> CmmReg
CmmLocal LocalReg
res_r)
      code :: OrdList Instr
code = Reg -> OrdList Instr
rCode Reg
reg_r OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
             Cond -> Operand -> Instr
SETCC Cond
cond (Reg -> Operand
OpReg Reg
reg_tmp) OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
             Format -> Operand -> Operand -> Instr
MOVZxL Format
II8 (Reg -> Operand
OpReg Reg
reg_tmp) (Reg -> Operand
OpReg Reg
reg_c)
  OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return OrdList Instr
code
genAddWithCarry
  :: Width
  -> LocalReg
  -> LocalReg
  -> CmmExpr
  -> CmmExpr
  -> NatM InstrBlock
genAddWithCarry :: Width
-> LocalReg
-> LocalReg
-> CmmExpr
-> CmmExpr
-> NatM (OrdList Instr)
genAddWithCarry Width
width LocalReg
res_h LocalReg
res_l CmmExpr
arg_x CmmExpr
arg_y = do
  Reg -> OrdList Instr
hCode <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg (CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt Integer
0 Width
width))
  let format :: Format
format = Width -> Format
intFormat Width
width
  Reg -> OrdList Instr
lCode <- Register -> NatM (Reg -> OrdList Instr)
anyReg (Register -> NatM (Reg -> OrdList Instr))
-> NatM Register -> NatM (Reg -> OrdList Instr)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Width
-> (Operand -> Operand -> Instr)
-> Maybe (Operand -> Operand -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialCode Width
width (Format -> Operand -> Operand -> Instr
ADD_CC Format
format)
                        ((Operand -> Operand -> Instr)
-> Maybe (Operand -> Operand -> Instr)
forall a. a -> Maybe a
Just (Format -> Operand -> Operand -> Instr
ADD_CC Format
format)) CmmExpr
arg_x CmmExpr
arg_y
  let reg_l :: Reg
reg_l = LocalReg -> Reg
getLocalRegReg LocalReg
res_l
      reg_h :: Reg
reg_h = LocalReg -> Reg
getLocalRegReg LocalReg
res_h
      code :: OrdList Instr
code = Reg -> OrdList Instr
hCode Reg
reg_h OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
             Reg -> OrdList Instr
lCode Reg
reg_l OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
             Format -> Operand -> Operand -> Instr
ADC Format
format (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
0)) (Reg -> Operand
OpReg Reg
reg_h)
  OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return OrdList Instr
code
genSignedLargeMul
  :: Width
  -> LocalReg
  -> LocalReg
  -> LocalReg
  -> CmmExpr
  -> CmmExpr
  -> NatM (OrdList Instr)
genSignedLargeMul :: Width
-> LocalReg
-> LocalReg
-> LocalReg
-> CmmExpr
-> CmmExpr
-> NatM (OrdList Instr)
genSignedLargeMul Width
width LocalReg
res_c LocalReg
res_h LocalReg
res_l CmmExpr
arg_x CmmExpr
arg_y = do
  (Operand
y_reg, OrdList Instr
y_code) <- CmmExpr -> NatM (Operand, OrdList Instr)
getRegOrMem CmmExpr
arg_y
  Reg -> OrdList Instr
x_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
arg_x
  Reg
reg_tmp <- Format -> NatM Reg
getNewRegNat Format
II8
  let format :: Format
format = Width -> Format
intFormat Width
width
      reg_h :: Reg
reg_h = LocalReg -> Reg
getLocalRegReg LocalReg
res_h
      reg_l :: Reg
reg_l = LocalReg -> Reg
getLocalRegReg LocalReg
res_l
      reg_c :: Reg
reg_c = LocalReg -> Reg
getLocalRegReg LocalReg
res_c
      code :: OrdList Instr
code = OrdList Instr
y_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
             Reg -> OrdList Instr
x_code Reg
rax 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 -> Operand -> Instr
IMUL2 Format
format Operand
y_reg
                  , Format -> Operand -> Operand -> Instr
MOV Format
format (Reg -> Operand
OpReg Reg
rdx) (Reg -> Operand
OpReg Reg
reg_h)
                  , Format -> Operand -> Operand -> Instr
MOV Format
format (Reg -> Operand
OpReg Reg
rax) (Reg -> Operand
OpReg Reg
reg_l)
                  , Cond -> Operand -> Instr
SETCC Cond
CARRY (Reg -> Operand
OpReg Reg
reg_tmp)
                  , Format -> Operand -> Operand -> Instr
MOVZxL Format
II8 (Reg -> Operand
OpReg Reg
reg_tmp) (Reg -> Operand
OpReg Reg
reg_c)
                  ]
  OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return OrdList Instr
code
genUnsignedLargeMul
  :: Width
  -> LocalReg
  -> LocalReg
  -> CmmExpr
  -> CmmExpr
  -> NatM (OrdList Instr)
genUnsignedLargeMul :: Width
-> LocalReg
-> LocalReg
-> CmmExpr
-> CmmExpr
-> NatM (OrdList Instr)
genUnsignedLargeMul Width
width LocalReg
res_h LocalReg
res_l CmmExpr
arg_x CmmExpr
arg_y = do
  (Operand
y_reg, OrdList Instr
y_code) <- CmmExpr -> NatM (Operand, OrdList Instr)
getRegOrMem CmmExpr
arg_y
  Reg -> OrdList Instr
x_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
arg_x
  let format :: Format
format = Width -> Format
intFormat Width
width
      reg_h :: Reg
reg_h = LocalReg -> Reg
getLocalRegReg LocalReg
res_h
      reg_l :: Reg
reg_l = LocalReg -> Reg
getLocalRegReg LocalReg
res_l
      code :: OrdList Instr
code = OrdList Instr
y_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
             Reg -> OrdList Instr
x_code Reg
rax 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 -> Operand -> Instr
MUL2 Format
format Operand
y_reg,
                   Format -> Operand -> Operand -> Instr
MOV Format
format (Reg -> Operand
OpReg Reg
rdx) (Reg -> Operand
OpReg Reg
reg_h),
                   Format -> Operand -> Operand -> Instr
MOV Format
format (Reg -> Operand
OpReg Reg
rax) (Reg -> Operand
OpReg Reg
reg_l)]
  OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return OrdList Instr
code
genQuotRem
  :: Width
  -> Bool
  -> LocalReg
  -> LocalReg
  -> Maybe CmmExpr
  -> CmmExpr
  -> CmmExpr
  -> NatM InstrBlock
genQuotRem :: Width
-> Bool
-> LocalReg
-> LocalReg
-> Maybe CmmExpr
-> CmmExpr
-> CmmExpr
-> NatM (OrdList Instr)
genQuotRem Width
width Bool
signed LocalReg
res_q LocalReg
res_r Maybe CmmExpr
m_arg_x_high CmmExpr
arg_x_low CmmExpr
arg_y = do
  case Width
width of
    Width
W8 -> do
      
      let widen :: MachOp
widen | Bool
signed = Width -> Width -> MachOp
MO_SS_Conv Width
W8 Width
W16
                | Bool
otherwise = Width -> Width -> MachOp
MO_UU_Conv Width
W8 Width
W16
          arg_x_low_16 :: CmmExpr
arg_x_low_16 = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp MachOp
widen [CmmExpr
arg_x_low]
          arg_y_16 :: CmmExpr
arg_y_16 = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp MachOp
widen [CmmExpr
arg_y]
          m_arg_x_high_16 :: Maybe CmmExpr
m_arg_x_high_16 = (\CmmExpr
p -> MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp MachOp
widen [CmmExpr
p]) (CmmExpr -> CmmExpr) -> Maybe CmmExpr -> Maybe CmmExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CmmExpr
m_arg_x_high
      Width
-> Bool
-> LocalReg
-> LocalReg
-> Maybe CmmExpr
-> CmmExpr
-> CmmExpr
-> NatM (OrdList Instr)
genQuotRem Width
W16 Bool
signed LocalReg
res_q LocalReg
res_r Maybe CmmExpr
m_arg_x_high_16 CmmExpr
arg_x_low_16 CmmExpr
arg_y_16
    Width
_ -> do
      let format :: Format
format = Width -> Format
intFormat Width
width
          reg_q :: Reg
reg_q = LocalReg -> Reg
getLocalRegReg LocalReg
res_q
          reg_r :: Reg
reg_r = LocalReg -> Reg
getLocalRegReg LocalReg
res_r
          widen :: Instr
widen | Bool
signed    = Format -> Instr
CLTD Format
format
                | Bool
otherwise = Format -> Operand -> Operand -> Instr
XOR Format
format (Reg -> Operand
OpReg Reg
rdx) (Reg -> Operand
OpReg Reg
rdx)
          instr :: Format -> Operand -> Instr
instr | Bool
signed    = Format -> Operand -> Instr
IDIV
                | Bool
otherwise = Format -> Operand -> Instr
DIV
      (Operand
y_reg, OrdList Instr
y_code) <- CmmExpr -> NatM (Operand, OrdList Instr)
getRegOrMem CmmExpr
arg_y
      Reg -> OrdList Instr
x_low_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
arg_x_low
      Reg -> OrdList Instr
x_high_code <- case Maybe CmmExpr
m_arg_x_high of
                     Just CmmExpr
arg_x_high ->
                         CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
arg_x_high
                     Maybe CmmExpr
Nothing ->
                         (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
$ OrdList Instr -> Reg -> OrdList Instr
forall a b. a -> b -> a
const (OrdList Instr -> Reg -> OrdList Instr)
-> OrdList Instr -> Reg -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL Instr
widen
      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`
               Reg -> OrdList Instr
x_low_code Reg
rax OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
               Reg -> OrdList Instr
x_high_code Reg
rdx 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 -> Operand -> Instr
instr Format
format Operand
y_reg,
                     Format -> Operand -> Operand -> Instr
MOV Format
format (Reg -> Operand
OpReg Reg
rax) (Reg -> Operand
OpReg Reg
reg_q),
                     Format -> Operand -> Operand -> Instr
MOV Format
format (Reg -> Operand
OpReg Reg
rdx) (Reg -> Operand
OpReg Reg
reg_r)]
genInt64ToInt :: LocalReg -> CmmExpr -> NatM InstrBlock
genInt64ToInt :: LocalReg -> CmmExpr -> NatM (OrdList Instr)
genInt64ToInt LocalReg
dst CmmExpr
src = do
  SDoc -> NatM ()
expect32BitPlatform (String -> SDoc
text String
"genInt64ToInt")
  RegCode64 OrdList Instr
code Reg
_src_hi Reg
src_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
src
  let dst_r :: Reg
dst_r = LocalReg -> Reg
getLocalRegReg LocalReg
dst
  OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ OrdList Instr
code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
src_lo) (Reg -> Operand
OpReg Reg
dst_r)
genWord64ToWord :: LocalReg -> CmmExpr -> NatM InstrBlock
genWord64ToWord :: LocalReg -> CmmExpr -> NatM (OrdList Instr)
genWord64ToWord LocalReg
dst CmmExpr
src = do
  SDoc -> NatM ()
expect32BitPlatform (String -> SDoc
text String
"genWord64ToWord")
  RegCode64 OrdList Instr
code Reg
_src_hi Reg
src_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
src
  let dst_r :: Reg
dst_r = LocalReg -> Reg
getLocalRegReg LocalReg
dst
  OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ OrdList Instr
code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
src_lo) (Reg -> Operand
OpReg Reg
dst_r)
genIntToInt64 :: LocalReg -> CmmExpr -> NatM InstrBlock
genIntToInt64 :: LocalReg -> CmmExpr -> NatM (OrdList Instr)
genIntToInt64 LocalReg
dst CmmExpr
src = do
  SDoc -> NatM ()
expect32BitPlatform (String -> SDoc
text String
"genIntToInt64")
  let Reg64 Reg
dst_hi Reg
dst_lo = (() :: Constraint) => LocalReg -> Reg64
LocalReg -> Reg64
localReg64 LocalReg
dst
  Reg -> OrdList Instr
src_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
src
  OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ Reg -> OrdList Instr
src_code Reg
rax 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 -> Instr
CLTD Format
II32 
          , Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
rax) (Reg -> Operand
OpReg Reg
dst_lo)
          , Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
rdx) (Reg -> Operand
OpReg Reg
dst_hi)
          ]
genWordToWord64 :: LocalReg -> CmmExpr -> NatM InstrBlock
genWordToWord64 :: LocalReg -> CmmExpr -> NatM (OrdList Instr)
genWordToWord64 LocalReg
dst CmmExpr
src = do
  SDoc -> NatM ()
expect32BitPlatform (String -> SDoc
text String
"genWordToWord64")
  let Reg64 Reg
dst_hi Reg
dst_lo = (() :: Constraint) => LocalReg -> Reg64
LocalReg -> Reg64
localReg64 LocalReg
dst
  Reg -> OrdList Instr
src_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
getAnyReg CmmExpr
src
  OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ Reg -> OrdList Instr
src_code Reg
dst_lo
          OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Operand -> Operand -> Instr
XOR Format
II32 (Reg -> Operand
OpReg Reg
dst_hi) (Reg -> Operand
OpReg Reg
dst_hi)
genNeg64 :: LocalReg -> CmmExpr -> NatM InstrBlock
genNeg64 :: LocalReg -> CmmExpr -> NatM (OrdList Instr)
genNeg64 LocalReg
dst CmmExpr
src = do
  SDoc -> NatM ()
expect32BitPlatform (String -> SDoc
text String
"genNeg64")
  let Reg64 Reg
dst_hi Reg
dst_lo = (() :: Constraint) => LocalReg -> Reg64
LocalReg -> Reg64
localReg64 LocalReg
dst
  RegCode64 OrdList Instr
code Reg
src_hi Reg
src_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
src
  OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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` [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL
          [ Format -> Operand -> Operand -> Instr
MOV  Format
II32 (Reg -> Operand
OpReg Reg
src_lo) (Reg -> Operand
OpReg Reg
dst_lo)
          , Format -> Operand -> Operand -> Instr
MOV  Format
II32 (Reg -> Operand
OpReg Reg
src_hi) (Reg -> Operand
OpReg Reg
dst_hi)
          , Format -> Operand -> Instr
NEGI Format
II32 (Reg -> Operand
OpReg Reg
dst_lo)
          , Format -> Operand -> Operand -> Instr
ADC  Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
0)) (Reg -> Operand
OpReg Reg
dst_hi)
          , Format -> Operand -> Instr
NEGI Format
II32 (Reg -> Operand
OpReg Reg
dst_hi)
          ]
genAdd64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
genAdd64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genAdd64 LocalReg
dst CmmExpr
x CmmExpr
y = do
  SDoc -> NatM ()
expect32BitPlatform (String -> SDoc
text String
"genAdd64")
  let Reg64 Reg
dst_hi Reg
dst_lo = (() :: Constraint) => LocalReg -> Reg64
LocalReg -> Reg64
localReg64 LocalReg
dst
  RegCode64 OrdList Instr
x_code Reg
x_hi Reg
x_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
x
  RegCode64 OrdList Instr
y_code Reg
y_hi Reg
y_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
y
  OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ OrdList Instr
x_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
y_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 -> Operand -> Operand -> Instr
MOV  Format
II32 (Reg -> Operand
OpReg Reg
x_lo) (Reg -> Operand
OpReg Reg
dst_lo)
          , Format -> Operand -> Operand -> Instr
MOV  Format
II32 (Reg -> Operand
OpReg Reg
x_hi) (Reg -> Operand
OpReg Reg
dst_hi)
          , Format -> Operand -> Operand -> Instr
ADD  Format
II32 (Reg -> Operand
OpReg Reg
y_lo) (Reg -> Operand
OpReg Reg
dst_lo)
          , Format -> Operand -> Operand -> Instr
ADC  Format
II32 (Reg -> Operand
OpReg Reg
y_hi) (Reg -> Operand
OpReg Reg
dst_hi)
          ]
genSub64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
genSub64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genSub64 LocalReg
dst CmmExpr
x CmmExpr
y = do
  SDoc -> NatM ()
expect32BitPlatform (String -> SDoc
text String
"genSub64")
  let Reg64 Reg
dst_hi Reg
dst_lo = (() :: Constraint) => LocalReg -> Reg64
LocalReg -> Reg64
localReg64 LocalReg
dst
  RegCode64 OrdList Instr
x_code Reg
x_hi Reg
x_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
x
  RegCode64 OrdList Instr
y_code Reg
y_hi Reg
y_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
y
  OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ OrdList Instr
x_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
y_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 -> Operand -> Operand -> Instr
MOV  Format
II32 (Reg -> Operand
OpReg Reg
x_lo) (Reg -> Operand
OpReg Reg
dst_lo)
          , Format -> Operand -> Operand -> Instr
MOV  Format
II32 (Reg -> Operand
OpReg Reg
x_hi) (Reg -> Operand
OpReg Reg
dst_hi)
          , Format -> Operand -> Operand -> Instr
SUB  Format
II32 (Reg -> Operand
OpReg Reg
y_lo) (Reg -> Operand
OpReg Reg
dst_lo)
          , Format -> Operand -> Operand -> Instr
SBB  Format
II32 (Reg -> Operand
OpReg Reg
y_hi) (Reg -> Operand
OpReg Reg
dst_hi)
          ]
genAnd64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
genAnd64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genAnd64 LocalReg
dst CmmExpr
x CmmExpr
y = do
  SDoc -> NatM ()
expect32BitPlatform (String -> SDoc
text String
"genAnd64")
  let Reg64 Reg
dst_hi Reg
dst_lo = (() :: Constraint) => LocalReg -> Reg64
LocalReg -> Reg64
localReg64 LocalReg
dst
  RegCode64 OrdList Instr
x_code Reg
x_hi Reg
x_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
x
  RegCode64 OrdList Instr
y_code Reg
y_hi Reg
y_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
y
  OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ OrdList Instr
x_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
y_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 -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
x_lo) (Reg -> Operand
OpReg Reg
dst_lo)
          , Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
x_hi) (Reg -> Operand
OpReg Reg
dst_hi)
          , Format -> Operand -> Operand -> Instr
AND Format
II32 (Reg -> Operand
OpReg Reg
y_lo) (Reg -> Operand
OpReg Reg
dst_lo)
          , Format -> Operand -> Operand -> Instr
AND Format
II32 (Reg -> Operand
OpReg Reg
y_hi) (Reg -> Operand
OpReg Reg
dst_hi)
          ]
genOr64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
genOr64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genOr64 LocalReg
dst CmmExpr
x CmmExpr
y = do
  SDoc -> NatM ()
expect32BitPlatform (String -> SDoc
text String
"genOr64")
  let Reg64 Reg
dst_hi Reg
dst_lo = (() :: Constraint) => LocalReg -> Reg64
LocalReg -> Reg64
localReg64 LocalReg
dst
  RegCode64 OrdList Instr
x_code Reg
x_hi Reg
x_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
x
  RegCode64 OrdList Instr
y_code Reg
y_hi Reg
y_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
y
  OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ OrdList Instr
x_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
y_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 -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
x_lo) (Reg -> Operand
OpReg Reg
dst_lo)
          , Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
x_hi) (Reg -> Operand
OpReg Reg
dst_hi)
          , Format -> Operand -> Operand -> Instr
OR  Format
II32 (Reg -> Operand
OpReg Reg
y_lo) (Reg -> Operand
OpReg Reg
dst_lo)
          , Format -> Operand -> Operand -> Instr
OR  Format
II32 (Reg -> Operand
OpReg Reg
y_hi) (Reg -> Operand
OpReg Reg
dst_hi)
          ]
genXor64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
genXor64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genXor64 LocalReg
dst CmmExpr
x CmmExpr
y = do
  SDoc -> NatM ()
expect32BitPlatform (String -> SDoc
text String
"genXor64")
  let Reg64 Reg
dst_hi Reg
dst_lo = (() :: Constraint) => LocalReg -> Reg64
LocalReg -> Reg64
localReg64 LocalReg
dst
  RegCode64 OrdList Instr
x_code Reg
x_hi Reg
x_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
x
  RegCode64 OrdList Instr
y_code Reg
y_hi Reg
y_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
y
  OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ OrdList Instr
x_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
y_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 -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
x_lo) (Reg -> Operand
OpReg Reg
dst_lo)
          , Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
x_hi) (Reg -> Operand
OpReg Reg
dst_hi)
          , Format -> Operand -> Operand -> Instr
XOR Format
II32 (Reg -> Operand
OpReg Reg
y_lo) (Reg -> Operand
OpReg Reg
dst_lo)
          , Format -> Operand -> Operand -> Instr
XOR Format
II32 (Reg -> Operand
OpReg Reg
y_hi) (Reg -> Operand
OpReg Reg
dst_hi)
          ]
genNot64 :: LocalReg -> CmmExpr -> NatM InstrBlock
genNot64 :: LocalReg -> CmmExpr -> NatM (OrdList Instr)
genNot64 LocalReg
dst CmmExpr
src = do
  SDoc -> NatM ()
expect32BitPlatform (String -> SDoc
text String
"genNot64")
  let Reg64 Reg
dst_hi Reg
dst_lo = (() :: Constraint) => LocalReg -> Reg64
LocalReg -> Reg64
localReg64 LocalReg
dst
  RegCode64 OrdList Instr
src_code Reg
src_hi Reg
src_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
src
  OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ OrdList Instr
src_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 -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
src_lo) (Reg -> Operand
OpReg Reg
dst_lo)
          , Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
src_hi) (Reg -> Operand
OpReg Reg
dst_hi)
          , Format -> Operand -> Instr
NOT Format
II32 (Reg -> Operand
OpReg Reg
dst_lo)
          , Format -> Operand -> Instr
NOT Format
II32 (Reg -> Operand
OpReg Reg
dst_hi)
          ]
genEq64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
genEq64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genEq64 LocalReg
dst CmmExpr
x CmmExpr
y = do
  SDoc -> NatM ()
expect32BitPlatform (String -> SDoc
text String
"genEq64")
  let dst_r :: Reg
dst_r = LocalReg -> Reg
getLocalRegReg LocalReg
dst
  RegCode64 OrdList Instr
x_code Reg
x_hi Reg
x_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
x
  RegCode64 OrdList Instr
y_code Reg
y_hi Reg
y_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
y
  Reg64 Reg
tmp_hi Reg
tmp_lo <- NatM Reg64
getNewReg64
  OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ OrdList Instr
x_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
y_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 -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
x_lo)   (Reg -> Operand
OpReg Reg
tmp_lo)
          , Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
x_hi)   (Reg -> Operand
OpReg Reg
tmp_hi)
          , Format -> Operand -> Operand -> Instr
XOR Format
II32 (Reg -> Operand
OpReg Reg
y_lo)   (Reg -> Operand
OpReg Reg
tmp_lo)
          , Format -> Operand -> Operand -> Instr
XOR Format
II32 (Reg -> Operand
OpReg Reg
y_hi)   (Reg -> Operand
OpReg Reg
tmp_hi)
          , Format -> Operand -> Operand -> Instr
OR  Format
II32 (Reg -> Operand
OpReg Reg
tmp_lo) (Reg -> Operand
OpReg Reg
tmp_hi)
          , Cond -> Operand -> Instr
SETCC Cond
EQQ (Reg -> Operand
OpReg Reg
dst_r)
          , Format -> Operand -> Operand -> Instr
MOVZxL Format
II8 (Reg -> Operand
OpReg Reg
dst_r) (Reg -> Operand
OpReg Reg
dst_r)
          ]
genNe64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
genNe64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genNe64 LocalReg
dst CmmExpr
x CmmExpr
y = do
  SDoc -> NatM ()
expect32BitPlatform (String -> SDoc
text String
"genNe64")
  let dst_r :: Reg
dst_r = LocalReg -> Reg
getLocalRegReg LocalReg
dst
  RegCode64 OrdList Instr
x_code Reg
x_hi Reg
x_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
x
  RegCode64 OrdList Instr
y_code Reg
y_hi Reg
y_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
y
  Reg64 Reg
tmp_hi Reg
tmp_lo <- NatM Reg64
getNewReg64
  OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ OrdList Instr
x_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
y_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 -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
x_lo)   (Reg -> Operand
OpReg Reg
tmp_lo)
          , Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
x_hi)   (Reg -> Operand
OpReg Reg
tmp_hi)
          , Format -> Operand -> Operand -> Instr
XOR Format
II32 (Reg -> Operand
OpReg Reg
y_lo)   (Reg -> Operand
OpReg Reg
tmp_lo)
          , Format -> Operand -> Operand -> Instr
XOR Format
II32 (Reg -> Operand
OpReg Reg
y_hi)   (Reg -> Operand
OpReg Reg
tmp_hi)
          , Format -> Operand -> Operand -> Instr
OR  Format
II32 (Reg -> Operand
OpReg Reg
tmp_lo) (Reg -> Operand
OpReg Reg
tmp_hi)
          , Cond -> Operand -> Instr
SETCC Cond
NE (Reg -> Operand
OpReg Reg
dst_r)
          , Format -> Operand -> Operand -> Instr
MOVZxL Format
II8 (Reg -> Operand
OpReg Reg
dst_r) (Reg -> Operand
OpReg Reg
dst_r)
          ]
genGtWord64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
genGtWord64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genGtWord64 LocalReg
dst CmmExpr
x CmmExpr
y = do
  SDoc -> NatM ()
expect32BitPlatform (String -> SDoc
text String
"genGtWord64")
  Cond -> LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genPred64 Cond
LU LocalReg
dst CmmExpr
y CmmExpr
x
genLtWord64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
genLtWord64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genLtWord64 LocalReg
dst CmmExpr
x CmmExpr
y = do
  SDoc -> NatM ()
expect32BitPlatform (String -> SDoc
text String
"genLtWord64")
  Cond -> LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genPred64 Cond
LU LocalReg
dst CmmExpr
x CmmExpr
y
genGeWord64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
genGeWord64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genGeWord64 LocalReg
dst CmmExpr
x CmmExpr
y = do
  SDoc -> NatM ()
expect32BitPlatform (String -> SDoc
text String
"genGeWord64")
  Cond -> LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genPred64 Cond
GEU LocalReg
dst CmmExpr
x CmmExpr
y
genLeWord64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
genLeWord64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genLeWord64 LocalReg
dst CmmExpr
x CmmExpr
y = do
  SDoc -> NatM ()
expect32BitPlatform (String -> SDoc
text String
"genLeWord64")
  Cond -> LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genPred64 Cond
GEU LocalReg
dst CmmExpr
y CmmExpr
x
genGtInt64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
genGtInt64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genGtInt64 LocalReg
dst CmmExpr
x CmmExpr
y = do
  SDoc -> NatM ()
expect32BitPlatform (String -> SDoc
text String
"genGtInt64")
  Cond -> LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genPred64 Cond
LTT LocalReg
dst CmmExpr
y CmmExpr
x
genLtInt64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
genLtInt64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genLtInt64 LocalReg
dst CmmExpr
x CmmExpr
y = do
  SDoc -> NatM ()
expect32BitPlatform (String -> SDoc
text String
"genLtInt64")
  Cond -> LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genPred64 Cond
LTT LocalReg
dst CmmExpr
x CmmExpr
y
genGeInt64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
genGeInt64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genGeInt64 LocalReg
dst CmmExpr
x CmmExpr
y = do
  SDoc -> NatM ()
expect32BitPlatform (String -> SDoc
text String
"genGeInt64")
  Cond -> LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genPred64 Cond
GE LocalReg
dst CmmExpr
x CmmExpr
y
genLeInt64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
genLeInt64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genLeInt64 LocalReg
dst CmmExpr
x CmmExpr
y = do
  SDoc -> NatM ()
expect32BitPlatform (String -> SDoc
text String
"genLeInt64")
  Cond -> LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genPred64 Cond
GE LocalReg
dst CmmExpr
y CmmExpr
x
genPred64 :: Cond -> LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
genPred64 :: Cond -> LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
genPred64 Cond
cond LocalReg
dst CmmExpr
x CmmExpr
y = do
  
  
  Bool -> NatM ()
forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
massert (Cond
cond Cond -> [Cond] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Cond
LU,Cond
GEU,Cond
LTT,Cond
GE])
  let dst_r :: Reg
dst_r = LocalReg -> Reg
getLocalRegReg LocalReg
dst
  RegCode64 OrdList Instr
x_code Reg
x_hi Reg
x_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
x
  RegCode64 OrdList Instr
y_code Reg
y_hi Reg
y_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
y
  
  
  
  OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ OrdList Instr
x_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
y_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 -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
x_hi) (Reg -> Operand
OpReg Reg
dst_r)
          , Format -> Operand -> Operand -> Instr
CMP Format
II32 (Reg -> Operand
OpReg Reg
y_lo) (Reg -> Operand
OpReg Reg
x_lo)
          , Format -> Operand -> Operand -> Instr
SBB Format
II32 (Reg -> Operand
OpReg Reg
y_hi) (Reg -> Operand
OpReg Reg
dst_r)
          , Cond -> Operand -> Instr
SETCC Cond
cond (Reg -> Operand
OpReg Reg
dst_r)
          , Format -> Operand -> Operand -> Instr
MOVZxL Format
II8 (Reg -> Operand
OpReg Reg
dst_r) (Reg -> Operand
OpReg Reg
dst_r)
          ]