{-# language GADTs #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE OverloadedStrings #-}
module GHC.CmmToAsm.AArch64.CodeGen (
      cmmTopCodeGen
    , generateJumpTableForInstr
    , makeFarBranches
)
where
import GHC.Prelude hiding (EQ)
import Data.Word
import GHC.Platform.Regs
import GHC.CmmToAsm.AArch64.Instr
import GHC.CmmToAsm.AArch64.Regs
import GHC.CmmToAsm.AArch64.Cond
import GHC.CmmToAsm.CPrim
import GHC.Cmm.DebugBlock
import GHC.CmmToAsm.Monad
   ( NatM, getNewRegNat
   , getPicBaseMaybeNat, getPlatform, getConfig
   , getDebugBlock, getFileId
   )
import GHC.CmmToAsm.PIC
import GHC.CmmToAsm.Format
import GHC.CmmToAsm.Config
import GHC.CmmToAsm.Types
import GHC.Platform.Reg
import GHC.Platform
import GHC.Cmm.BlockId
import GHC.Cmm
import GHC.Cmm.Utils
import GHC.Cmm.Switch
import GHC.Cmm.CLabel
import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Label
import GHC.Cmm.Dataflow.Graph
import GHC.Types.Tickish ( GenTickish(..) )
import GHC.Types.SrcLoc  ( srcSpanFile, srcSpanStartLine, srcSpanStartCol )
import GHC.Types.Unique.Supply
import GHC.Data.OrdList
import GHC.Utils.Outputable
import Control.Monad    ( mapAndUnzipM, foldM )
import Data.Maybe
import GHC.Float
import GHC.Types.Basic
import GHC.Types.ForeignCall
import GHC.Data.FastString
import GHC.Utils.Misc
import GHC.Utils.Panic
import GHC.Utils.Monad (mapAccumLM)
import GHC.Cmm.Dataflow.Collections
cmmTopCodeGen
    :: RawCmmDecl
    -> NatM [NatCmmDecl RawCmmStatics Instr]
cmmTopCodeGen :: RawCmmDecl -> NatM [NatCmmDecl RawCmmStatics Instr]
cmmTopCodeGen _cmm :: RawCmmDecl
_cmm@(CmmProc LabelMap RawCmmStatics
info CLabel
lab [GlobalReg]
live CmmGraph
graph) = do
  
  
  
  let blocks :: [Block CmmNode C C]
blocks = CmmGraph -> [Block CmmNode C C]
toBlockListEntryFirst CmmGraph
graph
  ([[NatBasicBlock Instr]]
nat_blocks,[[NatCmmDecl RawCmmStatics Instr]]
statics) <- (Block CmmNode C C
 -> NatM ([NatBasicBlock Instr], [NatCmmDecl RawCmmStatics Instr]))
-> [Block CmmNode C C]
-> NatM
     ([[NatBasicBlock Instr]], [[NatCmmDecl RawCmmStatics Instr]])
forall (m :: * -> *) a b c.
Applicative m =>
(a -> m (b, c)) -> [a] -> m ([b], [c])
mapAndUnzipM Block CmmNode C C
-> NatM ([NatBasicBlock Instr], [NatCmmDecl RawCmmStatics Instr])
basicBlockCodeGen [Block CmmNode C C]
blocks
  Maybe Reg
picBaseMb <- NatM (Maybe Reg)
getPicBaseMaybeNat
  let proc :: NatCmmDecl RawCmmStatics Instr
proc = LabelMap RawCmmStatics
-> CLabel
-> [GlobalReg]
-> ListGraph Instr
-> NatCmmDecl RawCmmStatics Instr
forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
CmmProc LabelMap RawCmmStatics
info CLabel
lab [GlobalReg]
live ([NatBasicBlock Instr] -> ListGraph Instr
forall i. [GenBasicBlock i] -> ListGraph i
ListGraph ([NatBasicBlock Instr] -> ListGraph Instr)
-> [NatBasicBlock Instr] -> ListGraph Instr
forall a b. (a -> b) -> a -> b
$ [[NatBasicBlock Instr]] -> [NatBasicBlock Instr]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[NatBasicBlock Instr]]
nat_blocks)
      tops :: [NatCmmDecl RawCmmStatics Instr]
tops = NatCmmDecl RawCmmStatics Instr
proc NatCmmDecl RawCmmStatics Instr
-> [NatCmmDecl RawCmmStatics Instr]
-> [NatCmmDecl RawCmmStatics Instr]
forall a. a -> [a] -> [a]
: [[NatCmmDecl RawCmmStatics Instr]]
-> [NatCmmDecl RawCmmStatics Instr]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[NatCmmDecl RawCmmStatics Instr]]
statics
  case Maybe Reg
picBaseMb of
      Just Reg
_picBase -> String -> NatM [NatCmmDecl RawCmmStatics Instr]
forall a. String -> a
panic String
"AArch64.cmmTopCodeGen: picBase not implemented"
      Maybe Reg
Nothing -> [NatCmmDecl RawCmmStatics Instr]
-> NatM [NatCmmDecl RawCmmStatics Instr]
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return [NatCmmDecl RawCmmStatics Instr]
tops
cmmTopCodeGen _cmm :: RawCmmDecl
_cmm@(CmmData Section
sec RawCmmStatics
dat) = do
  
  
  
  [NatCmmDecl RawCmmStatics Instr]
-> NatM [NatCmmDecl RawCmmStatics Instr]
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return [Section -> RawCmmStatics -> NatCmmDecl RawCmmStatics Instr
forall d h g. Section -> d -> GenCmmDecl d h g
CmmData Section
sec RawCmmStatics
dat] 
basicBlockCodeGen
        :: Block CmmNode C C
        -> NatM ( [NatBasicBlock Instr]
                , [NatCmmDecl RawCmmStatics Instr])
basicBlockCodeGen :: Block CmmNode C C
-> NatM ([NatBasicBlock Instr], [NatCmmDecl RawCmmStatics Instr])
basicBlockCodeGen Block CmmNode C C
block = do
  NCGConfig
config <- NatM NCGConfig
getConfig
  
  
  
  let (CmmNode C O
_, Block CmmNode O O
nodes, CmmNode O C
tail)  = Block CmmNode C C -> (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 Block CmmNode C C
block
      id :: Label
id = Block CmmNode C C -> Label
forall (x :: Extensibility). Block CmmNode C x -> Label
forall (thing :: Extensibility -> Extensibility -> *)
       (x :: Extensibility).
NonLocal thing =>
thing C x -> Label
entryLabel Block CmmNode C C
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
      header_comment_instr :: OrdList Instr
header_comment_instr = Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ SDoc -> Instr
MULTILINE_COMMENT (
          String -> SDoc
text String
"-- --------------------------- basicBlockCodeGen --------------------------- --\n"
          SDoc -> SDoc -> SDoc
$+$ Platform -> Block CmmNode C C -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc (NCGConfig -> Platform
ncgPlatform NCGConfig
config) Block CmmNode C C
block
          )
  
  Maybe DebugBlock
dbg <- Label -> NatM (Maybe DebugBlock)
getDebugBlock (Block CmmNode C C -> Label
forall (x :: Extensibility). Block CmmNode C x -> Label
forall (thing :: Extensibility -> Extensibility -> *)
       (x :: Extensibility).
NonLocal thing =>
thing C x -> Label
entryLabel Block CmmNode C C
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
header_comment_instr OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
loc_instrs OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
mid_instrs OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
tail_instrs
  
  
  
  
  
  
  let
        ([Instr]
top,[NatBasicBlock Instr]
other_blocks,[NatCmmDecl RawCmmStatics Instr]
statics) = (Instr
 -> ([Instr], [NatBasicBlock Instr],
     [NatCmmDecl RawCmmStatics Instr])
 -> ([Instr], [NatBasicBlock Instr],
     [NatCmmDecl RawCmmStatics Instr]))
-> ([Instr], [NatBasicBlock Instr],
    [NatCmmDecl RawCmmStatics Instr])
-> OrdList Instr
-> ([Instr], [NatBasicBlock Instr],
    [NatCmmDecl RawCmmStatics Instr])
forall a b. (a -> b -> b) -> b -> OrdList a -> b
foldrOL Instr
-> ([Instr], [NatBasicBlock Instr],
    [NatCmmDecl RawCmmStatics Instr])
-> ([Instr], [NatBasicBlock Instr],
    [NatCmmDecl RawCmmStatics Instr])
forall h g.
Instr
-> ([Instr], [NatBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])
-> ([Instr], [NatBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])
mkBlocks ([],[],[]) OrdList Instr
instrs
  ([NatBasicBlock Instr], [NatCmmDecl RawCmmStatics Instr])
-> NatM ([NatBasicBlock Instr], [NatCmmDecl RawCmmStatics Instr])
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (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 RawCmmStatics Instr]
statics)
mkBlocks :: Instr
          -> ([Instr], [GenBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])
          -> ([Instr], [GenBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])
mkBlocks :: forall h g.
Instr
-> ([Instr], [NatBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])
-> ([Instr], [NatBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])
mkBlocks (NEWBLOCK Label
id) ([Instr]
instrs,[NatBasicBlock Instr]
blocks,[GenCmmDecl RawCmmStatics h g]
statics)
  = ([], 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 RawCmmStatics h g]
statics)
mkBlocks (LDATA Section
sec RawCmmStatics
dat) ([Instr]
instrs,[NatBasicBlock Instr]
blocks,[GenCmmDecl RawCmmStatics h g]
statics)
  = ([Instr]
instrs, [NatBasicBlock Instr]
blocks, Section -> RawCmmStatics -> GenCmmDecl RawCmmStatics h g
forall d h g. Section -> d -> GenCmmDecl d h g
CmmData Section
sec RawCmmStatics
datGenCmmDecl RawCmmStatics h g
-> [GenCmmDecl RawCmmStatics h g] -> [GenCmmDecl RawCmmStatics h g]
forall a. a -> [a] -> [a]
:[GenCmmDecl RawCmmStatics h g]
statics)
mkBlocks Instr
instr ([Instr]
instrs,[NatBasicBlock Instr]
blocks,[GenCmmDecl RawCmmStatics h g]
statics)
  = (Instr
instrInstr -> [Instr] -> [Instr]
forall a. a -> [a] -> [a]
:[Instr]
instrs, [NatBasicBlock Instr]
blocks, [GenCmmDecl RawCmmStatics h g]
statics)
ann :: SDoc -> Instr -> Instr
ann :: SDoc -> Instr -> Instr
ann SDoc
doc Instr
instr  = SDoc -> Instr -> Instr
ANN SDoc
doc Instr
instr
{-# INLINE ann #-}
annExpr :: CmmExpr -> Instr -> Instr
annExpr :: CmmExpr -> Instr -> Instr
annExpr CmmExpr
e Instr
instr  = SDoc -> Instr -> Instr
ANN (String -> SDoc
text (String -> SDoc) -> (CmmExpr -> String) -> CmmExpr -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmmExpr -> String
forall a. Show a => a -> String
show (CmmExpr -> SDoc) -> CmmExpr -> SDoc
forall a b. (a -> b) -> a -> b
$ CmmExpr
e) Instr
instr
{-# INLINE annExpr #-}
genSwitch :: CmmExpr -> SwitchTargets -> NatM InstrBlock
genSwitch :: CmmExpr -> SwitchTargets -> NatM (OrdList Instr)
genSwitch CmmExpr
expr SwitchTargets
targets = do 
  (Reg
reg, Format
format, OrdList Instr
code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg CmmExpr
expr
  let w :: Width
w = Format -> Width
formatToWidth Format
format
  let mkbranch :: OrdList Instr -> (Integer, Label) -> NatM (OrdList Instr)
mkbranch OrdList Instr
acc (Integer
key, Label
bid) = do
        (Reg
keyReg, Format
_format, OrdList Instr
code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg (CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt Integer
key Width
w))
        OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ OrdList Instr
code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                 [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Operand -> Operand -> Instr
CMP (Width -> Reg -> Operand
OpReg Width
w Reg
reg) (Width -> Reg -> Operand
OpReg Width
w Reg
keyReg)
                      , Cond -> Target -> Instr
BCOND Cond
EQ (Label -> Target
TBlock Label
bid)
                      ] OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
acc
      def_code :: OrdList Instr
def_code = case SwitchTargets -> Maybe Label
switchTargetsDefault SwitchTargets
targets of
        Just Label
bid -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Target -> Instr
B (Label -> Target
TBlock Label
bid))
        Maybe Label
Nothing  -> OrdList Instr
forall a. OrdList a
nilOL
  OrdList Instr
switch_code <- (OrdList Instr -> (Integer, Label) -> NatM (OrdList Instr))
-> OrdList Instr -> [(Integer, Label)] -> NatM (OrdList Instr)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM OrdList Instr -> (Integer, Label) -> NatM (OrdList Instr)
mkbranch OrdList Instr
forall a. OrdList a
nilOL (SwitchTargets -> [(Integer, Label)]
switchTargetsCases SwitchTargets
targets)
  OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ OrdList Instr
code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
switch_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
def_code
generateJumpTableForInstr :: NCGConfig -> Instr
  -> Maybe (NatCmmDecl RawCmmStatics Instr)
generateJumpTableForInstr :: NCGConfig -> Instr -> Maybe (NatCmmDecl RawCmmStatics Instr)
generateJumpTableForInstr NCGConfig
_ Instr
_ = Maybe (NatCmmDecl RawCmmStatics Instr)
forall a. Maybe a
Nothing
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
  
  
  Platform
platform <- NatM Platform
getPlatform
  case CmmNode e x
stmt of
    CmmUnsafeForeignCall ForeignTarget
target [CmmFormal]
result_regs [CmmExpr]
args
       -> ForeignTarget
-> [CmmFormal]
-> [CmmExpr]
-> Label
-> NatM (OrdList Instr, Maybe Label)
genCCall ForeignTarget
target [CmmFormal]
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 (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
      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
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
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          -> Label -> NatM (OrdList Instr)
genBranch Label
id
      
      
      CmmCondBranch CmmExpr
arg Label
true Label
false Maybe Bool
_prediction ->
          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 } -> CmmExpr -> NatM (OrdList Instr)
genJump CmmExpr
arg
      CmmUnwind [(GlobalReg, Maybe CmmExpr)]
_regs -> 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
      CmmNode e x
_ -> String -> SDoc -> NatM (OrdList Instr)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"stmtToInstrs: statement should have been cps'd away" (Platform -> CmmNode e x -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmNode e x
stmt)
type InstrBlock
        = OrdList Instr
data Register
        = Fixed Format Reg InstrBlock
        | Any   Format (Reg -> InstrBlock)
swizzleRegisterRep :: Format -> Register -> Register
swizzleRegisterRep :: Format -> Register -> Register
swizzleRegisterRep Format
format (Fixed Format
_ Reg
reg OrdList Instr
code) = Format -> Reg -> OrdList Instr -> Register
Fixed Format
format Reg
reg OrdList Instr
code
swizzleRegisterRep Format
format (Any Format
_ Reg -> OrdList Instr
codefn)     = Format -> (Reg -> OrdList Instr) -> Register
Any   Format
format Reg -> OrdList Instr
codefn
getRegisterReg :: Platform -> CmmReg -> Reg
getRegisterReg :: Platform -> CmmReg -> Reg
getRegisterReg Platform
_ (CmmLocal (LocalReg Unique
u CmmType
pk))
  = VirtualReg -> Reg
RegVirtual (VirtualReg -> Reg) -> VirtualReg -> Reg
forall a b. (a -> b) -> a -> b
$ Unique -> Format -> VirtualReg
mkVirtualReg Unique
u (CmmType -> Format
cmmTypeFormat CmmType
pk)
getRegisterReg Platform
platform (CmmGlobal GlobalReg
mid)
  = case Platform -> GlobalReg -> Maybe RealReg
globalRegMaybe Platform
platform GlobalReg
mid of
        Just RealReg
reg -> RealReg -> Reg
RegReal RealReg
reg
        Maybe RealReg
Nothing  -> 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)
        
        
        
        
getSomeReg :: CmmExpr -> NatM (Reg, Format, InstrBlock)
getSomeReg :: CmmExpr -> NatM (Reg, Format, 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, Format, OrdList Instr) -> NatM (Reg, Format, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg
tmp, Format
rep, Reg -> OrdList Instr
code Reg
tmp)
    Fixed Format
rep Reg
reg OrdList Instr
code ->
        (Reg, Format, OrdList Instr) -> NatM (Reg, Format, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg
reg, Format
rep, OrdList Instr
code)
getFloatReg :: HasCallStack => CmmExpr -> NatM (Reg, Format, InstrBlock)
getFloatReg :: HasCallStack => CmmExpr -> NatM (Reg, Format, OrdList Instr)
getFloatReg CmmExpr
expr = do
  Register
r <- CmmExpr -> NatM Register
getRegister CmmExpr
expr
  case Register
r of
    Any Format
rep Reg -> OrdList Instr
code | Format -> Bool
isFloatFormat Format
rep -> do
      Reg
tmp <- Format -> NatM Reg
getNewRegNat Format
rep
      (Reg, Format, OrdList Instr) -> NatM (Reg, Format, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg
tmp, Format
rep, Reg -> OrdList Instr
code Reg
tmp)
    Any Format
II32 Reg -> OrdList Instr
code -> do
      Reg
tmp <- Format -> NatM Reg
getNewRegNat Format
FF32
      (Reg, Format, OrdList Instr) -> NatM (Reg, Format, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg
tmp, Format
FF32, Reg -> OrdList Instr
code Reg
tmp)
    Any Format
II64 Reg -> OrdList Instr
code -> do
      Reg
tmp <- Format -> NatM Reg
getNewRegNat Format
FF64
      (Reg, Format, OrdList Instr) -> NatM (Reg, Format, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg
tmp, Format
FF64, Reg -> OrdList Instr
code Reg
tmp)
    Any Format
_w Reg -> OrdList Instr
_code -> do
      NCGConfig
config <- NatM NCGConfig
getConfig
      String -> SDoc -> NatM (Reg, Format, OrdList Instr)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"can't do getFloatReg on" (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc (NCGConfig -> Platform
ncgPlatform NCGConfig
config) CmmExpr
expr)
    
    Fixed Format
rep Reg
reg OrdList Instr
code ->
      (Reg, Format, OrdList Instr) -> NatM (Reg, Format, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg
reg, Format
rep, OrdList Instr
code)
litToImm' :: CmmLit -> NatM (Operand, InstrBlock)
litToImm' :: CmmLit -> NatM (Operand, OrdList Instr)
litToImm' CmmLit
lit = (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)
getRegister :: CmmExpr -> NatM Register
getRegister :: CmmExpr -> NatM Register
getRegister CmmExpr
e = do
  NCGConfig
config <- NatM NCGConfig
getConfig
  NCGConfig -> Platform -> CmmExpr -> NatM Register
getRegister' NCGConfig
config (NCGConfig -> Platform
ncgPlatform NCGConfig
config) CmmExpr
e
opRegWidth :: Width -> Width
opRegWidth :: Width -> Width
opRegWidth Width
W64 = Width
W64  
opRegWidth Width
W32 = Width
W32  
opRegWidth Width
W16 = Width
W32  
opRegWidth Width
W8  = Width
W32  
opRegWidth Width
w   = String -> SDoc -> Width
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"opRegWidth" (String -> SDoc
text String
"Unsupported width" SDoc -> SDoc -> SDoc
<+> Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
w)
getRegister' :: NCGConfig -> Platform -> CmmExpr -> NatM Register
getRegister' :: NCGConfig -> Platform -> CmmExpr -> NatM Register
getRegister' NCGConfig
config Platform
plat (CmmMachOp (MO_Add Width
w0) [CmmExpr
x, CmmLit (CmmInt Integer
i Width
w1)]) | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
  = NCGConfig -> Platform -> CmmExpr -> NatM Register
getRegister' NCGConfig
config Platform
plat (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Sub Width
w0) [CmmExpr
x, CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (-Integer
i) Width
w1)])
getRegister' NCGConfig
config Platform
plat (CmmMachOp (MO_Sub Width
w0) [CmmExpr
x, CmmLit (CmmInt Integer
i Width
w1)]) | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
  = NCGConfig -> Platform -> CmmExpr -> NatM Register
getRegister' NCGConfig
config Platform
plat (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Add Width
w0) [CmmExpr
x, CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (-Integer
i) Width
w1)])
getRegister' NCGConfig
config Platform
plat CmmExpr
expr
  = case CmmExpr
expr of
    CmmReg (CmmGlobal GlobalReg
PicBaseReg)
      -> String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getRegisterReg-memory" (GlobalReg -> SDoc
forall a. Outputable a => a -> SDoc
ppr (GlobalReg -> SDoc) -> GlobalReg -> SDoc
forall a b. (a -> b) -> a -> b
$ GlobalReg
PicBaseReg)
    CmmLit CmmLit
lit
      -> case CmmLit
lit of
        
        CmmInt Integer
i Width
W8 | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 -> do
          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
W8) (\Reg
dst -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Operand -> Operand -> Instr
MOV (Width -> Reg -> Operand
OpReg Width
W8 Reg
dst) (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger (Width -> Integer -> Integer
narrowU Width
W8 Integer
i))))))
        CmmInt Integer
i Width
W16 | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 -> do
          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
W16) (\Reg
dst -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Operand -> Operand -> Instr
MOV (Width -> Reg -> Operand
OpReg Width
W16 Reg
dst) (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger (Width -> Integer -> Integer
narrowU Width
W16 Integer
i))))))
        CmmInt Integer
i Width
W8  -> do
          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
W8) (\Reg
dst -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Operand -> Operand -> Instr
MOV (Width -> Reg -> Operand
OpReg Width
W8 Reg
dst) (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger (Width -> Integer -> Integer
narrowU Width
W8 Integer
i))))))
        CmmInt Integer
i Width
W16 -> do
          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
W16) (\Reg
dst -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Operand -> Operand -> Instr
MOV (Width -> Reg -> Operand
OpReg Width
W16 Reg
dst) (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger (Width -> Integer -> Integer
narrowU Width
W16 Integer
i))))))
        
        
        
        
        CmmInt Integer
i Width
w | Int -> Integer -> Bool
isNbitEncodeable Int
16 Integer
i, Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 -> do
          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
w) (\Reg
dst -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Operand -> Operand -> Instr
MOV (Width -> Reg -> Operand
OpReg Width
W16 Reg
dst) (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
i)))))
        CmmInt Integer
i Width
w | Int -> Integer -> Bool
isNbitEncodeable Int
32 Integer
i, Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 -> do
          let  half0 :: Int
half0 = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Word16)
               half1 :: Int
half1 = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
16) :: Word16)
          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
w) (\Reg
dst -> [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr
                                                  (Instr -> Instr) -> Instr -> Instr
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> Instr
MOV (Width -> Reg -> Operand
OpReg Width
W32 Reg
dst) (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
half0))
                                                  , Operand -> Operand -> Instr
MOVK (Width -> Reg -> Operand
OpReg Width
W32 Reg
dst) (Imm -> ShiftMode -> Int -> Operand
OpImmShift (Int -> Imm
ImmInt Int
half1) ShiftMode
SLSL Int
16)
                                                  ]))
        
        CmmInt Integer
i Width
W32 -> do
          let  half0 :: Int
half0 = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Word16)
               half1 :: Int
half1 = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
16) :: Word16)
          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
W32) (\Reg
dst -> [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr
                                                    (Instr -> Instr) -> Instr -> Instr
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> Instr
MOV (Width -> Reg -> Operand
OpReg Width
W32 Reg
dst) (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
half0))
                                                    , Operand -> Operand -> Instr
MOVK (Width -> Reg -> Operand
OpReg Width
W32 Reg
dst) (Imm -> ShiftMode -> Int -> Operand
OpImmShift (Int -> Imm
ImmInt Int
half1) ShiftMode
SLSL Int
16)
                                                    ]))
        
        CmmInt Integer
i Width
W64 -> do
          let  half0 :: Int
half0 = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Word16)
               half1 :: Int
half1 = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
16) :: Word16)
               half2 :: Int
half2 = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
32) :: Word16)
               half3 :: Int
half3 = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
48) :: Word16)
          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
W64) (\Reg
dst -> [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr
                                                    (Instr -> Instr) -> Instr -> Instr
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> Instr
MOV (Width -> Reg -> Operand
OpReg Width
W64 Reg
dst) (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
half0))
                                                    , Operand -> Operand -> Instr
MOVK (Width -> Reg -> Operand
OpReg Width
W64 Reg
dst) (Imm -> ShiftMode -> Int -> Operand
OpImmShift (Int -> Imm
ImmInt Int
half1) ShiftMode
SLSL Int
16)
                                                    , Operand -> Operand -> Instr
MOVK (Width -> Reg -> Operand
OpReg Width
W64 Reg
dst) (Imm -> ShiftMode -> Int -> Operand
OpImmShift (Int -> Imm
ImmInt Int
half2) ShiftMode
SLSL Int
32)
                                                    , Operand -> Operand -> Instr
MOVK (Width -> Reg -> Operand
OpReg Width
W64 Reg
dst) (Imm -> ShiftMode -> Int -> Operand
OpImmShift (Int -> Imm
ImmInt Int
half3) ShiftMode
SLSL Int
48)
                                                    ]))
        CmmInt Integer
_i Width
rep -> do
          (Operand
op, OrdList Instr
imm_code) <- CmmLit -> NatM (Operand, OrdList Instr)
litToImm' CmmLit
lit
          Register -> NatM Register
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any (Width -> Format
intFormat Width
rep) (\Reg
dst -> OrdList Instr
imm_code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Operand -> Operand -> Instr
MOV (Width -> Reg -> Operand
OpReg Width
rep Reg
dst) Operand
op)))
        
        CmmFloat Rational
0 Width
w   -> do
          (Operand
op, OrdList Instr
imm_code) <- CmmLit -> NatM (Operand, OrdList Instr)
litToImm' CmmLit
lit
          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
w) (\Reg
dst -> OrdList Instr
imm_code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Operand -> Operand -> Instr
MOV (Width -> Reg -> Operand
OpReg Width
w Reg
dst) Operand
op)))
        CmmFloat Rational
_f Width
W8  -> String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getRegister' (CmmLit:CmmFloat), no support for bytes" (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
plat CmmExpr
expr)
        CmmFloat Rational
_f Width
W16 -> String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getRegister' (CmmLit:CmmFloat), no support for halfs" (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
plat CmmExpr
expr)
        CmmFloat Rational
f Width
W32 -> do
          let word :: Word32
word = Float -> Word32
castFloatToWord32 (Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
f) :: Word32
              half0 :: Int
half0 = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
word :: Word16)
              half1 :: Int
half1 = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
word Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
16) :: Word16)
          Reg
tmp <- Format -> NatM Reg
getNewRegNat (Width -> Format
intFormat Width
W32)
          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
W32) (\Reg
dst -> [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr
                                                      (Instr -> Instr) -> Instr -> Instr
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> Instr
MOV (Width -> Reg -> Operand
OpReg Width
W32 Reg
tmp) (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
half0))
                                                      , Operand -> Operand -> Instr
MOVK (Width -> Reg -> Operand
OpReg Width
W32 Reg
tmp) (Imm -> ShiftMode -> Int -> Operand
OpImmShift (Int -> Imm
ImmInt Int
half1) ShiftMode
SLSL Int
16)
                                                      , Operand -> Operand -> Instr
MOV (Width -> Reg -> Operand
OpReg Width
W32 Reg
dst) (Width -> Reg -> Operand
OpReg Width
W32 Reg
tmp)
                                                      ]))
        CmmFloat Rational
f Width
W64 -> do
          let word :: Word64
word = Double -> Word64
castDoubleToWord64 (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
f) :: Word64
              half0 :: Int
half0 = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
word :: Word16)
              half1 :: Int
half1 = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
word Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
16) :: Word16)
              half2 :: Int
half2 = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
word Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
32) :: Word16)
              half3 :: Int
half3 = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
word Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
48) :: Word16)
          Reg
tmp <- Format -> NatM Reg
getNewRegNat (Width -> Format
intFormat Width
W64)
          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
W64) (\Reg
dst -> [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr
                                                      (Instr -> Instr) -> Instr -> Instr
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> Instr
MOV (Width -> Reg -> Operand
OpReg Width
W64 Reg
tmp) (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
half0))
                                                      , Operand -> Operand -> Instr
MOVK (Width -> Reg -> Operand
OpReg Width
W64 Reg
tmp) (Imm -> ShiftMode -> Int -> Operand
OpImmShift (Int -> Imm
ImmInt Int
half1) ShiftMode
SLSL Int
16)
                                                      , Operand -> Operand -> Instr
MOVK (Width -> Reg -> Operand
OpReg Width
W64 Reg
tmp) (Imm -> ShiftMode -> Int -> Operand
OpImmShift (Int -> Imm
ImmInt Int
half2) ShiftMode
SLSL Int
32)
                                                      , Operand -> Operand -> Instr
MOVK (Width -> Reg -> Operand
OpReg Width
W64 Reg
tmp) (Imm -> ShiftMode -> Int -> Operand
OpImmShift (Int -> Imm
ImmInt Int
half3) ShiftMode
SLSL Int
48)
                                                      , Operand -> Operand -> Instr
MOV (Width -> Reg -> Operand
OpReg Width
W64 Reg
dst) (Width -> Reg -> Operand
OpReg Width
W64 Reg
tmp)
                                                      ]))
        CmmFloat Rational
_f Width
_w -> String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getRegister' (CmmLit:CmmFloat), unsupported float lit" (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
plat CmmExpr
expr)
        CmmVec [CmmLit]
_ -> String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getRegister' (CmmLit:CmmVec): " (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
plat CmmExpr
expr)
        CmmLabel CLabel
_lbl -> do
          (Operand
op, OrdList Instr
imm_code) <- CmmLit -> NatM (Operand, OrdList Instr)
litToImm' CmmLit
lit
          let rep :: CmmType
rep = Platform -> CmmLit -> CmmType
cmmLitType Platform
plat CmmLit
lit
              format :: Format
format = CmmType -> Format
cmmTypeFormat CmmType
rep
          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
dst -> OrdList Instr
imm_code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` (CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Instr -> Instr) -> Instr -> Instr
forall a b. (a -> b) -> a -> b
$ Format -> Operand -> Operand -> Instr
LDR Format
format (Width -> Reg -> Operand
OpReg (Format -> Width
formatToWidth Format
format) Reg
dst) Operand
op)))
        CmmLabelOff CLabel
_lbl Int
off | Int -> Integer -> Bool
isNbitEncodeable Int
12 (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off) -> do
          (Operand
op, OrdList Instr
imm_code) <- CmmLit -> NatM (Operand, OrdList Instr)
litToImm' CmmLit
lit
          let rep :: CmmType
rep = Platform -> CmmLit -> CmmType
cmmLitType Platform
plat CmmLit
lit
              format :: Format
format = CmmType -> Format
cmmTypeFormat CmmType
rep
              
          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
dst -> OrdList Instr
imm_code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Operand -> Operand -> Instr
LDR Format
format (Width -> Reg -> Operand
OpReg (Format -> Width
formatToWidth Format
format) Reg
dst) Operand
op))
        CmmLabelOff CLabel
lbl Int
off -> do
          (Operand
op, OrdList Instr
imm_code) <- CmmLit -> NatM (Operand, OrdList Instr)
litToImm' (CLabel -> CmmLit
CmmLabel CLabel
lbl)
          let rep :: CmmType
rep = Platform -> CmmLit -> CmmType
cmmLitType Platform
plat CmmLit
lit
              format :: Format
format = CmmType -> Format
cmmTypeFormat CmmType
rep
              width :: Width
width = CmmType -> Width
typeWidth CmmType
rep
          (Reg
off_r, Format
_off_format, OrdList Instr
off_code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg (CmmExpr -> NatM (Reg, Format, OrdList Instr))
-> CmmExpr -> NatM (Reg, Format, OrdList Instr)
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off) Width
width)
          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
dst -> OrdList Instr
imm_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
off_code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Operand -> Operand -> Instr
LDR Format
format (Width -> Reg -> Operand
OpReg (Format -> Width
formatToWidth Format
format) Reg
dst) Operand
op OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Operand -> Operand -> Operand -> Instr
ADD (Width -> Reg -> Operand
OpReg Width
width Reg
dst) (Width -> Reg -> Operand
OpReg Width
width Reg
dst) (Width -> Reg -> Operand
OpReg Width
width Reg
off_r)))
        CmmLabelDiffOff CLabel
_ CLabel
_ Int
_ Width
_ -> String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getRegister' (CmmLit:CmmLabelOff): " (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
plat CmmExpr
expr)
        CmmBlock Label
_ -> String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getRegister' (CmmLit:CmmLabelOff): " (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
plat CmmExpr
expr)
        CmmLit
CmmHighStackMark -> String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getRegister' (CmmLit:CmmLabelOff): " (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
plat CmmExpr
expr)
    CmmLoad CmmExpr
mem CmmType
rep AlignmentSpec
_ -> do
      Amode AddrMode
addr OrdList Instr
addr_code <- Platform -> Width -> CmmExpr -> NatM Amode
getAmode Platform
plat (CmmType -> Width
typeWidth CmmType
rep) CmmExpr
mem
      let format :: Format
format = CmmType -> Format
cmmTypeFormat CmmType
rep
      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
dst -> OrdList Instr
addr_code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Operand -> Operand -> Instr
LDR Format
format (Width -> Reg -> Operand
OpReg (Format -> Width
formatToWidth Format
format) Reg
dst) (AddrMode -> Operand
OpAddr AddrMode
addr)))
    CmmStackSlot Area
_ Int
_
      -> String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getRegister' (CmmStackSlot): " (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
plat CmmExpr
expr)
    CmmReg CmmReg
reg
      -> Register -> NatM Register
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> Reg -> OrdList Instr -> Register
Fixed (CmmType -> Format
cmmTypeFormat (Platform -> CmmReg -> CmmType
cmmRegType Platform
plat CmmReg
reg))
                       (Platform -> CmmReg -> Reg
getRegisterReg Platform
plat CmmReg
reg)
                       OrdList Instr
forall a. OrdList a
nilOL)
    CmmRegOff CmmReg
reg Int
off | Int -> Integer -> Bool
isNbitEncodeable Int
12 (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off) -> do
      NCGConfig -> Platform -> CmmExpr -> NatM Register
getRegister' NCGConfig
config Platform
plat (CmmExpr -> NatM Register) -> CmmExpr -> NatM Register
forall a b. (a -> b) -> a -> b
$
            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
plat CmmReg
reg)
    CmmRegOff CmmReg
reg Int
off -> do
      (Reg
off_r, Format
_off_format, OrdList Instr
off_code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg (CmmExpr -> NatM (Reg, Format, OrdList Instr))
-> CmmExpr -> NatM (Reg, Format, OrdList Instr)
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off) Width
width)
      (Reg
reg, Format
_format, OrdList Instr
code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg (CmmExpr -> NatM (Reg, Format, OrdList Instr))
-> CmmExpr -> NatM (Reg, Format, OrdList Instr)
forall a b. (a -> b) -> a -> b
$ CmmReg -> CmmExpr
CmmReg CmmReg
reg
      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 (Width -> Format
intFormat Width
width) (\Reg
dst -> OrdList Instr
off_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Operand -> Operand -> Operand -> Instr
ADD (Width -> Reg -> Operand
OpReg Width
width Reg
dst) (Width -> Reg -> Operand
OpReg Width
width Reg
reg) (Width -> Reg -> Operand
OpReg Width
width Reg
off_r))
          where width :: Width
width = CmmType -> Width
typeWidth (Platform -> CmmReg -> CmmType
cmmRegType Platform
plat CmmReg
reg)
    
    
    CmmMachOp MachOp
op [CmmExpr
e] -> do
      (Reg
reg, Format
_format, OrdList Instr
code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg CmmExpr
e
      case MachOp
op of
        MO_Not Width
w -> 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 (Width -> Format
intFormat Width
w) ((Reg -> OrdList Instr) -> Register)
-> (Reg -> OrdList Instr) -> Register
forall a b. (a -> b) -> a -> b
$ \Reg
dst ->
            let w' :: Width
w' = Width -> Width
opRegWidth Width
w
             in OrdList Instr
code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
                Operand -> Operand -> Instr
MVN (Width -> Reg -> Operand
OpReg Width
w' Reg
dst) (Width -> Reg -> Operand
OpReg Width
w' Reg
reg) OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                Width -> Width -> Reg -> OrdList Instr
truncateReg Width
w' Width
w Reg
dst 
        MO_S_Neg Width
w -> OrdList Instr -> Width -> Reg -> NatM Register
negate OrdList Instr
code Width
w Reg
reg
        MO_F_Neg Width
w -> 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 (Width -> Format
floatFormat Width
w) (\Reg
dst -> OrdList Instr
code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Operand -> Operand -> Instr
NEG (Width -> Reg -> Operand
OpReg Width
w Reg
dst) (Width -> Reg -> Operand
OpReg Width
w Reg
reg))
        MO_SF_Conv Width
from Width
to -> 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 (Width -> Format
floatFormat Width
to) (\Reg
dst -> OrdList Instr
code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Operand -> Operand -> Instr
SCVTF (Width -> Reg -> Operand
OpReg Width
to Reg
dst) (Width -> Reg -> Operand
OpReg Width
from Reg
reg))  
        MO_FS_Conv Width
from Width
to -> 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 (Width -> Format
intFormat Width
to) (\Reg
dst -> OrdList Instr
code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Operand -> Operand -> Instr
FCVTZS (Width -> Reg -> Operand
OpReg Width
to Reg
dst) (Width -> Reg -> Operand
OpReg Width
from Reg
reg)) 
        
        
        
        MO_UU_Conv Width
from Width
to -> 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 (Width -> Format
intFormat Width
to) (\Reg
dst -> OrdList Instr
code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Operand -> Operand -> Operand -> Operand -> Instr
UBFM (Width -> Reg -> Operand
OpReg (Width -> Width -> Width
forall a. Ord a => a -> a -> a
max Width
from Width
to) Reg
dst) (Width -> Reg -> Operand
OpReg (Width -> Width -> Width
forall a. Ord a => a -> a -> a
max Width
from Width
to) Reg
reg) (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
0)) (Width -> Operand
toImm (Width -> Width -> Width
forall a. Ord a => a -> a -> a
min Width
from Width
to)))
        MO_SS_Conv Width
from Width
to -> Width -> Width -> Reg -> OrdList Instr -> NatM Register
forall {m :: * -> *}.
Monad m =>
Width -> Width -> Reg -> OrdList Instr -> m Register
ss_conv Width
from Width
to Reg
reg OrdList Instr
code
        MO_FF_Conv Width
from Width
to -> 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 (Width -> Format
floatFormat Width
to) (\Reg
dst -> OrdList Instr
code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Operand -> Operand -> Instr
FCVT (Width -> Reg -> Operand
OpReg Width
to Reg
dst) (Width -> Reg -> Operand
OpReg Width
from Reg
reg))
        
        MO_XX_Conv Width
_from Width
to -> Format -> Register -> Register
swizzleRegisterRep (Width -> Format
intFormat Width
to) (Register -> Register) -> NatM Register -> NatM Register
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CmmExpr -> NatM Register
getRegister CmmExpr
e
        MachOp
_ -> String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getRegister' (monadic CmmMachOp):" (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
plat CmmExpr
expr)
      where
        toImm :: Width -> Operand
toImm Width
W8 =  (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
7))
        toImm Width
W16 = (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
15))
        toImm Width
W32 = (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
31))
        toImm Width
W64 = (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
63))
        toImm Width
W128 = (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
127))
        toImm Width
W256 = (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
255))
        toImm Width
W512 = (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
511))
        
        
        negate :: OrdList Instr -> Width -> Reg -> NatM Register
negate OrdList Instr
code Width
w Reg
reg = do
            let w' :: Width
w' = Width -> Width
opRegWidth Width
w
            (Reg
reg', OrdList Instr
code_sx) <- Width -> Width -> Reg -> NatM (Reg, OrdList Instr)
signExtendReg Width
w Width
w' Reg
reg
            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 (Width -> Format
intFormat Width
w) ((Reg -> OrdList Instr) -> Register)
-> (Reg -> OrdList Instr) -> Register
forall a b. (a -> b) -> a -> b
$ \Reg
dst ->
                OrdList Instr
code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                OrdList Instr
code_sx OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
                Operand -> Operand -> Instr
NEG (Width -> Reg -> Operand
OpReg Width
w' Reg
dst) (Width -> Reg -> Operand
OpReg Width
w' Reg
reg') OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                Width -> Width -> Reg -> OrdList Instr
truncateReg Width
w' Width
w Reg
dst
        ss_conv :: Width -> Width -> Reg -> OrdList Instr -> m Register
ss_conv Width
from Width
to Reg
reg OrdList Instr
code =
            let w' :: Width
w' = Width -> Width
opRegWidth (Width -> Width -> Width
forall a. Ord a => a -> a -> a
max Width
from Width
to)
            in Register -> m Register
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Register -> m Register) -> Register -> m Register
forall a b. (a -> b) -> a -> b
$ Format -> (Reg -> OrdList Instr) -> Register
Any (Width -> Format
intFormat Width
to) ((Reg -> OrdList Instr) -> Register)
-> (Reg -> OrdList Instr) -> Register
forall a b. (a -> b) -> a -> b
$ \Reg
dst ->
                OrdList Instr
code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
                Operand -> Operand -> Operand -> Operand -> Instr
SBFM (Width -> Reg -> Operand
OpReg Width
w' Reg
dst) (Width -> Reg -> Operand
OpReg Width
w' Reg
reg) (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
0)) (Width -> Operand
toImm (Width -> Width -> Width
forall a. Ord a => a -> a -> a
min Width
from Width
to)) OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                
                
                Width -> Width -> Reg -> OrdList Instr
truncateReg Width
w' Width
to Reg
dst
    
    
    
    
    
    
    
    
    
    
    
    CmmMachOp (MO_Add Width
_) [expr' :: CmmExpr
expr'@(CmmReg (CmmGlobal GlobalReg
_r)), CmmLit (CmmInt Integer
0 Width
_)] -> NCGConfig -> Platform -> CmmExpr -> NatM Register
getRegister' NCGConfig
config Platform
plat CmmExpr
expr'
    CmmMachOp (MO_Sub Width
_) [expr' :: CmmExpr
expr'@(CmmReg (CmmGlobal GlobalReg
_r)), CmmLit (CmmInt Integer
0 Width
_)] -> NCGConfig -> Platform -> CmmExpr -> NatM Register
getRegister' NCGConfig
config Platform
plat CmmExpr
expr'
    
    
    CmmMachOp (MO_Add Width
w) [(CmmReg CmmReg
reg), CmmLit (CmmInt Integer
n Width
_)]
      | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 Bool -> Bool -> Bool
&& Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
4096
      , Width
w Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W32 Bool -> Bool -> Bool
|| Width
w Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W64 
      -> 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 (Width -> Format
intFormat Width
w) (\Reg
d -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Operand -> Operand -> Operand -> Instr
ADD (Width -> Reg -> Operand
OpReg Width
w Reg
d) (Width -> Reg -> Operand
OpReg Width
w' Reg
r') (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
n))))
      
      where w' :: Width
w' = Format -> Width
formatToWidth (CmmType -> Format
cmmTypeFormat (Platform -> CmmReg -> CmmType
cmmRegType Platform
plat CmmReg
reg))
            r' :: Reg
r' = Platform -> CmmReg -> Reg
getRegisterReg Platform
plat CmmReg
reg
    CmmMachOp (MO_Sub Width
w) [(CmmReg CmmReg
reg), CmmLit (CmmInt Integer
n Width
_)]
      | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 Bool -> Bool -> Bool
&& Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
4096
      , Width
w Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W32 Bool -> Bool -> Bool
|| Width
w Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W64 
      -> 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 (Width -> Format
intFormat Width
w) (\Reg
d -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Operand -> Operand -> Operand -> Instr
SUB (Width -> Reg -> Operand
OpReg Width
w Reg
d) (Width -> Reg -> Operand
OpReg Width
w' Reg
r') (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
n))))
      
      where w' :: Width
w' = Format -> Width
formatToWidth (CmmType -> Format
cmmTypeFormat (Platform -> CmmReg -> CmmType
cmmRegType Platform
plat CmmReg
reg))
            r' :: Reg
r' = Platform -> CmmReg -> Reg
getRegisterReg Platform
plat CmmReg
reg
    CmmMachOp (MO_U_Quot Width
w) [CmmExpr
x, CmmExpr
y] | Width
w Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W8 -> do
      (Reg
reg_x, Format
_format_x, OrdList Instr
code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg CmmExpr
x
      (Reg
reg_y, Format
_format_y, OrdList Instr
code_y) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg CmmExpr
y
      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 (Width -> Format
intFormat Width
w) (\Reg
dst -> OrdList Instr
code_x OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code_y OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Operand -> Operand -> Instr
UXTB (Width -> Reg -> Operand
OpReg Width
w Reg
reg_x) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_x)) OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` (Operand -> Operand -> Instr
UXTB (Width -> Reg -> Operand
OpReg Width
w Reg
reg_y) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_y)) OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` (Operand -> Operand -> Operand -> Instr
UDIV (Width -> Reg -> Operand
OpReg Width
w Reg
dst) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_x) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_y)))
    CmmMachOp (MO_U_Quot Width
w) [CmmExpr
x, CmmExpr
y] | Width
w Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W16 -> do
      (Reg
reg_x, Format
_format_x, OrdList Instr
code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg CmmExpr
x
      (Reg
reg_y, Format
_format_y, OrdList Instr
code_y) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg CmmExpr
y
      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 (Width -> Format
intFormat Width
w) (\Reg
dst -> OrdList Instr
code_x OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code_y OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Operand -> Operand -> Instr
UXTH (Width -> Reg -> Operand
OpReg Width
w Reg
reg_x) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_x)) OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` (Operand -> Operand -> Instr
UXTH (Width -> Reg -> Operand
OpReg Width
w Reg
reg_y) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_y)) OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` (Operand -> Operand -> Operand -> Instr
UDIV (Width -> Reg -> Operand
OpReg Width
w Reg
dst) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_x) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_y)))
    
    CmmMachOp (MO_Shl Width
w) [CmmExpr
x, (CmmLit (CmmInt Integer
n Width
_))] | Width
w Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W32, Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
n, Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
32 -> do
      (Reg
reg_x, Format
_format_x, OrdList Instr
code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg 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
Any (Width -> Format
intFormat Width
w) (\Reg
dst -> OrdList Instr
code_x OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Operand -> Operand -> Operand -> Instr
LSL (Width -> Reg -> Operand
OpReg Width
w Reg
dst) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_x) (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
n))))
    CmmMachOp (MO_Shl Width
w) [CmmExpr
x, (CmmLit (CmmInt Integer
n Width
_))] | Width
w Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W64, Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
n, Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
64 -> do
      (Reg
reg_x, Format
_format_x, OrdList Instr
code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg 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
Any (Width -> Format
intFormat Width
w) (\Reg
dst -> OrdList Instr
code_x OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Operand -> Operand -> Operand -> Instr
LSL (Width -> Reg -> Operand
OpReg Width
w Reg
dst) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_x) (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
n))))
    CmmMachOp (MO_S_Shr Width
w) [CmmExpr
x, (CmmLit (CmmInt Integer
n Width
_))] | Width
w Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W8, Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
n, Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
8 -> do
      (Reg
reg_x, Format
_format_x, OrdList Instr
code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg 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
Any (Width -> Format
intFormat Width
w) (\Reg
dst -> OrdList Instr
code_x OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Operand -> Operand -> Operand -> Operand -> Instr
SBFX (Width -> Reg -> Operand
OpReg Width
w Reg
dst) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_x) (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
n)) (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger (Integer
8Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
n)))))
    CmmMachOp (MO_S_Shr Width
w) [CmmExpr
x, CmmExpr
y] | Width
w Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W8 -> do
      (Reg
reg_x, Format
_format_x, OrdList Instr
code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg CmmExpr
x
      (Reg
reg_y, Format
_format_y, OrdList Instr
code_y) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg CmmExpr
y
      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 (Width -> Format
intFormat Width
w) (\Reg
dst -> OrdList Instr
code_x OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code_y OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Operand -> Operand -> Instr
SXTB (Width -> Reg -> Operand
OpReg Width
w Reg
reg_x) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_x)) OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` (Operand -> Operand -> Operand -> Instr
ASR (Width -> Reg -> Operand
OpReg Width
w Reg
dst) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_x) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_y)))
    CmmMachOp (MO_S_Shr Width
w) [CmmExpr
x, (CmmLit (CmmInt Integer
n Width
_))] | Width
w Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W16, Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
n, Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
16 -> do
      (Reg
reg_x, Format
_format_x, OrdList Instr
code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg 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
Any (Width -> Format
intFormat Width
w) (\Reg
dst -> OrdList Instr
code_x OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Operand -> Operand -> Operand -> Operand -> Instr
SBFX (Width -> Reg -> Operand
OpReg Width
w Reg
dst) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_x) (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
n)) (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger (Integer
16Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
n)))))
    CmmMachOp (MO_S_Shr Width
w) [CmmExpr
x, CmmExpr
y] | Width
w Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W16 -> do
      (Reg
reg_x, Format
_format_x, OrdList Instr
code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg CmmExpr
x
      (Reg
reg_y, Format
_format_y, OrdList Instr
code_y) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg CmmExpr
y
      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 (Width -> Format
intFormat Width
w) (\Reg
dst -> OrdList Instr
code_x OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code_y OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Operand -> Operand -> Instr
SXTH (Width -> Reg -> Operand
OpReg Width
w Reg
reg_x) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_x)) OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` (Operand -> Operand -> Operand -> Instr
ASR (Width -> Reg -> Operand
OpReg Width
w Reg
dst) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_x) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_y)))
    CmmMachOp (MO_S_Shr Width
w) [CmmExpr
x, (CmmLit (CmmInt Integer
n Width
_))] | Width
w Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W32, Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
n, Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
32 -> do
      (Reg
reg_x, Format
_format_x, OrdList Instr
code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg 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
Any (Width -> Format
intFormat Width
w) (\Reg
dst -> OrdList Instr
code_x OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Operand -> Operand -> Operand -> Instr
ASR (Width -> Reg -> Operand
OpReg Width
w Reg
dst) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_x) (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
n))))
    CmmMachOp (MO_S_Shr Width
w) [CmmExpr
x, (CmmLit (CmmInt Integer
n Width
_))] | Width
w Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W64, Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
n, Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
64 -> do
      (Reg
reg_x, Format
_format_x, OrdList Instr
code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg 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
Any (Width -> Format
intFormat Width
w) (\Reg
dst -> OrdList Instr
code_x OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Operand -> Operand -> Operand -> Instr
ASR (Width -> Reg -> Operand
OpReg Width
w Reg
dst) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_x) (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
n))))
    CmmMachOp (MO_U_Shr Width
w) [CmmExpr
x, (CmmLit (CmmInt Integer
n Width
_))] | Width
w Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W8, Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
n, Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
8 -> do
      (Reg
reg_x, Format
_format_x, OrdList Instr
code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg 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
Any (Width -> Format
intFormat Width
w) (\Reg
dst -> OrdList Instr
code_x OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Operand -> Operand -> Operand -> Operand -> Instr
UBFX (Width -> Reg -> Operand
OpReg Width
w Reg
dst) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_x) (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
n)) (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger (Integer
8Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
n)))))
    CmmMachOp (MO_U_Shr Width
w) [CmmExpr
x, CmmExpr
y] | Width
w Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W8 -> do
      (Reg
reg_x, Format
_format_x, OrdList Instr
code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg CmmExpr
x
      (Reg
reg_y, Format
_format_y, OrdList Instr
code_y) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg CmmExpr
y
      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 (Width -> Format
intFormat Width
w) (\Reg
dst -> OrdList Instr
code_x OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code_y OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Operand -> Operand -> Instr
UXTB (Width -> Reg -> Operand
OpReg Width
w Reg
reg_x) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_x)) OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` (Operand -> Operand -> Operand -> Instr
ASR (Width -> Reg -> Operand
OpReg Width
w Reg
dst) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_x) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_y)))
    CmmMachOp (MO_U_Shr Width
w) [CmmExpr
x, (CmmLit (CmmInt Integer
n Width
_))] | Width
w Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W16, Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
n, Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
16 -> do
      (Reg
reg_x, Format
_format_x, OrdList Instr
code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg 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
Any (Width -> Format
intFormat Width
w) (\Reg
dst -> OrdList Instr
code_x OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Operand -> Operand -> Operand -> Operand -> Instr
UBFX (Width -> Reg -> Operand
OpReg Width
w Reg
dst) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_x) (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
n)) (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger (Integer
16Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
n)))))
    CmmMachOp (MO_U_Shr Width
w) [CmmExpr
x, CmmExpr
y] | Width
w Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W16 -> do
      (Reg
reg_x, Format
_format_x, OrdList Instr
code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg CmmExpr
x
      (Reg
reg_y, Format
_format_y, OrdList Instr
code_y) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg CmmExpr
y
      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 (Width -> Format
intFormat Width
w) (\Reg
dst -> OrdList Instr
code_x OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code_y OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Operand -> Operand -> Instr
UXTH (Width -> Reg -> Operand
OpReg Width
w Reg
reg_x) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_x)) OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` (Operand -> Operand -> Operand -> Instr
ASR (Width -> Reg -> Operand
OpReg Width
w Reg
dst) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_x) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_y)))
    CmmMachOp (MO_U_Shr Width
w) [CmmExpr
x, (CmmLit (CmmInt Integer
n Width
_))] | Width
w Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W32, Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
n, Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
32 -> do
      (Reg
reg_x, Format
_format_x, OrdList Instr
code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg 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
Any (Width -> Format
intFormat Width
w) (\Reg
dst -> OrdList Instr
code_x OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Operand -> Operand -> Operand -> Instr
LSR (Width -> Reg -> Operand
OpReg Width
w Reg
dst) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_x) (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
n))))
    CmmMachOp (MO_U_Shr Width
w) [CmmExpr
x, (CmmLit (CmmInt Integer
n Width
_))] | Width
w Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W64, Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
n, Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
64 -> do
      (Reg
reg_x, Format
_format_x, OrdList Instr
code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg 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
Any (Width -> Format
intFormat Width
w) (\Reg
dst -> OrdList Instr
code_x OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Operand -> Operand -> Operand -> Instr
LSR (Width -> Reg -> Operand
OpReg Width
w Reg
dst) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_x) (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
n))))
    
    CmmMachOp (MO_And Width
w) [(CmmReg CmmReg
reg), CmmLit (CmmInt Integer
n Width
_)] | Integer -> Bool
isAArch64Bitmask (Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n) ->
      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 (Width -> Format
intFormat Width
w) (\Reg
d -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Operand -> Operand -> Operand -> Instr
AND (Width -> Reg -> Operand
OpReg Width
w Reg
d) (Width -> Reg -> Operand
OpReg Width
w' Reg
r') (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
n))))
      where w' :: Width
w' = Format -> Width
formatToWidth (CmmType -> Format
cmmTypeFormat (Platform -> CmmReg -> CmmType
cmmRegType Platform
plat CmmReg
reg))
            r' :: Reg
r' = Platform -> CmmReg -> Reg
getRegisterReg Platform
plat CmmReg
reg
    CmmMachOp (MO_Or Width
w) [(CmmReg CmmReg
reg), CmmLit (CmmInt Integer
n Width
_)] | Integer -> Bool
isAArch64Bitmask (Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n) ->
      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 (Width -> Format
intFormat Width
w) (\Reg
d -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Operand -> Operand -> Operand -> Instr
ORR (Width -> Reg -> Operand
OpReg Width
w Reg
d) (Width -> Reg -> Operand
OpReg Width
w' Reg
r') (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
n))))
      where w' :: Width
w' = Format -> Width
formatToWidth (CmmType -> Format
cmmTypeFormat (Platform -> CmmReg -> CmmType
cmmRegType Platform
plat CmmReg
reg))
            r' :: Reg
r' = Platform -> CmmReg -> Reg
getRegisterReg Platform
plat CmmReg
reg
    
    CmmMachOp MachOp
op [CmmExpr
x, CmmExpr
y] -> do
      
      
      let withTempIntReg :: Width -> (Operand -> NatM b) -> NatM b
withTempIntReg Width
w Operand -> NatM b
op = Width -> Reg -> Operand
OpReg Width
w (Reg -> Operand) -> NatM Reg -> NatM Operand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Format -> NatM Reg
getNewRegNat (Width -> Format
intFormat Width
w) NatM Operand -> (Operand -> NatM b) -> NatM b
forall a b. NatM a -> (a -> NatM b) -> NatM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Operand -> NatM b
op
          
          
          bitOp :: Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
bitOp Width
w Operand -> Operand -> Operand -> OrdList Instr
op = do
            
            
            
            (Reg
reg_x, Format
format_x, OrdList Instr
code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg CmmExpr
x
            (Reg
reg_y, Format
format_y, OrdList Instr
code_y) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg CmmExpr
y
            Bool -> SDoc -> NatM ()
forall (m :: * -> *).
(HasCallStack, Applicative m) =>
Bool -> SDoc -> m ()
massertPpr (Format -> Bool
isIntFormat Format
format_x Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Format -> Bool
isIntFormat Format
format_y) (SDoc -> NatM ()) -> SDoc -> NatM ()
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"bitOp: incompatible"
            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 (Width -> Format
intFormat Width
w) (\Reg
dst ->
                OrdList Instr
code_x OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                OrdList Instr
code_y OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                Operand -> Operand -> Operand -> OrdList Instr
op (Width -> Reg -> Operand
OpReg Width
w Reg
dst) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_x) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_y))
          
          
          
          
          intOp :: Bool
-> Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
intOp Bool
is_signed Width
w Operand -> Operand -> Operand -> OrdList Instr
op = do
              
              
              
              (Reg
reg_x, Format
format_x, OrdList Instr
code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg CmmExpr
x
              (Reg
reg_y, Format
format_y, OrdList Instr
code_y) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg CmmExpr
y
              Bool -> SDoc -> NatM ()
forall (m :: * -> *).
(HasCallStack, Applicative m) =>
Bool -> SDoc -> m ()
massertPpr (Format -> Bool
isIntFormat Format
format_x Bool -> Bool -> Bool
&& Format -> Bool
isIntFormat Format
format_y) (SDoc -> NatM ()) -> SDoc -> NatM ()
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"intOp: non-int"
              
              
              let w' :: Width
w' = Width -> Width
opRegWidth Width
w
                  signExt :: Reg -> NatM (Reg, OrdList Instr)
signExt Reg
r
                    | Bool -> Bool
not Bool
is_signed  = (Reg, OrdList Instr) -> NatM (Reg, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg
r, OrdList Instr
forall a. OrdList a
nilOL)
                    | Bool
otherwise      = Width -> Width -> Reg -> NatM (Reg, OrdList Instr)
signExtendReg Width
w Width
w' Reg
r
              (Reg
reg_x_sx, OrdList Instr
code_x_sx) <- Reg -> NatM (Reg, OrdList Instr)
signExt Reg
reg_x
              (Reg
reg_y_sx, OrdList Instr
code_y_sx) <- Reg -> NatM (Reg, OrdList Instr)
signExt Reg
reg_y
              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 (Width -> Format
intFormat Width
w) ((Reg -> OrdList Instr) -> Register)
-> (Reg -> OrdList Instr) -> Register
forall a b. (a -> b) -> a -> b
$ \Reg
dst ->
                  OrdList Instr
code_x OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                  OrdList Instr
code_y OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                  
                  OrdList Instr
code_x_sx OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                  OrdList Instr
code_y_sx OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                  Operand -> Operand -> Operand -> OrdList Instr
op (Width -> Reg -> Operand
OpReg Width
w' Reg
dst) (Width -> Reg -> Operand
OpReg Width
w' Reg
reg_x_sx) (Width -> Reg -> Operand
OpReg Width
w' Reg
reg_y_sx) OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                  Width -> Width -> Reg -> OrdList Instr
truncateReg Width
w' Width
w Reg
dst 
          floatOp :: Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
floatOp Width
w Operand -> Operand -> Operand -> OrdList Instr
op = do
            (Reg
reg_fx, Format
format_x, OrdList Instr
code_fx) <- HasCallStack => CmmExpr -> NatM (Reg, Format, OrdList Instr)
CmmExpr -> NatM (Reg, Format, OrdList Instr)
getFloatReg CmmExpr
x
            (Reg
reg_fy, Format
format_y, OrdList Instr
code_fy) <- HasCallStack => CmmExpr -> NatM (Reg, Format, OrdList Instr)
CmmExpr -> NatM (Reg, Format, OrdList Instr)
getFloatReg CmmExpr
y
            Bool -> SDoc -> NatM ()
forall (m :: * -> *).
(HasCallStack, Applicative m) =>
Bool -> SDoc -> m ()
massertPpr (Format -> Bool
isFloatFormat Format
format_x Bool -> Bool -> Bool
&& Format -> Bool
isFloatFormat Format
format_y) (SDoc -> NatM ()) -> SDoc -> NatM ()
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"floatOp: non-float"
            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 (Width -> Format
floatFormat Width
w) (\Reg
dst -> OrdList Instr
code_fx OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code_fy OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Operand -> Operand -> Operand -> OrdList Instr
op (Width -> Reg -> Operand
OpReg Width
w Reg
dst) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_fx) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_fy))
          
          floatCond :: Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
floatCond Width
w Operand -> Operand -> Operand -> OrdList Instr
op = do
            (Reg
reg_fx, Format
format_x, OrdList Instr
code_fx) <- HasCallStack => CmmExpr -> NatM (Reg, Format, OrdList Instr)
CmmExpr -> NatM (Reg, Format, OrdList Instr)
getFloatReg CmmExpr
x
            (Reg
reg_fy, Format
format_y, OrdList Instr
code_fy) <- HasCallStack => CmmExpr -> NatM (Reg, Format, OrdList Instr)
CmmExpr -> NatM (Reg, Format, OrdList Instr)
getFloatReg CmmExpr
y
            Bool -> SDoc -> NatM ()
forall (m :: * -> *).
(HasCallStack, Applicative m) =>
Bool -> SDoc -> m ()
massertPpr (Format -> Bool
isFloatFormat Format
format_x Bool -> Bool -> Bool
&& Format -> Bool
isFloatFormat Format
format_y) (SDoc -> NatM ()) -> SDoc -> NatM ()
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"floatCond: non-float"
            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 (Width -> Format
intFormat Width
w) (\Reg
dst -> OrdList Instr
code_fx OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code_fy OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Operand -> Operand -> Operand -> OrdList Instr
op (Width -> Reg -> Operand
OpReg Width
w Reg
dst) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_fx) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_fy))
      case MachOp
op of
        
        
        MO_Add Width
w -> Bool
-> Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
intOp Bool
False Width
w (\Operand
d Operand
x Operand
y -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Operand -> Operand -> Operand -> Instr
ADD Operand
d Operand
x Operand
y))
        
        MO_Sub Width
w -> Bool
-> Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
intOp Bool
False Width
w (\Operand
d Operand
x Operand
y -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Operand -> Operand -> Operand -> Instr
SUB Operand
d Operand
x Operand
y))
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        MO_Eq Width
w     -> Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
bitOp Width
w (\Operand
d Operand
x Operand
y -> [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Operand -> Operand -> Instr
CMP Operand
x Operand
y, Operand -> Cond -> Instr
CSET Operand
d Cond
EQ ])
        MO_Ne Width
w     -> Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
bitOp Width
w (\Operand
d Operand
x Operand
y -> [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Operand -> Operand -> Instr
CMP Operand
x Operand
y, Operand -> Cond -> Instr
CSET Operand
d Cond
NE ])
        
        MO_Mul Width
w          -> Bool
-> Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
intOp Bool
True Width
w (\Operand
d Operand
x Operand
y -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> Operand -> Instr
MUL Operand
d Operand
x Operand
y)
        MO_S_MulMayOflo Width
w -> Width -> CmmExpr -> CmmExpr -> NatM Register
do_mul_may_oflo Width
w CmmExpr
x CmmExpr
y
        MO_S_Quot Width
w       -> Bool
-> Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
intOp Bool
True Width
w (\Operand
d Operand
x Operand
y -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> Operand -> Instr
SDIV Operand
d Operand
x Operand
y)
        
        
        
        
        
        
        
        MO_S_Rem Width
w -> Width -> (Operand -> NatM Register) -> NatM Register
forall {b}. Width -> (Operand -> NatM b) -> NatM b
withTempIntReg Width
w ((Operand -> NatM Register) -> NatM Register)
-> (Operand -> NatM Register) -> NatM Register
forall a b. (a -> b) -> a -> b
$ \Operand
t ->
                      Bool
-> Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
intOp Bool
True Width
w (\Operand
d Operand
x Operand
y -> [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Operand -> Operand -> Operand -> Instr
SDIV Operand
t Operand
x Operand
y, Operand -> Operand -> Operand -> Operand -> Instr
MSUB Operand
d Operand
t Operand
y Operand
x ])
        
        MO_U_MulMayOflo Width
_w -> Platform -> CmmExpr -> NatM Register
forall env a b. OutputableP env a => env -> a -> b
unsupportedP Platform
plat CmmExpr
expr
        MO_U_Quot Width
w -> Bool
-> Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
intOp Bool
False Width
w (\Operand
d Operand
x Operand
y -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> Operand -> Instr
UDIV Operand
d Operand
x Operand
y)
        MO_U_Rem Width
w  -> Width -> (Operand -> NatM Register) -> NatM Register
forall {b}. Width -> (Operand -> NatM b) -> NatM b
withTempIntReg Width
w ((Operand -> NatM Register) -> NatM Register)
-> (Operand -> NatM Register) -> NatM Register
forall a b. (a -> b) -> a -> b
$ \Operand
t ->
                       Bool
-> Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
intOp Bool
False Width
w (\Operand
d Operand
x Operand
y -> [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Operand -> Operand -> Operand -> Instr
UDIV Operand
t Operand
x Operand
y, Operand -> Operand -> Operand -> Operand -> Instr
MSUB Operand
d Operand
t Operand
y Operand
x ])
        
        MO_S_Ge Width
w     -> Bool
-> Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
intOp Bool
True  Width
w (\Operand
d Operand
x Operand
y -> [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Operand -> Operand -> Instr
CMP Operand
x Operand
y, Operand -> Cond -> Instr
CSET Operand
d Cond
SGE ])
        MO_S_Le Width
w     -> Bool
-> Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
intOp Bool
True  Width
w (\Operand
d Operand
x Operand
y -> [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Operand -> Operand -> Instr
CMP Operand
x Operand
y, Operand -> Cond -> Instr
CSET Operand
d Cond
SLE ])
        MO_S_Gt Width
w     -> Bool
-> Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
intOp Bool
True  Width
w (\Operand
d Operand
x Operand
y -> [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Operand -> Operand -> Instr
CMP Operand
x Operand
y, Operand -> Cond -> Instr
CSET Operand
d Cond
SGT ])
        MO_S_Lt Width
w     -> Bool
-> Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
intOp Bool
True  Width
w (\Operand
d Operand
x Operand
y -> [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Operand -> Operand -> Instr
CMP Operand
x Operand
y, Operand -> Cond -> Instr
CSET Operand
d Cond
SLT ])
        
        MO_U_Ge Width
w     -> Bool
-> Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
intOp Bool
False Width
w (\Operand
d Operand
x Operand
y -> [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Operand -> Operand -> Instr
CMP Operand
x Operand
y, Operand -> Cond -> Instr
CSET Operand
d Cond
UGE ])
        MO_U_Le Width
w     -> Bool
-> Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
intOp Bool
False Width
w (\Operand
d Operand
x Operand
y -> [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Operand -> Operand -> Instr
CMP Operand
x Operand
y, Operand -> Cond -> Instr
CSET Operand
d Cond
ULE ])
        MO_U_Gt Width
w     -> Bool
-> Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
intOp Bool
False Width
w (\Operand
d Operand
x Operand
y -> [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Operand -> Operand -> Instr
CMP Operand
x Operand
y, Operand -> Cond -> Instr
CSET Operand
d Cond
UGT ])
        MO_U_Lt Width
w     -> Bool
-> Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
intOp Bool
False Width
w (\Operand
d Operand
x Operand
y -> [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Operand -> Operand -> Instr
CMP Operand
x Operand
y, Operand -> Cond -> Instr
CSET Operand
d Cond
ULT ])
        
        MO_F_Add Width
w   -> Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
floatOp Width
w (\Operand
d Operand
x Operand
y -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> Operand -> Instr
ADD Operand
d Operand
x Operand
y)
        MO_F_Sub Width
w   -> Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
floatOp Width
w (\Operand
d Operand
x Operand
y -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> Operand -> Instr
SUB Operand
d Operand
x Operand
y)
        MO_F_Mul Width
w   -> Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
floatOp Width
w (\Operand
d Operand
x Operand
y -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> Operand -> Instr
MUL Operand
d Operand
x Operand
y)
        MO_F_Quot Width
w  -> Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
floatOp Width
w (\Operand
d Operand
x Operand
y -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> Operand -> Instr
SDIV Operand
d Operand
x Operand
y)
        
        MO_F_Eq Width
w    -> Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
floatCond Width
w (\Operand
d Operand
x Operand
y -> [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Operand -> Operand -> Instr
CMP Operand
x Operand
y, Operand -> Cond -> Instr
CSET Operand
d Cond
EQ ])
        MO_F_Ne Width
w    -> Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
floatCond Width
w (\Operand
d Operand
x Operand
y -> [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Operand -> Operand -> Instr
CMP Operand
x Operand
y, Operand -> Cond -> Instr
CSET Operand
d Cond
NE ])
        
        
        
        
        
        MO_F_Ge Width
w    -> Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
floatCond Width
w (\Operand
d Operand
x Operand
y -> [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Operand -> Operand -> Instr
CMP Operand
x Operand
y, Operand -> Cond -> Instr
CSET Operand
d Cond
OGE ])
        MO_F_Le Width
w    -> Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
floatCond Width
w (\Operand
d Operand
x Operand
y -> [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Operand -> Operand -> Instr
CMP Operand
x Operand
y, Operand -> Cond -> Instr
CSET Operand
d Cond
OLE ]) 
        MO_F_Gt Width
w    -> Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
floatCond Width
w (\Operand
d Operand
x Operand
y -> [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Operand -> Operand -> Instr
CMP Operand
x Operand
y, Operand -> Cond -> Instr
CSET Operand
d Cond
OGT ])
        MO_F_Lt Width
w    -> Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
floatCond Width
w (\Operand
d Operand
x Operand
y -> [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Operand -> Operand -> Instr
CMP Operand
x Operand
y, Operand -> Cond -> Instr
CSET Operand
d Cond
OLT ]) 
        
        MO_And   Width
w -> Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
bitOp Width
w (\Operand
d Operand
x Operand
y -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> Operand -> Instr
AND Operand
d Operand
x Operand
y)
        MO_Or    Width
w -> Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
bitOp Width
w (\Operand
d Operand
x Operand
y -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> Operand -> Instr
ORR Operand
d Operand
x Operand
y)
        MO_Xor   Width
w -> Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
bitOp Width
w (\Operand
d Operand
x Operand
y -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> Operand -> Instr
EOR Operand
d Operand
x Operand
y)
        MO_Shl   Width
w -> Bool
-> Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
intOp Bool
False Width
w (\Operand
d Operand
x Operand
y -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> Operand -> Instr
LSL Operand
d Operand
x Operand
y)
        MO_U_Shr Width
w -> Bool
-> Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
intOp Bool
False Width
w (\Operand
d Operand
x Operand
y -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> Operand -> Instr
LSR Operand
d Operand
x Operand
y)
        MO_S_Shr Width
w -> Bool
-> Width
-> (Operand -> Operand -> Operand -> OrdList Instr)
-> NatM Register
intOp Bool
True  Width
w (\Operand
d Operand
x Operand
y -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> Operand -> Instr
ASR Operand
d Operand
x Operand
y)
        
        MachOp
op -> String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getRegister' (unhandled dyadic CmmMachOp): " (SDoc -> NatM Register) -> SDoc -> NatM Register
forall a b. (a -> b) -> a -> b
$ (MachOp -> SDoc
pprMachOp MachOp
op) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"in" SDoc -> SDoc -> SDoc
<+> (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
plat CmmExpr
expr)
    CmmMachOp MachOp
_op [CmmExpr]
_xs
      -> String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getRegister' (variadic CmmMachOp): " (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
plat CmmExpr
expr)
  where
    unsupportedP :: OutputableP env a => env -> a -> b
    unsupportedP :: forall env a b. OutputableP env a => env -> a -> b
unsupportedP env
platform a
op = String -> SDoc -> b
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Unsupported op:" (env -> a -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc env
platform a
op)
    isNbitEncodeable :: Int -> Integer -> Bool
    isNbitEncodeable :: Int -> Integer -> Bool
isNbitEncodeable Int
n Integer
i = let shift :: Int
shift = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 in (-Integer
1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
shift) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
i Bool -> Bool -> Bool
&& Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< (Integer
1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
shift)
    
    do_mul_may_oflo :: Width -> CmmExpr -> CmmExpr -> NatM Register
    do_mul_may_oflo :: Width -> CmmExpr -> CmmExpr -> NatM Register
do_mul_may_oflo w :: Width
w@Width
W64 CmmExpr
x CmmExpr
y = do
        (Reg
reg_x, Format
_format_x, OrdList Instr
code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg CmmExpr
x
        (Reg
reg_y, Format
_format_y, OrdList Instr
code_y) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg CmmExpr
y
        Reg
lo <- Format -> NatM Reg
getNewRegNat Format
II64
        Reg
hi <- Format -> NatM Reg
getNewRegNat Format
II64
        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 (Width -> Format
intFormat Width
w) (\Reg
dst ->
            OrdList Instr
code_x OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
            OrdList Instr
code_y OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
            Operand -> Operand -> Operand -> Instr
MUL (Width -> Reg -> Operand
OpReg Width
w Reg
lo) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_x) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_y) OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
            Operand -> Operand -> Operand -> Instr
SMULH (Width -> Reg -> Operand
OpReg Width
w Reg
hi) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_x) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_y) OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
            Operand -> Operand -> Instr
CMP (Width -> Reg -> Operand
OpReg Width
w Reg
hi) (Width -> Reg -> ShiftMode -> Int -> Operand
OpRegShift Width
w Reg
lo ShiftMode
SASR Int
63) OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
            Operand -> Cond -> Instr
CSET (Width -> Reg -> Operand
OpReg Width
w Reg
dst) Cond
NE)
    do_mul_may_oflo Width
w CmmExpr
x CmmExpr
y = do
        (Reg
reg_x, Format
_format_x, OrdList Instr
code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg CmmExpr
x
        (Reg
reg_y, Format
_format_y, OrdList Instr
code_y) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg CmmExpr
y
        let tmp_w :: Width
tmp_w = case Width
w of
                      Width
W32 -> Width
W64
                      Width
W16 -> Width
W32
                      Width
W8  -> Width
W32
                      Width
_   -> String -> Width
forall a. String -> a
panic String
"do_mul_may_oflo: impossible"
        
        Reg
tmp <- Format -> NatM Reg
getNewRegNat (Width -> Format
intFormat Width
tmp_w)
        let ext_mode :: ExtMode
ext_mode = case Width
w of
                         Width
W32 -> ExtMode
ESXTW
                         Width
W16 -> ExtMode
ESXTH
                         Width
W8  -> ExtMode
ESXTB
                         Width
_   -> String -> ExtMode
forall a. String -> a
panic String
"do_mul_may_oflo: impossible"
            mul :: Operand -> Operand -> Operand -> Instr
mul = case Width
w of
                    Width
W32 -> Operand -> Operand -> Operand -> Instr
SMULL
                    Width
W16 -> Operand -> Operand -> Operand -> Instr
MUL
                    Width
W8  -> Operand -> Operand -> Operand -> Instr
MUL
                    Width
_   -> String -> Operand -> Operand -> Operand -> Instr
forall a. String -> a
panic String
"do_mul_may_oflo: impossible"
        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 (Width -> Format
intFormat Width
w) (\Reg
dst ->
            OrdList Instr
code_x OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
            OrdList Instr
code_y OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
            Operand -> Operand -> Operand -> Instr
mul (Width -> Reg -> Operand
OpReg Width
tmp_w Reg
tmp) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_x) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_y) OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
            Operand -> Operand -> Instr
CMP (Width -> Reg -> Operand
OpReg Width
tmp_w Reg
tmp) (Width -> Reg -> ExtMode -> Int -> Operand
OpRegExt Width
tmp_w Reg
tmp ExtMode
ext_mode Int
0) OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
            Operand -> Cond -> Instr
CSET (Width -> Reg -> Operand
OpReg Width
w Reg
dst) Cond
NE)
isAArch64Bitmask :: Integer -> Bool
isAArch64Bitmask :: Integer -> Bool
isAArch64Bitmask Integer
0  = Bool
False
isAArch64Bitmask Integer
n
  | Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Integer
forall a. Bits a => Int -> a
bit Int
64 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1 = Bool
False
isAArch64Bitmask Integer
n  =
    Int -> Bool
check Int
64 Bool -> Bool -> Bool
|| Int -> Bool
check Int
32 Bool -> Bool -> Bool
|| Int -> Bool
check Int
16 Bool -> Bool -> Bool
|| Int -> Bool
check Int
8
  where
    
    
    check :: Int -> Bool
check Int
width
      | Word64 -> Bool
hasOneRun Word64
subpat =
          let n' :: Integer
n' = Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64 -> Word64
mkPat Int
width Word64
subpat)
          in Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
n'
      | Bool
otherwise = Bool
False
      where
        subpat :: Word64
        subpat :: Word64
subpat = Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
n Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. (Int -> Integer
forall a. Bits a => Int -> a
bit Int
width Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1))
    
    mkPat :: Int -> Word64 -> Word64
    mkPat :: Int -> Word64 -> Word64
mkPat Int
width Word64
subpat =
        (Word64 -> Word64 -> Word64) -> Word64 -> [Word64] -> Word64
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
(.|.) Word64
0 [ Word64
subpat Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
p | Int
p <- [Int
0, Int
width..Int
63] ]
    
    
    hasOneRun :: Word64 -> Bool
    hasOneRun :: Word64 -> Bool
hasOneRun Word64
m =
        Int
64 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Word64 -> Int
forall a. Bits a => a -> Int
popCount Word64
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word64 -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros Word64
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word64 -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros Word64
m
signExtendReg :: Width -> Width -> Reg -> NatM (Reg, OrdList Instr)
signExtendReg :: Width -> Width -> Reg -> NatM (Reg, OrdList Instr)
signExtendReg Width
w Width
w' Reg
r =
    case Width
w of
      Width
W64 -> NatM (Reg, OrdList Instr)
noop
      Width
W32
        | Width
w' Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W32 -> NatM (Reg, OrdList Instr)
noop
        | Bool
otherwise -> (Operand -> Operand -> Instr) -> NatM (Reg, OrdList Instr)
extend Operand -> Operand -> Instr
SXTH
      Width
W16           -> (Operand -> Operand -> Instr) -> NatM (Reg, OrdList Instr)
extend Operand -> Operand -> Instr
SXTH
      Width
W8            -> (Operand -> Operand -> Instr) -> NatM (Reg, OrdList Instr)
extend Operand -> Operand -> Instr
SXTB
      Width
_             -> String -> NatM (Reg, OrdList Instr)
forall a. String -> a
panic String
"intOp"
  where
    noop :: NatM (Reg, OrdList Instr)
noop = (Reg, OrdList Instr) -> NatM (Reg, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg
r, OrdList Instr
forall a. OrdList a
nilOL)
    extend :: (Operand -> Operand -> Instr) -> NatM (Reg, OrdList Instr)
extend Operand -> Operand -> Instr
instr = do
        Reg
r' <- Format -> NatM Reg
getNewRegNat Format
II64
        (Reg, OrdList Instr) -> NatM (Reg, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg
r', Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> Instr
instr (Width -> Reg -> Operand
OpReg Width
w' Reg
r') (Width -> Reg -> Operand
OpReg Width
w' Reg
r))
truncateReg :: Width -> Width -> Reg -> OrdList Instr
truncateReg :: Width -> Width -> Reg -> OrdList Instr
truncateReg Width
w Width
w' Reg
r =
    case Width
w of
      Width
W64 -> OrdList Instr
forall a. OrdList a
nilOL
      Width
W32
        | Width
w' Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W32 -> OrdList Instr
forall a. OrdList a
nilOL
      Width
_   -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> Operand -> Operand -> Instr
UBFM (Width -> Reg -> Operand
OpReg Width
w Reg
r)
                           (Width -> Reg -> Operand
OpReg Width
w Reg
r)
                           (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
0))
                           (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
$ Width -> Int
widthInBits Width
w' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
data Amode = Amode AddrMode InstrBlock
getAmode :: Platform
         -> Width     
         -> CmmExpr
         -> NatM Amode
getAmode :: Platform -> Width -> CmmExpr -> NatM Amode
getAmode Platform
platform Width
_ (CmmRegOff CmmReg
reg Int
off) | -Int
256 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
off, Int
off Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
255
  = 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 (Reg -> Imm -> AddrMode
AddrRegImm Reg
reg' Imm
off') OrdList Instr
forall a. OrdList a
nilOL
    where reg' :: Reg
reg' = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform CmmReg
reg
          off' :: Imm
off' = Int -> Imm
ImmInt Int
off
getAmode Platform
platform Width
W32 (CmmRegOff CmmReg
reg Int
off)
  | Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
off, Int
off Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
16380, Int
off Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
4 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 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 (Reg -> Imm -> AddrMode
AddrRegImm Reg
reg' Imm
off') OrdList Instr
forall a. OrdList a
nilOL
    where reg' :: Reg
reg' = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform CmmReg
reg
          off' :: Imm
off' = Int -> Imm
ImmInt Int
off
getAmode Platform
platform Width
W64 (CmmRegOff CmmReg
reg Int
off)
  | Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
off, Int
off Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
32760, Int
off Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
8 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 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 (Reg -> Imm -> AddrMode
AddrRegImm Reg
reg' Imm
off') OrdList Instr
forall a. OrdList a
nilOL
    where reg' :: Reg
reg' = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform CmmReg
reg
          off' :: Imm
off' = Int -> Imm
ImmInt Int
off
getAmode Platform
_platform Width
_ (CmmMachOp (MO_Add Width
_w) [CmmExpr
expr, CmmLit (CmmInt Integer
off Width
_w')])
  | -Integer
256 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
off, Integer
off Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
255
  = do (Reg
reg, Format
_format, OrdList Instr
code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg CmmExpr
expr
       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 (Reg -> Imm -> AddrMode
AddrRegImm Reg
reg (Integer -> Imm
ImmInteger Integer
off)) OrdList Instr
code
getAmode Platform
_platform Width
_ (CmmMachOp (MO_Sub Width
_w) [CmmExpr
expr, CmmLit (CmmInt Integer
off Width
_w')])
  | -Integer
256 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= -Integer
off, -Integer
off Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
255
  = do (Reg
reg, Format
_format, OrdList Instr
code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg CmmExpr
expr
       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 (Reg -> Imm -> AddrMode
AddrRegImm Reg
reg (Integer -> Imm
ImmInteger (-Integer
off))) OrdList Instr
code
getAmode Platform
_platform Width
_ CmmExpr
expr
  = do (Reg
reg, Format
_format, OrdList Instr
code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg CmmExpr
expr
       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 (Reg -> AddrMode
AddrReg Reg
reg) 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
rep CmmExpr
addrE CmmExpr
srcE
  = do
    (Reg
src_reg, Format
_format, OrdList Instr
code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg CmmExpr
srcE
    Platform
platform <- NatM Platform
getPlatform
    let w :: Width
w = Format -> Width
formatToWidth Format
rep
    Amode AddrMode
addr OrdList Instr
addr_code <- Platform -> Width -> CmmExpr -> NatM Amode
getAmode Platform
platform Width
w CmmExpr
addrE
    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
$ SDoc -> Instr
COMMENT (String -> SDoc
text String
"CmmStore" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
parens (String -> SDoc
text (CmmExpr -> String
forall a. Show a => a -> String
show CmmExpr
addrE)) SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
parens (String -> SDoc
text (CmmExpr -> String
forall a. Show a => a -> String
show CmmExpr
srcE)))
            Instr -> OrdList Instr -> OrdList Instr
forall a. a -> OrdList a -> OrdList a
`consOL` (OrdList Instr
code
            OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
addr_code
            OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Operand -> Operand -> Instr
STR Format
rep (Width -> Reg -> Operand
OpReg Width
w Reg
src_reg) (AddrMode -> Operand
OpAddr AddrMode
addr))
assignReg_IntCode :: Format -> CmmReg -> CmmExpr -> NatM (OrdList Instr)
assignReg_IntCode Format
_ CmmReg
reg CmmExpr
src
  = do
    Platform
platform <- NatM Platform
getPlatform
    let dst :: Reg
dst = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform CmmReg
reg
    Register
r <- CmmExpr -> NatM Register
getRegister CmmExpr
src
    OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ case Register
r of
      Any Format
_ Reg -> OrdList Instr
code              -> SDoc -> Instr
COMMENT (String -> SDoc
text String
"CmmAssign" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
parens (String -> SDoc
text (CmmReg -> String
forall a. Show a => a -> String
show CmmReg
reg)) SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
parens (String -> SDoc
text (CmmExpr -> String
forall a. Show a => a -> String
show CmmExpr
src))) Instr -> OrdList Instr -> OrdList Instr
forall a. a -> OrdList a -> OrdList a
`consOL` Reg -> OrdList Instr
code Reg
dst
      Fixed Format
format Reg
freg OrdList Instr
fcode -> SDoc -> Instr
COMMENT (String -> SDoc
text String
"CmmAssign" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
parens (String -> SDoc
text (CmmReg -> String
forall a. Show a => a -> String
show CmmReg
reg)) SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
parens (String -> SDoc
text (CmmExpr -> String
forall a. Show a => a -> String
show CmmExpr
src))) Instr -> OrdList Instr -> OrdList Instr
forall a. a -> OrdList a -> OrdList a
`consOL` (OrdList Instr
fcode OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Operand -> Operand -> Instr
MOV (Width -> Reg -> Operand
OpReg (Format -> Width
formatToWidth Format
format) Reg
dst) (Width -> Reg -> Operand
OpReg (Format -> Width
formatToWidth Format
format) Reg
freg))
assignMem_FltCode :: Format -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
assignMem_FltCode = Format -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
assignMem_IntCode
assignReg_FltCode :: Format -> CmmReg -> CmmExpr -> NatM (OrdList Instr)
assignReg_FltCode = Format -> CmmReg -> CmmExpr -> NatM (OrdList Instr)
assignReg_IntCode
genJump :: CmmExpr -> NatM InstrBlock
genJump :: CmmExpr -> NatM (OrdList Instr)
genJump expr :: CmmExpr
expr@(CmmLit (CmmLabel CLabel
lbl))
  = 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 (CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Target -> Instr
J (CLabel -> Target
TLabel CLabel
lbl)))
genJump CmmExpr
expr = do
    (Reg
target, Format
_format, OrdList Instr
code) <- CmmExpr -> NatM (Reg, Format, 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 -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Target -> Instr
J (Reg -> Target
TReg Reg
target))))
genBranch :: BlockId -> NatM InstrBlock
genBranch :: Label -> NatM (OrdList Instr)
genBranch = OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> NatM (OrdList Instr))
-> (Label -> OrdList Instr) -> Label -> NatM (OrdList Instr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL ([Instr] -> OrdList Instr)
-> (Label -> [Instr]) -> Label -> OrdList Instr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Label -> [Instr]
mkJumpInstr
genCondJump
    :: BlockId
    -> CmmExpr
    -> NatM InstrBlock
genCondJump :: Label -> CmmExpr -> NatM (OrdList Instr)
genCondJump Label
bid CmmExpr
expr = do
    case CmmExpr
expr of
      
      CmmMachOp (MO_Eq Width
w) [CmmExpr
x, CmmLit (CmmInt Integer
0 Width
_)] -> do
        (Reg
reg_x, Format
_format_x, OrdList Instr
code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg CmmExpr
x
        OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ OrdList Instr
code_x OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` (CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Operand -> Target -> Instr
CBZ (Width -> Reg -> Operand
OpReg Width
w Reg
reg_x) (Label -> Target
TBlock Label
bid)))
      
      CmmMachOp (MO_Ne Width
w) [CmmExpr
x, CmmLit (CmmInt Integer
0 Width
_)] -> do
        (Reg
reg_x, Format
_format_x, OrdList Instr
code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg CmmExpr
x
        OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ OrdList Instr
code_x OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`  (CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Operand -> Target -> Instr
CBNZ (Width -> Reg -> Operand
OpReg Width
w Reg
reg_x) (Label -> Target
TBlock Label
bid)))
      
      CmmMachOp MachOp
mop [CmmExpr
x, CmmExpr
y] -> do
        let ubcond :: Width -> Cond -> NatM (OrdList Instr)
ubcond Width
w Cond
cmp = do
                
                (Reg
reg_x, Format
_format_x, OrdList Instr
code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg CmmExpr
x
                (Reg
reg_y, Format
_format_y, OrdList Instr
code_y) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg CmmExpr
y
                let x' :: Operand
x' = Width -> Reg -> Operand
OpReg Width
w Reg
reg_x
                    y' :: Operand
y' = Width -> Reg -> Operand
OpReg Width
w Reg
reg_y
                OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ case Width
w of
                  Width
W8  -> OrdList Instr
code_x OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code_y OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Operand -> Operand -> Instr
UXTB Operand
x' Operand
x', Operand -> Operand -> Instr
UXTB Operand
y' Operand
y', Operand -> Operand -> Instr
CMP Operand
x' Operand
y', (CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Cond -> Target -> Instr
BCOND Cond
cmp (Label -> Target
TBlock Label
bid))) ]
                  Width
W16 -> OrdList Instr
code_x OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code_y OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Operand -> Operand -> Instr
UXTH Operand
x' Operand
x', Operand -> Operand -> Instr
UXTH Operand
y' Operand
y', Operand -> Operand -> Instr
CMP Operand
x' Operand
y', (CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Cond -> Target -> Instr
BCOND Cond
cmp (Label -> Target
TBlock Label
bid))) ]
                  Width
_   -> OrdList Instr
code_x OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code_y OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [                         Operand -> Operand -> Instr
CMP Operand
x' Operand
y', (CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Cond -> Target -> Instr
BCOND Cond
cmp (Label -> Target
TBlock Label
bid))) ]
            sbcond :: Width -> Cond -> NatM (OrdList Instr)
sbcond Width
w Cond
cmp = do
                
                (Reg
reg_x, Format
_format_x, OrdList Instr
code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg CmmExpr
x
                (Reg
reg_y, Format
_format_y, OrdList Instr
code_y) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg CmmExpr
y
                let x' :: Operand
x' = Width -> Reg -> Operand
OpReg Width
w Reg
reg_x
                    y' :: Operand
y' = Width -> Reg -> Operand
OpReg Width
w Reg
reg_y
                OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ case Width
w of
                  Width
W8  -> OrdList Instr
code_x OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code_y OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Operand -> Operand -> Instr
SXTB Operand
x' Operand
x', Operand -> Operand -> Instr
SXTB Operand
y' Operand
y', Operand -> Operand -> Instr
CMP Operand
x' Operand
y', (CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Cond -> Target -> Instr
BCOND Cond
cmp (Label -> Target
TBlock Label
bid))) ]
                  Width
W16 -> OrdList Instr
code_x OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code_y OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Operand -> Operand -> Instr
SXTH Operand
x' Operand
x', Operand -> Operand -> Instr
SXTH Operand
y' Operand
y', Operand -> Operand -> Instr
CMP Operand
x' Operand
y', (CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Cond -> Target -> Instr
BCOND Cond
cmp (Label -> Target
TBlock Label
bid))) ]
                  Width
_   -> OrdList Instr
code_x OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code_y OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [                         Operand -> Operand -> Instr
CMP Operand
x' Operand
y', (CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Cond -> Target -> Instr
BCOND Cond
cmp (Label -> Target
TBlock Label
bid))) ]
            fbcond :: Width -> Cond -> NatM (OrdList Instr)
fbcond Width
w Cond
cmp = do
              
              (Reg
reg_fx, Format
_format_fx, OrdList Instr
code_fx) <- HasCallStack => CmmExpr -> NatM (Reg, Format, OrdList Instr)
CmmExpr -> NatM (Reg, Format, OrdList Instr)
getFloatReg CmmExpr
x
              (Reg
reg_fy, Format
_format_fy, OrdList Instr
code_fy) <- HasCallStack => CmmExpr -> NatM (Reg, Format, OrdList Instr)
CmmExpr -> NatM (Reg, Format, OrdList Instr)
getFloatReg CmmExpr
y
              OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ OrdList Instr
code_fx OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code_fy OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Operand -> Operand -> Instr
CMP (Width -> Reg -> Operand
OpReg Width
w Reg
reg_fx) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_fy) OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` (CmmExpr -> Instr -> Instr
annExpr CmmExpr
expr (Cond -> Target -> Instr
BCOND Cond
cmp (Label -> Target
TBlock Label
bid)))
        case MachOp
mop of
          MO_F_Eq Width
w -> Width -> Cond -> NatM (OrdList Instr)
fbcond Width
w Cond
EQ
          MO_F_Ne Width
w -> Width -> Cond -> NatM (OrdList Instr)
fbcond Width
w Cond
NE
          MO_F_Gt Width
w -> Width -> Cond -> NatM (OrdList Instr)
fbcond Width
w Cond
OGT
          MO_F_Ge Width
w -> Width -> Cond -> NatM (OrdList Instr)
fbcond Width
w Cond
OGE
          MO_F_Lt Width
w -> Width -> Cond -> NatM (OrdList Instr)
fbcond Width
w Cond
OLT
          MO_F_Le Width
w -> Width -> Cond -> NatM (OrdList Instr)
fbcond Width
w Cond
OLE
          MO_Eq Width
w   -> Width -> Cond -> NatM (OrdList Instr)
sbcond Width
w Cond
EQ
          MO_Ne Width
w   -> Width -> Cond -> NatM (OrdList Instr)
sbcond Width
w Cond
NE
          MO_S_Gt Width
w -> Width -> Cond -> NatM (OrdList Instr)
sbcond Width
w Cond
SGT
          MO_S_Ge Width
w -> Width -> Cond -> NatM (OrdList Instr)
sbcond Width
w Cond
SGE
          MO_S_Lt Width
w -> Width -> Cond -> NatM (OrdList Instr)
sbcond Width
w Cond
SLT
          MO_S_Le Width
w -> Width -> Cond -> NatM (OrdList Instr)
sbcond Width
w Cond
SLE
          MO_U_Gt Width
w -> Width -> Cond -> NatM (OrdList Instr)
ubcond Width
w Cond
UGT
          MO_U_Ge Width
w -> Width -> Cond -> NatM (OrdList Instr)
ubcond Width
w Cond
UGE
          MO_U_Lt Width
w -> Width -> Cond -> NatM (OrdList Instr)
ubcond Width
w Cond
ULT
          MO_U_Le Width
w -> Width -> Cond -> NatM (OrdList Instr)
ubcond Width
w Cond
ULE
          MachOp
_ -> String -> SDoc -> NatM (OrdList Instr)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"AArch64.genCondJump:case mop: " (String -> SDoc
text (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$ CmmExpr -> String
forall a. Show a => a -> String
show CmmExpr
expr)
      CmmExpr
_ -> String -> SDoc -> NatM (OrdList Instr)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"AArch64.genCondJump: " (String -> SDoc
text (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$ CmmExpr -> String
forall a. Show a => a -> String
show CmmExpr
expr)
genCondFarJump :: MonadUnique m => Cond -> Target -> m InstrBlock
genCondFarJump :: forall (m :: * -> *).
MonadUnique m =>
Cond -> Target -> m (OrdList Instr)
genCondFarJump Cond
cond Target
far_target = do
  Label
skip_lbl_id <- m Label
forall (m :: * -> *). MonadUnique m => m Label
newBlockId
  Label
jmp_lbl_id <- m Label
forall (m :: * -> *). MonadUnique m => m Label
newBlockId
  
  
  
  
  
  OrdList Instr -> m (OrdList Instr)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> m (OrdList Instr))
-> OrdList Instr -> m (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Cond -> Target -> Instr
BCOND Cond
cond (Label -> Target
TBlock Label
jmp_lbl_id)
                , Target -> Instr
B (Label -> Target
TBlock Label
skip_lbl_id)
                , Label -> Instr
NEWBLOCK Label
jmp_lbl_id
                , Target -> Instr
B Target
far_target
                , Label -> Instr
NEWBLOCK Label
skip_lbl_id]
genCondBranch
    :: BlockId      
    -> BlockId      
    -> BlockId      
    -> CmmExpr      
    -> NatM InstrBlock 
genCondBranch :: Label -> Label -> Label -> CmmExpr -> NatM (OrdList Instr)
genCondBranch Label
_ Label
true Label
false CmmExpr
expr = do
  OrdList Instr
b1 <- Label -> CmmExpr -> NatM (OrdList Instr)
genCondJump Label
true CmmExpr
expr
  OrdList Instr
b2 <- Label -> NatM (OrdList Instr)
genBranch Label
false
  OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr
b1 OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
b2)
genCCall
    :: ForeignTarget      
    -> [CmmFormal]        
    -> [CmmActual]        
    -> BlockId            
    -> NatM (InstrBlock, Maybe BlockId)
genCCall :: ForeignTarget
-> [CmmFormal]
-> [CmmExpr]
-> Label
-> NatM (OrdList Instr, Maybe Label)
genCCall ForeignTarget
target [CmmFormal]
dest_regs [CmmExpr]
arg_regs Label
bid = do
  
  
  
  
  case ForeignTarget
target of
    
    
    
    ForeignTarget CmmExpr
expr ForeignConvention
_cconv -> do
      (Target
call_target, OrdList Instr
call_target_code) <- case CmmExpr
expr of
        
        
        (CmmLit (CmmLabel CLabel
lbl)) -> (Target, OrdList Instr) -> NatM (Target, OrdList Instr)
forall a. a -> NatM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CLabel -> Target
TLabel CLabel
lbl, OrdList Instr
forall a. OrdList a
nilOL)
        
        
        CmmExpr
_ -> do (Reg
reg, Format
_format, OrdList Instr
reg_code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
getSomeReg CmmExpr
expr
                (Target, OrdList Instr) -> NatM (Target, OrdList Instr)
forall a. a -> NatM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Reg -> Target
TReg Reg
reg, OrdList Instr
reg_code)
      
      
      [(Reg, Format, OrdList Instr)]
arg_regs' <- (CmmExpr -> NatM (Reg, Format, OrdList Instr))
-> [CmmExpr] -> NatM [(Reg, Format, 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 (Reg, Format, OrdList Instr)
getSomeReg [CmmExpr]
arg_regs
      
      
      
      
      
      
      
      let ([ForeignHint]
_res_hints, [ForeignHint]
arg_hints) = ForeignTarget -> ([ForeignHint], [ForeignHint])
foreignTargetHints ForeignTarget
target
          arg_regs'' :: [(Reg, Format, ForeignHint, OrdList Instr)]
arg_regs'' = ((Reg, Format, OrdList Instr)
 -> ForeignHint -> (Reg, Format, ForeignHint, OrdList Instr))
-> [(Reg, Format, OrdList Instr)]
-> [ForeignHint]
-> [(Reg, Format, ForeignHint, OrdList Instr)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\(Reg
r, Format
f, OrdList Instr
c) ForeignHint
h -> (Reg
r,Format
f,ForeignHint
h,OrdList Instr
c)) [(Reg, Format, OrdList Instr)]
arg_regs' [ForeignHint]
arg_hints
      Platform
platform <- NatM Platform
getPlatform
      let packStack :: Bool
packStack = Platform -> OS
platformOS Platform
platform OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSDarwin
      (Int
stackSpace', [Reg]
passRegs, OrdList Instr
passArgumentsCode) <- Bool
-> [Reg]
-> [Reg]
-> [(Reg, Format, ForeignHint, OrdList Instr)]
-> Int
-> [Reg]
-> OrdList Instr
-> NatM (Int, [Reg], OrdList Instr)
passArguments Bool
packStack [Reg]
allGpArgRegs [Reg]
allFpArgRegs [(Reg, Format, ForeignHint, OrdList Instr)]
arg_regs'' Int
0 [] OrdList Instr
forall a. OrdList a
nilOL
      
      
      let stackSpace :: Int
stackSpace = if Int
stackSpace' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
8 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
                       then Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
stackSpace' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                       else Int
stackSpace'
      ([Reg]
returnRegs, OrdList Instr
readResultsCode)   <- [Reg]
-> [Reg]
-> [CmmFormal]
-> [Reg]
-> OrdList Instr
-> NatM ([Reg], OrdList Instr)
readResults [Reg]
allGpArgRegs [Reg]
allFpArgRegs [CmmFormal]
dest_regs [] OrdList Instr
forall a. OrdList a
nilOL
      let moveStackDown :: Int -> OrdList Instr
moveStackDown Int
0 = [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Instr
PUSH_STACK_FRAME
                                 , Int -> Instr
DELTA (-Int
16) ]
          moveStackDown Int
i | Int -> Bool
forall a. Integral a => a -> Bool
odd Int
i = Int -> OrdList Instr
moveStackDown (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          moveStackDown Int
i = [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Instr
PUSH_STACK_FRAME
                                 , Operand -> Operand -> Operand -> Instr
SUB (Width -> Reg -> Operand
OpReg Width
W64 (Int -> Reg
regSingle Int
31)) (Width -> Reg -> Operand
OpReg Width
W64 (Int -> Reg
regSingle Int
31)) (Imm -> Operand
OpImm (Int -> Imm
ImmInt (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i)))
                                 , Int -> Instr
DELTA (-Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
16) ]
          moveStackUp :: Int -> OrdList Instr
moveStackUp Int
0 = [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Instr
POP_STACK_FRAME
                               , Int -> Instr
DELTA Int
0 ]
          moveStackUp Int
i | Int -> Bool
forall a. Integral a => a -> Bool
odd Int
i = Int -> OrdList Instr
moveStackUp (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          moveStackUp Int
i = [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Operand -> Operand -> Operand -> Instr
ADD (Width -> Reg -> Operand
OpReg Width
W64 (Int -> Reg
regSingle Int
31)) (Width -> Reg -> Operand
OpReg Width
W64 (Int -> Reg
regSingle Int
31)) (Imm -> Operand
OpImm (Int -> Imm
ImmInt (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i)))
                               , Instr
POP_STACK_FRAME
                               , Int -> Instr
DELTA Int
0 ]
      let code :: OrdList Instr
code =    OrdList Instr
call_target_code          
            OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Int -> OrdList Instr
moveStackDown (Int
stackSpace Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8)
            OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
passArgumentsCode         
            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 -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ Target -> [Reg] -> [Reg] -> Instr
BL Target
call_target [Reg]
passRegs [Reg]
returnRegs) 
            OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
readResultsCode           
            OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Int -> OrdList Instr
moveStackUp (Int
stackSpace Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8)
      (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
code, Maybe Label
forall a. Maybe a
Nothing)
    PrimTarget CallishMachOp
MO_F32_Fabs
      | [CmmExpr
arg_reg] <- [CmmExpr]
arg_regs, [CmmFormal
dest_reg] <- [CmmFormal]
dest_regs ->
        Width
-> (Operand -> Operand -> OrdList Instr)
-> CmmExpr
-> CmmFormal
-> NatM (OrdList Instr, Maybe Label)
forall {a}.
Width
-> (Operand -> Operand -> OrdList Instr)
-> CmmExpr
-> CmmFormal
-> NatM (OrdList Instr, Maybe a)
unaryFloatOp Width
W32 (\Operand
d Operand
x -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> Instr
FABS Operand
d Operand
x) CmmExpr
arg_reg CmmFormal
dest_reg
    PrimTarget CallishMachOp
MO_F64_Fabs
      | [CmmExpr
arg_reg] <- [CmmExpr]
arg_regs, [CmmFormal
dest_reg] <- [CmmFormal]
dest_regs ->
        Width
-> (Operand -> Operand -> OrdList Instr)
-> CmmExpr
-> CmmFormal
-> NatM (OrdList Instr, Maybe Label)
forall {a}.
Width
-> (Operand -> Operand -> OrdList Instr)
-> CmmExpr
-> CmmFormal
-> NatM (OrdList Instr, Maybe a)
unaryFloatOp Width
W64 (\Operand
d Operand
x -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> Instr
FABS Operand
d Operand
x) CmmExpr
arg_reg CmmFormal
dest_reg
    
    
    PrimTarget CallishMachOp
mop -> do
      
      case CallishMachOp
mop of
        
        CallishMachOp
MO_F64_Pwr   -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"pow"
        CallishMachOp
MO_F64_Sin   -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"sin"
        CallishMachOp
MO_F64_Cos   -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"cos"
        CallishMachOp
MO_F64_Tan   -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"tan"
        CallishMachOp
MO_F64_Sinh  -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"sinh"
        CallishMachOp
MO_F64_Cosh  -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"cosh"
        CallishMachOp
MO_F64_Tanh  -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"tanh"
        CallishMachOp
MO_F64_Asin  -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"asin"
        CallishMachOp
MO_F64_Acos  -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"acos"
        CallishMachOp
MO_F64_Atan  -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"atan"
        CallishMachOp
MO_F64_Asinh -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"asinh"
        CallishMachOp
MO_F64_Acosh -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"acosh"
        CallishMachOp
MO_F64_Atanh -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"atanh"
        CallishMachOp
MO_F64_Log   -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"log"
        CallishMachOp
MO_F64_Log1P -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"log1p"
        CallishMachOp
MO_F64_Exp   -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"exp"
        CallishMachOp
MO_F64_ExpM1 -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"expm1"
        CallishMachOp
MO_F64_Fabs  -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"fabs"
        CallishMachOp
MO_F64_Sqrt  -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"sqrt"
        
        CallishMachOp
MO_F32_Pwr   -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"powf"
        CallishMachOp
MO_F32_Sin   -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"sinf"
        CallishMachOp
MO_F32_Cos   -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"cosf"
        CallishMachOp
MO_F32_Tan   -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"tanf"
        CallishMachOp
MO_F32_Sinh  -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"sinhf"
        CallishMachOp
MO_F32_Cosh  -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"coshf"
        CallishMachOp
MO_F32_Tanh  -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"tanhf"
        CallishMachOp
MO_F32_Asin  -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"asinf"
        CallishMachOp
MO_F32_Acos  -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"acosf"
        CallishMachOp
MO_F32_Atan  -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"atanf"
        CallishMachOp
MO_F32_Asinh -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"asinhf"
        CallishMachOp
MO_F32_Acosh -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"acoshf"
        CallishMachOp
MO_F32_Atanh -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"atanhf"
        CallishMachOp
MO_F32_Log   -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"logf"
        CallishMachOp
MO_F32_Log1P -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"log1pf"
        CallishMachOp
MO_F32_Exp   -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"expf"
        CallishMachOp
MO_F32_ExpM1 -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"expm1f"
        CallishMachOp
MO_F32_Fabs  -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"fabsf"
        CallishMachOp
MO_F32_Sqrt  -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"sqrtf"
        
        CallishMachOp
MO_I64_ToI   -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"hs_int64ToInt"
        CallishMachOp
MO_I64_FromI -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"hs_intToInt64"
        CallishMachOp
MO_W64_ToW   -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"hs_word64ToWord"
        CallishMachOp
MO_W64_FromW -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"hs_wordToWord64"
        CallishMachOp
MO_x64_Neg   -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"hs_neg64"
        CallishMachOp
MO_x64_Add   -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"hs_add64"
        CallishMachOp
MO_x64_Sub   -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"hs_sub64"
        CallishMachOp
MO_x64_Mul   -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"hs_mul64"
        CallishMachOp
MO_I64_Quot  -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"hs_quotInt64"
        CallishMachOp
MO_I64_Rem   -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"hs_remInt64"
        CallishMachOp
MO_W64_Quot  -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"hs_quotWord64"
        CallishMachOp
MO_W64_Rem   -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"hs_remWord64"
        CallishMachOp
MO_x64_And   -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"hs_and64"
        CallishMachOp
MO_x64_Or    -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"hs_or64"
        CallishMachOp
MO_x64_Xor   -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"hs_xor64"
        CallishMachOp
MO_x64_Not   -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"hs_not64"
        CallishMachOp
MO_x64_Shl   -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"hs_uncheckedShiftL64"
        CallishMachOp
MO_I64_Shr   -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"hs_uncheckedIShiftRA64"
        CallishMachOp
MO_W64_Shr   -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"hs_uncheckedShiftRL64"
        CallishMachOp
MO_x64_Eq    -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"hs_eq64"
        CallishMachOp
MO_x64_Ne    -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"hs_ne64"
        CallishMachOp
MO_I64_Ge    -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"hs_geInt64"
        CallishMachOp
MO_I64_Gt    -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"hs_gtInt64"
        CallishMachOp
MO_I64_Le    -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"hs_leInt64"
        CallishMachOp
MO_I64_Lt    -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"hs_ltInt64"
        CallishMachOp
MO_W64_Ge    -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"hs_geWord64"
        CallishMachOp
MO_W64_Gt    -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"hs_gtWord64"
        CallishMachOp
MO_W64_Le    -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"hs_leWord64"
        CallishMachOp
MO_W64_Lt    -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"hs_ltWord64"
        
        MO_UF_Conv Width
w        -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall (Width -> FastString
word2FloatLabel Width
w)
        
        
        MO_S_Mul2     Width
_w -> CallishMachOp -> NatM (OrdList Instr, Maybe Label)
forall a b. Show a => a -> b
unsupported CallishMachOp
mop
        MO_S_QuotRem  Width
_w -> CallishMachOp -> NatM (OrdList Instr, Maybe Label)
forall a b. Show a => a -> b
unsupported CallishMachOp
mop
        MO_U_QuotRem  Width
_w -> CallishMachOp -> NatM (OrdList Instr, Maybe Label)
forall a b. Show a => a -> b
unsupported CallishMachOp
mop
        MO_U_QuotRem2 Width
_w -> CallishMachOp -> NatM (OrdList Instr, Maybe Label)
forall a b. Show a => a -> b
unsupported CallishMachOp
mop
        MO_Add2       Width
_w -> CallishMachOp -> NatM (OrdList Instr, Maybe Label)
forall a b. Show a => a -> b
unsupported CallishMachOp
mop
        MO_AddWordC   Width
_w -> CallishMachOp -> NatM (OrdList Instr, Maybe Label)
forall a b. Show a => a -> b
unsupported CallishMachOp
mop
        MO_SubWordC   Width
_w -> CallishMachOp -> NatM (OrdList Instr, Maybe Label)
forall a b. Show a => a -> b
unsupported CallishMachOp
mop
        MO_AddIntC    Width
_w -> CallishMachOp -> NatM (OrdList Instr, Maybe Label)
forall a b. Show a => a -> b
unsupported CallishMachOp
mop
        MO_SubIntC    Width
_w -> CallishMachOp -> NatM (OrdList Instr, Maybe Label)
forall a b. Show a => a -> b
unsupported CallishMachOp
mop
        MO_U_Mul2     Width
_w -> CallishMachOp -> NatM (OrdList Instr, Maybe Label)
forall a b. Show a => a -> b
unsupported CallishMachOp
mop
        
        
        CallishMachOp
MO_ReadBarrier      ->  (OrdList Instr, Maybe Label) -> NatM (OrdList Instr, Maybe Label)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL Instr
DMBSY, Maybe Label
forall a. Maybe a
Nothing)
        CallishMachOp
MO_WriteBarrier     ->  (OrdList Instr, Maybe Label) -> NatM (OrdList Instr, Maybe Label)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL Instr
DMBSY, Maybe Label
forall a. Maybe a
Nothing)
        CallishMachOp
MO_Touch            ->  (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
forall a. OrdList a
nilOL, Maybe Label
forall a. Maybe a
Nothing) 
        
        MO_Prefetch_Data Int
_n -> (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
forall a. OrdList a
nilOL, Maybe Label
forall a. Maybe a
Nothing) 
        
        
        
        
        
        
        MO_Memcpy  Int
_align   -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"memcpy"
        MO_Memset  Int
_align   -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"memset"
        MO_Memmove Int
_align   -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"memmove"
        MO_Memcmp  Int
_align   -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"memcmp"
        CallishMachOp
MO_SuspendThread    -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"suspendThread"
        CallishMachOp
MO_ResumeThread     -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
"resumeThread"
        MO_PopCnt Width
w         -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall (Width -> FastString
popCntLabel Width
w)
        MO_Pdep Width
w           -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall (Width -> FastString
pdepLabel Width
w)
        MO_Pext Width
w           -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall (Width -> FastString
pextLabel Width
w)
        MO_Clz Width
w            -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall (Width -> FastString
clzLabel Width
w)
        MO_Ctz Width
w            -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall (Width -> FastString
ctzLabel Width
w)
        MO_BSwap Width
w          -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall (Width -> FastString
bSwapLabel Width
w)
        MO_BRev Width
w           -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall (Width -> FastString
bRevLabel Width
w)
        
        MO_AtomicRMW Width
w AtomicMachOp
amop -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall (Width -> AtomicMachOp -> FastString
atomicRMWLabel Width
w AtomicMachOp
amop)
        MO_AtomicRead Width
w MemoryOrdering
_   -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall (Width -> FastString
atomicReadLabel Width
w)
        MO_AtomicWrite Width
w MemoryOrdering
_  -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall (Width -> FastString
atomicWriteLabel Width
w)
        MO_Cmpxchg Width
w        -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall (Width -> FastString
cmpxchgLabel Width
w)
        
        
        
        MO_Xchg Width
w           -> FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall (Width -> FastString
xchgLabel Width
w)
  where
    unsupported :: Show a => a -> b
    unsupported :: forall a b. Show a => a -> b
unsupported a
mop = String -> b
forall a. String -> a
panic (String
"outOfLineCmmOp: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
mop
                          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not supported here")
    mkCCall :: FastString -> NatM (InstrBlock, Maybe BlockId)
    mkCCall :: FastString -> NatM (OrdList Instr, Maybe Label)
mkCCall FastString
name = do
      NCGConfig
config <- NatM NCGConfig
getConfig
      CmmExpr
target <- NCGConfig -> ReferenceKind -> CLabel -> NatM CmmExpr
forall (m :: * -> *).
CmmMakeDynamicReferenceM m =>
NCGConfig -> ReferenceKind -> CLabel -> m CmmExpr
cmmMakeDynamicReference NCGConfig
config ReferenceKind
CallReference (CLabel -> NatM CmmExpr) -> CLabel -> NatM CmmExpr
forall a b. (a -> b) -> a -> b
$
          FastString
-> Maybe Int -> ForeignLabelSource -> FunctionOrData -> CLabel
mkForeignLabel FastString
name Maybe Int
forall a. Maybe a
Nothing ForeignLabelSource
ForeignLabelInThisPackage FunctionOrData
IsFunction
      let cconv :: ForeignConvention
cconv = CCallConv
-> [ForeignHint]
-> [ForeignHint]
-> CmmReturnInfo
-> ForeignConvention
ForeignConvention CCallConv
CCallConv [ForeignHint
NoHint] [ForeignHint
NoHint] CmmReturnInfo
CmmMayReturn
      ForeignTarget
-> [CmmFormal]
-> [CmmExpr]
-> Label
-> NatM (OrdList Instr, Maybe Label)
genCCall (CmmExpr -> ForeignConvention -> ForeignTarget
ForeignTarget CmmExpr
target ForeignConvention
cconv) [CmmFormal]
dest_regs [CmmExpr]
arg_regs Label
bid
    
    
    
    
    
    
    
    
    passArguments :: Bool -> [Reg] -> [Reg] -> [(Reg, Format, ForeignHint, InstrBlock)] -> Int -> [Reg] -> InstrBlock -> NatM (Int, [Reg], InstrBlock)
    passArguments :: Bool
-> [Reg]
-> [Reg]
-> [(Reg, Format, ForeignHint, OrdList Instr)]
-> Int
-> [Reg]
-> OrdList Instr
-> NatM (Int, [Reg], OrdList Instr)
passArguments Bool
_packStack [Reg]
_ [Reg]
_ [] Int
stackSpace [Reg]
accumRegs OrdList Instr
accumCode = (Int, [Reg], OrdList Instr) -> NatM (Int, [Reg], OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
stackSpace, [Reg]
accumRegs, OrdList Instr
accumCode)
    
    
    
    
    
    
    
    
    
    
      
      
      
      
      
      
      
      
      
      
      
      
      
      
      
      
      
      
      
      
      
      
      
      
      
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    passArguments Bool
pack (Reg
gpReg:[Reg]
gpRegs) [Reg]
fpRegs ((Reg
r, Format
format, ForeignHint
hint, OrdList Instr
code_r):[(Reg, Format, ForeignHint, OrdList Instr)]
args) Int
stackSpace [Reg]
accumRegs OrdList Instr
accumCode | Format -> Bool
isIntFormat Format
format = do
      Platform
platform <- NatM Platform
getPlatform
      let w :: Width
w = Format -> Width
formatToWidth Format
format
          mov :: Instr
mov
            
            
            | Width
w Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
< Width
W32
            , Platform -> Bool
platformCConvNeedsExtension Platform
platform
            , ForeignHint
SignedHint <- ForeignHint
hint
            = case Width
w of
                Width
W8  -> Operand -> Operand -> Instr
SXTB (Width -> Reg -> Operand
OpReg Width
W64 Reg
gpReg) (Width -> Reg -> Operand
OpReg Width
w Reg
r)
                Width
W16 -> Operand -> Operand -> Instr
SXTH (Width -> Reg -> Operand
OpReg Width
W64 Reg
gpReg) (Width -> Reg -> Operand
OpReg Width
w Reg
r)
                Width
_   -> String -> Instr
forall a. String -> a
panic String
"impossible"
            | Bool
otherwise
            = Operand -> Operand -> Instr
MOV (Width -> Reg -> Operand
OpReg Width
w Reg
gpReg) (Width -> Reg -> Operand
OpReg Width
w Reg
r)
          accumCode' :: OrdList Instr
accumCode' = OrdList Instr
accumCode OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                       OrdList Instr
code_r OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
                       SDoc -> Instr -> Instr
ann (String -> SDoc
text String
"Pass gp argument: " SDoc -> SDoc -> SDoc
<> Reg -> SDoc
forall a. Outputable a => a -> SDoc
ppr Reg
r) Instr
mov
      Bool
-> [Reg]
-> [Reg]
-> [(Reg, Format, ForeignHint, OrdList Instr)]
-> Int
-> [Reg]
-> OrdList Instr
-> NatM (Int, [Reg], OrdList Instr)
passArguments Bool
pack [Reg]
gpRegs [Reg]
fpRegs [(Reg, Format, ForeignHint, OrdList Instr)]
args Int
stackSpace (Reg
gpRegReg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
:[Reg]
accumRegs) OrdList Instr
accumCode'
    
    passArguments Bool
pack [Reg]
gpRegs (Reg
fpReg:[Reg]
fpRegs) ((Reg
r, Format
format, ForeignHint
_hint, OrdList Instr
code_r):[(Reg, Format, ForeignHint, OrdList Instr)]
args) Int
stackSpace [Reg]
accumRegs OrdList Instr
accumCode | Format -> Bool
isFloatFormat Format
format = do
      let w :: Width
w = Format -> Width
formatToWidth Format
format
          mov :: Instr
mov = Operand -> Operand -> Instr
MOV (Width -> Reg -> Operand
OpReg Width
w Reg
fpReg) (Width -> Reg -> Operand
OpReg Width
w Reg
r)
          accumCode' :: OrdList Instr
accumCode' = OrdList Instr
accumCode OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                       OrdList Instr
code_r OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
                       SDoc -> Instr -> Instr
ann (String -> SDoc
text String
"Pass fp argument: " SDoc -> SDoc -> SDoc
<> Reg -> SDoc
forall a. Outputable a => a -> SDoc
ppr Reg
r) Instr
mov
      Bool
-> [Reg]
-> [Reg]
-> [(Reg, Format, ForeignHint, OrdList Instr)]
-> Int
-> [Reg]
-> OrdList Instr
-> NatM (Int, [Reg], OrdList Instr)
passArguments Bool
pack [Reg]
gpRegs [Reg]
fpRegs [(Reg, Format, ForeignHint, OrdList Instr)]
args Int
stackSpace (Reg
fpRegReg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
:[Reg]
accumRegs) OrdList Instr
accumCode'
    
    passArguments Bool
pack [] [] ((Reg
r, Format
format, ForeignHint
_hint, OrdList Instr
code_r):[(Reg, Format, ForeignHint, OrdList Instr)]
args) Int
stackSpace [Reg]
accumRegs OrdList Instr
accumCode = do
      let w :: Width
w = Format -> Width
formatToWidth Format
format
          bytes :: Int
bytes = Width -> Int
widthInBits Width
w Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8
          space :: Int
space = if Bool
pack then Int
bytes else Int
8
          stackSpace' :: Int
stackSpace' | Bool
pack Bool -> Bool -> Bool
&& Int
stackSpace Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
space Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 = Int
stackSpace Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
space Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
stackSpace Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
space)
                      | Bool
otherwise                           = Int
stackSpace
          str :: Instr
str = Format -> Operand -> Operand -> Instr
STR Format
format (Width -> Reg -> Operand
OpReg Width
w Reg
r) (AddrMode -> Operand
OpAddr (Reg -> Imm -> AddrMode
AddrRegImm (Int -> Reg
regSingle Int
31) (Int -> Imm
ImmInt Int
stackSpace')))
          stackCode :: OrdList Instr
stackCode = OrdList Instr
code_r OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
                      SDoc -> Instr -> Instr
ann (String -> SDoc
text String
"Pass argument (size " SDoc -> SDoc -> SDoc
<> Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
w SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
") on the stack: " SDoc -> SDoc -> SDoc
<> Reg -> SDoc
forall a. Outputable a => a -> SDoc
ppr Reg
r) Instr
str
      Bool
-> [Reg]
-> [Reg]
-> [(Reg, Format, ForeignHint, OrdList Instr)]
-> Int
-> [Reg]
-> OrdList Instr
-> NatM (Int, [Reg], OrdList Instr)
passArguments Bool
pack [] [] [(Reg, Format, ForeignHint, OrdList Instr)]
args (Int
stackSpace'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
space) [Reg]
accumRegs (OrdList Instr
stackCode OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
accumCode)
    
    passArguments Bool
pack [] [Reg]
fpRegs ((Reg
r, Format
format, ForeignHint
_hint, OrdList Instr
code_r):[(Reg, Format, ForeignHint, OrdList Instr)]
args) Int
stackSpace [Reg]
accumRegs OrdList Instr
accumCode | Format -> Bool
isIntFormat Format
format = do
      let w :: Width
w = Format -> Width
formatToWidth Format
format
          bytes :: Int
bytes = Width -> Int
widthInBits Width
w Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8
          space :: Int
space = if Bool
pack then Int
bytes else Int
8
          stackSpace' :: Int
stackSpace' | Bool
pack Bool -> Bool -> Bool
&& Int
stackSpace Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
space Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 = Int
stackSpace Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
space Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
stackSpace Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
space)
                      | Bool
otherwise                           = Int
stackSpace
          str :: Instr
str = Format -> Operand -> Operand -> Instr
STR Format
format (Width -> Reg -> Operand
OpReg Width
w Reg
r) (AddrMode -> Operand
OpAddr (Reg -> Imm -> AddrMode
AddrRegImm (Int -> Reg
regSingle Int
31) (Int -> Imm
ImmInt Int
stackSpace')))
          stackCode :: OrdList Instr
stackCode = OrdList Instr
code_r OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
                      SDoc -> Instr -> Instr
ann (String -> SDoc
text String
"Pass argument (size " SDoc -> SDoc -> SDoc
<> Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
w SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
") on the stack: " SDoc -> SDoc -> SDoc
<> Reg -> SDoc
forall a. Outputable a => a -> SDoc
ppr Reg
r) Instr
str
      Bool
-> [Reg]
-> [Reg]
-> [(Reg, Format, ForeignHint, OrdList Instr)]
-> Int
-> [Reg]
-> OrdList Instr
-> NatM (Int, [Reg], OrdList Instr)
passArguments Bool
pack [] [Reg]
fpRegs [(Reg, Format, ForeignHint, OrdList Instr)]
args (Int
stackSpace'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
space) [Reg]
accumRegs (OrdList Instr
stackCode OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
accumCode)
    
    passArguments Bool
pack [Reg]
gpRegs [] ((Reg
r, Format
format, ForeignHint
_hint, OrdList Instr
code_r):[(Reg, Format, ForeignHint, OrdList Instr)]
args) Int
stackSpace [Reg]
accumRegs OrdList Instr
accumCode | Format -> Bool
isFloatFormat Format
format = do
      let w :: Width
w = Format -> Width
formatToWidth Format
format
          bytes :: Int
bytes = Width -> Int
widthInBits Width
w Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8
          space :: Int
space = if Bool
pack then Int
bytes else Int
8
          stackSpace' :: Int
stackSpace' | Bool
pack Bool -> Bool -> Bool
&& Int
stackSpace Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
space Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 = Int
stackSpace Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
space Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
stackSpace Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
space)
                      | Bool
otherwise                           = Int
stackSpace
          str :: Instr
str = Format -> Operand -> Operand -> Instr
STR Format
format (Width -> Reg -> Operand
OpReg Width
w Reg
r) (AddrMode -> Operand
OpAddr (Reg -> Imm -> AddrMode
AddrRegImm (Int -> Reg
regSingle Int
31) (Int -> Imm
ImmInt Int
stackSpace')))
          stackCode :: OrdList Instr
stackCode = OrdList Instr
code_r OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
                      SDoc -> Instr -> Instr
ann (String -> SDoc
text String
"Pass argument (size " SDoc -> SDoc -> SDoc
<> Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
w SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
") on the stack: " SDoc -> SDoc -> SDoc
<> Reg -> SDoc
forall a. Outputable a => a -> SDoc
ppr Reg
r) Instr
str
      Bool
-> [Reg]
-> [Reg]
-> [(Reg, Format, ForeignHint, OrdList Instr)]
-> Int
-> [Reg]
-> OrdList Instr
-> NatM (Int, [Reg], OrdList Instr)
passArguments Bool
pack [Reg]
gpRegs [] [(Reg, Format, ForeignHint, OrdList Instr)]
args (Int
stackSpace'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
space) [Reg]
accumRegs (OrdList Instr
stackCode OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
accumCode)
    passArguments Bool
_ [Reg]
_ [Reg]
_ [(Reg, Format, ForeignHint, OrdList Instr)]
_ Int
_ [Reg]
_ OrdList Instr
_ = String -> SDoc -> NatM (Int, [Reg], OrdList Instr)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"passArguments" (String -> SDoc
text String
"invalid state")
    readResults :: [Reg] -> [Reg] -> [LocalReg] -> [Reg]-> InstrBlock -> NatM ([Reg], InstrBlock)
    readResults :: [Reg]
-> [Reg]
-> [CmmFormal]
-> [Reg]
-> OrdList Instr
-> NatM ([Reg], OrdList Instr)
readResults [Reg]
_ [Reg]
_ [] [Reg]
accumRegs OrdList Instr
accumCode = ([Reg], OrdList Instr) -> NatM ([Reg], OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Reg]
accumRegs, OrdList Instr
accumCode)
    readResults [] [Reg]
_ [CmmFormal]
_ [Reg]
_ OrdList Instr
_ = do
      Platform
platform <- NatM Platform
getPlatform
      String -> SDoc -> NatM ([Reg], OrdList Instr)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"genCCall, out of gp registers when reading results" (Platform -> ForeignTarget -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform ForeignTarget
target)
    readResults [Reg]
_ [] [CmmFormal]
_ [Reg]
_ OrdList Instr
_ = do
      Platform
platform <- NatM Platform
getPlatform
      String -> SDoc -> NatM ([Reg], OrdList Instr)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"genCCall, out of fp registers when reading results" (Platform -> ForeignTarget -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform ForeignTarget
target)
    readResults (Reg
gpReg:[Reg]
gpRegs) (Reg
fpReg:[Reg]
fpRegs) (CmmFormal
dst:[CmmFormal]
dsts) [Reg]
accumRegs OrdList Instr
accumCode = do
      
      Platform
platform <- NatM Platform
getPlatform
      let rep :: CmmType
rep = Platform -> CmmReg -> CmmType
cmmRegType Platform
platform (CmmFormal -> CmmReg
CmmLocal CmmFormal
dst)
          format :: Format
format = CmmType -> Format
cmmTypeFormat CmmType
rep
          w :: Width
w   = Platform -> CmmReg -> Width
cmmRegWidth Platform
platform (CmmFormal -> CmmReg
CmmLocal CmmFormal
dst)
          r_dst :: Reg
r_dst = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform (CmmFormal -> CmmReg
CmmLocal CmmFormal
dst)
      if Format -> Bool
isFloatFormat Format
format
        then [Reg]
-> [Reg]
-> [CmmFormal]
-> [Reg]
-> OrdList Instr
-> NatM ([Reg], OrdList Instr)
readResults (Reg
gpRegReg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
:[Reg]
gpRegs) [Reg]
fpRegs [CmmFormal]
dsts (Reg
fpRegReg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
:[Reg]
accumRegs) (OrdList Instr
accumCode OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Operand -> Operand -> Instr
MOV (Width -> Reg -> Operand
OpReg Width
w Reg
r_dst) (Width -> Reg -> Operand
OpReg Width
w Reg
fpReg))
        else [Reg]
-> [Reg]
-> [CmmFormal]
-> [Reg]
-> OrdList Instr
-> NatM ([Reg], OrdList Instr)
readResults [Reg]
gpRegs (Reg
fpRegReg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
:[Reg]
fpRegs) [CmmFormal]
dsts (Reg
gpRegReg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
:[Reg]
accumRegs) (OrdList Instr
accumCode OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Operand -> Operand -> Instr
MOV (Width -> Reg -> Operand
OpReg Width
w Reg
r_dst) (Width -> Reg -> Operand
OpReg Width
w Reg
gpReg))
    unaryFloatOp :: Width
-> (Operand -> Operand -> OrdList Instr)
-> CmmExpr
-> CmmFormal
-> NatM (OrdList Instr, Maybe a)
unaryFloatOp Width
w Operand -> Operand -> OrdList Instr
op CmmExpr
arg_reg CmmFormal
dest_reg = do
      Platform
platform <- NatM Platform
getPlatform
      (Reg
reg_fx, Format
_format_x, OrdList Instr
code_fx) <- HasCallStack => CmmExpr -> NatM (Reg, Format, OrdList Instr)
CmmExpr -> NatM (Reg, Format, OrdList Instr)
getFloatReg CmmExpr
arg_reg
      let dst :: Reg
dst = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform (CmmFormal -> CmmReg
CmmLocal CmmFormal
dest_reg)
      let code :: OrdList Instr
code = OrdList Instr
code_fx OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Operand -> Operand -> OrdList Instr
op (Width -> Reg -> Operand
OpReg Width
w Reg
dst) (Width -> Reg -> Operand
OpReg Width
w Reg
reg_fx)
      (OrdList Instr, Maybe a) -> NatM (OrdList Instr, Maybe a)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr
code, Maybe a
forall a. Maybe a
Nothing)
data BlockInRange = InRange | NotInRange Target
makeFarBranches :: Platform -> LabelMap RawCmmStatics -> [NatBasicBlock Instr]
                -> UniqSM [NatBasicBlock Instr]
makeFarBranches :: Platform
-> LabelMap RawCmmStatics
-> [NatBasicBlock Instr]
-> UniqSM [NatBasicBlock Instr]
makeFarBranches  Platform
_platform LabelMap RawCmmStatics
statics [NatBasicBlock Instr]
basic_blocks = do
  
  
  let (Int
func_size, LabelMap Int
lblMap) = ((Int, LabelMap Int) -> NatBasicBlock Instr -> (Int, LabelMap Int))
-> (Int, LabelMap Int)
-> [NatBasicBlock Instr]
-> (Int, LabelMap Int)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int, LabelMap Int) -> NatBasicBlock Instr -> (Int, LabelMap Int)
calc_lbl_positions (Int
0, LabelMap Int
forall a. LabelMap a
forall (map :: * -> *) a. IsMap map => map a
mapEmpty) [NatBasicBlock Instr]
basic_blocks
  if Int
func_size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
max_jump_dist
    then [NatBasicBlock Instr] -> UniqSM [NatBasicBlock Instr]
forall a. a -> UniqSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [NatBasicBlock Instr]
basic_blocks
    else do
      (Int
_,[[NatBasicBlock Instr]]
blocks) <- (Int -> NatBasicBlock Instr -> UniqSM (Int, [NatBasicBlock Instr]))
-> Int
-> [NatBasicBlock Instr]
-> UniqSM (Int, [[NatBasicBlock Instr]])
forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM (LabelMap Int
-> Int
-> NatBasicBlock Instr
-> UniqSM (Int, [NatBasicBlock Instr])
replace_blk LabelMap Int
lblMap) Int
0 [NatBasicBlock Instr]
basic_blocks
      [NatBasicBlock Instr] -> UniqSM [NatBasicBlock Instr]
forall a. a -> UniqSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([NatBasicBlock Instr] -> UniqSM [NatBasicBlock Instr])
-> [NatBasicBlock Instr] -> UniqSM [NatBasicBlock Instr]
forall a b. (a -> b) -> a -> b
$ [[NatBasicBlock Instr]] -> [NatBasicBlock Instr]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[NatBasicBlock Instr]]
blocks
      
  where
    
    max_jump_dist :: Int
max_jump_dist = Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
18::Int) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 :: Int
    
    max_info_size :: Int
max_info_size     = Int
16 :: Int
    long_bc_jump_size :: Int
long_bc_jump_size =  Int
3 :: Int
    long_bz_jump_size :: Int
long_bz_jump_size =  Int
4 :: Int
    
    replace_blk :: LabelMap Int -> Int -> GenBasicBlock Instr -> UniqSM (Int, [GenBasicBlock Instr])
    replace_blk :: LabelMap Int
-> Int
-> NatBasicBlock Instr
-> UniqSM (Int, [NatBasicBlock Instr])
replace_blk !LabelMap Int
m !Int
pos (BasicBlock Label
lbl [Instr]
instrs) = do
      
      let !block_pos :: Int
block_pos = Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Label -> Int
infoTblSize_maybe Label
lbl
      (!Int
pos', [[Instr]]
instrs') <- (Int -> Instr -> UniqSM (Int, [Instr]))
-> Int -> [Instr] -> UniqSM (Int, [[Instr]])
forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM (LabelMap Int -> Int -> Instr -> UniqSM (Int, [Instr])
replace_jump LabelMap Int
m) Int
block_pos [Instr]
instrs
      let instrs'' :: [Instr]
instrs'' = [[Instr]] -> [Instr]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Instr]]
instrs'
      
      let ([Instr]
top, [NatBasicBlock Instr]
split_blocks, [GenCmmDecl RawCmmStatics Any Any]
no_data) = (Instr
 -> ([Instr], [NatBasicBlock Instr],
     [GenCmmDecl RawCmmStatics Any Any])
 -> ([Instr], [NatBasicBlock Instr],
     [GenCmmDecl RawCmmStatics Any Any]))
-> ([Instr], [NatBasicBlock Instr],
    [GenCmmDecl RawCmmStatics Any Any])
-> [Instr]
-> ([Instr], [NatBasicBlock Instr],
    [GenCmmDecl RawCmmStatics Any Any])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Instr
-> ([Instr], [NatBasicBlock Instr],
    [GenCmmDecl RawCmmStatics Any Any])
-> ([Instr], [NatBasicBlock Instr],
    [GenCmmDecl RawCmmStatics Any Any])
forall h g.
Instr
-> ([Instr], [NatBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])
-> ([Instr], [NatBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])
mkBlocks ([],[],[]) [Instr]
instrs''
      
      Bool -> SDoc -> UniqSM ()
forall (m :: * -> *).
(HasCallStack, Applicative m) =>
Bool -> SDoc -> m ()
massertPpr ([GenCmmDecl RawCmmStatics Any Any] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenCmmDecl RawCmmStatics Any Any]
no_data) (SDoc -> UniqSM ()) -> SDoc -> UniqSM ()
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"There should be no data in the instruction stream"
      let final_blocks :: [NatBasicBlock Instr]
final_blocks = Label -> [Instr] -> NatBasicBlock Instr
forall i. Label -> [i] -> GenBasicBlock i
BasicBlock Label
lbl [Instr]
top NatBasicBlock Instr
-> [NatBasicBlock Instr] -> [NatBasicBlock Instr]
forall a. a -> [a] -> [a]
: [NatBasicBlock Instr]
split_blocks
      (Int, [NatBasicBlock Instr]) -> UniqSM (Int, [NatBasicBlock Instr])
forall a. a -> UniqSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
pos', [NatBasicBlock Instr]
final_blocks)
    replace_jump :: LabelMap Int -> Int -> Instr -> UniqSM (Int, [Instr])
    replace_jump :: LabelMap Int -> Int -> Instr -> UniqSM (Int, [Instr])
replace_jump !LabelMap Int
m !Int
pos Instr
instr = do
      case Instr
instr of
        ANN SDoc
ann Instr
instr -> do
          (Int
idx,Instr
instr':[Instr]
instrs') <- LabelMap Int -> Int -> Instr -> UniqSM (Int, [Instr])
replace_jump LabelMap Int
m Int
pos Instr
instr
          (Int, [Instr]) -> UniqSM (Int, [Instr])
forall a. a -> UniqSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
idx, SDoc -> Instr -> Instr
ANN SDoc
ann Instr
instr'Instr -> [Instr] -> [Instr]
forall a. a -> [a] -> [a]
:[Instr]
instrs')
        BCOND Cond
cond Target
t
          -> case LabelMap Int -> Target -> Int -> BlockInRange
target_in_range LabelMap Int
m Target
t Int
pos of
              BlockInRange
InRange -> (Int, [Instr]) -> UniqSM (Int, [Instr])
forall a. a -> UniqSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
long_bc_jump_size,[Instr
instr])
              NotInRange Target
far_target -> do
                OrdList Instr
jmp_code <- Cond -> Target -> UniqSM (OrdList Instr)
forall (m :: * -> *).
MonadUnique m =>
Cond -> Target -> m (OrdList Instr)
genCondFarJump Cond
cond Target
far_target
                (Int, [Instr]) -> UniqSM (Int, [Instr])
forall a. a -> UniqSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
long_bc_jump_size, OrdList Instr -> [Instr]
forall a. OrdList a -> [a]
fromOL OrdList Instr
jmp_code)
        CBZ Operand
op Target
t -> Operand -> Target -> Cond -> UniqSM (Int, [Instr])
long_zero_jump Operand
op Target
t Cond
EQ
        CBNZ Operand
op Target
t -> Operand -> Target -> Cond -> UniqSM (Int, [Instr])
long_zero_jump Operand
op Target
t Cond
NE
        Instr
instr
          | Instr -> Bool
isMetaInstr Instr
instr -> (Int, [Instr]) -> UniqSM (Int, [Instr])
forall a. a -> UniqSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
pos,[Instr
instr])
          | Bool
otherwise -> (Int, [Instr]) -> UniqSM (Int, [Instr])
forall a. a -> UniqSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, [Instr
instr])
      where
        
        long_zero_jump :: Operand -> Target -> Cond -> UniqSM (Int, [Instr])
long_zero_jump Operand
op Target
t Cond
cmp_op =
          case LabelMap Int -> Target -> Int -> BlockInRange
target_in_range LabelMap Int
m Target
t Int
pos of
              BlockInRange
InRange -> (Int, [Instr]) -> UniqSM (Int, [Instr])
forall a. a -> UniqSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
long_bz_jump_size,[Instr
instr])
              NotInRange Target
far_target -> do
                OrdList Instr
jmp_code <- Cond -> Target -> UniqSM (OrdList Instr)
forall (m :: * -> *).
MonadUnique m =>
Cond -> Target -> m (OrdList Instr)
genCondFarJump Cond
cmp_op Target
far_target
                
                (Int, [Instr]) -> UniqSM (Int, [Instr])
forall a. a -> UniqSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
long_bz_jump_size, Operand -> Operand -> Instr
CMP Operand
op (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
0)) Instr -> [Instr] -> [Instr]
forall a. a -> [a] -> [a]
: OrdList Instr -> [Instr]
forall a. OrdList a -> [a]
fromOL OrdList Instr
jmp_code)
    target_in_range :: LabelMap Int -> Target -> Int -> BlockInRange
    target_in_range :: LabelMap Int -> Target -> Int -> BlockInRange
target_in_range LabelMap Int
m Target
target Int
src =
      case Target
target of
        (TReg{}) -> BlockInRange
InRange
        (TBlock Label
bid) -> LabelMap Int -> Int -> Label -> BlockInRange
block_in_range LabelMap Int
m Int
src Label
bid
        (TLabel CLabel
clbl)
          | Just Label
bid <- CLabel -> Maybe Label
maybeLocalBlockLabel CLabel
clbl
          -> LabelMap Int -> Int -> Label -> BlockInRange
block_in_range LabelMap Int
m Int
src Label
bid
          | Bool
otherwise
          
          -> BlockInRange
InRange
    block_in_range :: LabelMap Int -> Int -> BlockId -> BlockInRange
    block_in_range :: LabelMap Int -> Int -> Label -> BlockInRange
block_in_range LabelMap Int
m Int
src_pos Label
dest_lbl =
      case KeyOf LabelMap -> LabelMap Int -> Maybe Int
forall a. KeyOf LabelMap -> LabelMap a -> Maybe a
forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup KeyOf LabelMap
Label
dest_lbl LabelMap Int
m of
        Maybe Int
Nothing       ->
          
            Target -> BlockInRange
NotInRange (Label -> Target
TBlock Label
dest_lbl)
        Just Int
dest_pos -> if Int -> Int
forall a. Num a => a -> a
abs (Int
dest_pos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
src_pos) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
max_jump_dist
          then BlockInRange
InRange
          else Target -> BlockInRange
NotInRange (Label -> Target
TBlock Label
dest_lbl)
    calc_lbl_positions :: (Int, LabelMap Int) -> GenBasicBlock Instr -> (Int, LabelMap Int)
    calc_lbl_positions :: (Int, LabelMap Int) -> NatBasicBlock Instr -> (Int, LabelMap Int)
calc_lbl_positions (Int
pos, LabelMap Int
m) (BasicBlock Label
lbl [Instr]
instrs)
      = let !pos' :: Int
pos' = Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Label -> Int
infoTblSize_maybe Label
lbl
        in ((Int, LabelMap Int) -> Instr -> (Int, LabelMap Int))
-> (Int, LabelMap Int) -> [Instr] -> (Int, LabelMap Int)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int, LabelMap Int) -> Instr -> (Int, LabelMap Int)
instr_pos (Int
pos',KeyOf LabelMap -> Int -> LabelMap Int -> LabelMap Int
forall a. KeyOf LabelMap -> a -> LabelMap a -> LabelMap a
forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> a -> map a -> map a
mapInsert KeyOf LabelMap
Label
lbl Int
pos' LabelMap Int
m) [Instr]
instrs
    instr_pos :: (Int, LabelMap Int) -> Instr -> (Int, LabelMap Int)
    instr_pos :: (Int, LabelMap Int) -> Instr -> (Int, LabelMap Int)
instr_pos (Int
pos, LabelMap Int
m) Instr
instr =
      case Instr
instr of
        ANN SDoc
_ann Instr
instr -> (Int, LabelMap Int) -> Instr -> (Int, LabelMap Int)
instr_pos (Int
pos, LabelMap Int
m) Instr
instr
        NEWBLOCK Label
_bid -> String -> (Int, LabelMap Int)
forall a. String -> a
panic String
"mkFarBranched - unexpected NEWBLOCK" 
                                                                     
                                                                     
        COMMENT{} -> (Int
pos, LabelMap Int
m)
        Instr
instr
          | Just Int
jump_size <- Instr -> Maybe Int
is_expandable_jump Instr
instr -> (Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
jump_size, LabelMap Int
m)
          | Bool
otherwise -> (Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, LabelMap Int
m)
    infoTblSize_maybe :: Label -> Int
infoTblSize_maybe Label
bid =
      case KeyOf LabelMap -> LabelMap RawCmmStatics -> Maybe RawCmmStatics
forall a. KeyOf LabelMap -> LabelMap a -> Maybe a
forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup KeyOf LabelMap
Label
bid LabelMap RawCmmStatics
statics of
        Maybe RawCmmStatics
Nothing           -> Int
0 :: Int
        Just RawCmmStatics
_info_static -> Int
max_info_size
    
    
    
    is_expandable_jump :: Instr -> Maybe Int
is_expandable_jump Instr
i = case Instr
i of
      CBZ{}   -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
long_bz_jump_size
      CBNZ{}  -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
long_bz_jump_size
      BCOND{} -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
long_bc_jump_size
      Instr
_ -> Maybe Int
forall a. Maybe a
Nothing