{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
module GHC.CmmToC
( cmmToC
)
where
import GHC.Prelude
import GHC.Platform
import GHC.CmmToAsm.CPrim
import GHC.Cmm.BlockId
import GHC.Cmm.CLabel
import GHC.Cmm hiding (pprBBlock, pprStatic)
import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Collections
import GHC.Cmm.Dataflow.Graph
import GHC.Cmm.Utils
import GHC.Cmm.Switch
import GHC.Cmm.InitFini
import GHC.Types.ForeignCall
import GHC.Types.Unique.Set
import GHC.Types.Unique.FM
import GHC.Types.Unique
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Monad.State.Strict (State (..), runState, state)
import GHC.Utils.Misc
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Char
import Data.List (intersperse)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Map (Map)
import qualified Data.Map as Map
import GHC.Float
cmmToC :: Platform -> RawCmmGroup -> SDoc
cmmToC :: Platform -> RawCmmGroup -> SDoc
cmmToC Platform
platform RawCmmGroup
tops = (forall doc. IsDoc doc => [doc] -> doc
vcat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse SDoc
blankLine forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Platform -> RawCmmDecl -> SDoc
pprTop Platform
platform) RawCmmGroup
tops) forall doc. IsDoc doc => doc -> doc -> doc
$$ SDoc
blankLine
pprTop :: Platform -> RawCmmDecl -> SDoc
pprTop :: Platform -> RawCmmDecl -> SDoc
pprTop Platform
platform = \case
(CmmProc LabelMap RawCmmStatics
infos CLabel
clbl [GlobalReg]
_in_live_regs CmmGraph
graph) ->
(case forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup (forall (n :: Extensibility -> Extensibility -> *).
GenCmmGraph n -> BlockId
g_entry CmmGraph
graph) LabelMap RawCmmStatics
infos of
Maybe RawCmmStatics
Nothing -> forall doc. IsOutput doc => doc
empty
Just (CmmStaticsRaw CLabel
info_clbl [CmmStatic]
info_dat) ->
Platform -> [CmmStatic] -> SDoc
pprDataExterns Platform
platform [CmmStatic]
info_dat forall doc. IsDoc doc => doc -> doc -> doc
$$
Platform -> Bool -> CLabel -> [CmmStatic] -> SDoc
pprWordArray Platform
platform Bool
info_is_in_rodata CLabel
info_clbl [CmmStatic]
info_dat) forall doc. IsDoc doc => doc -> doc -> doc
$$
(forall doc. IsDoc doc => [doc] -> doc
vcat [
SDoc
blankLine,
SDoc
extern_decls,
(if (CLabel -> Bool
externallyVisibleCLabel CLabel
clbl)
then SDoc -> SDoc
mkFN_ else SDoc -> SDoc
mkIF_) (forall doc. IsLine doc => Platform -> CLabel -> doc
pprCLabel Platform
platform CLabel
clbl) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => doc
lbrace,
Int -> SDoc -> SDoc
nest Int
8 SDoc
temp_decls,
forall doc. IsDoc doc => [doc] -> doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CmmBlock -> SDoc
pprBBlock Platform
platform) [CmmBlock]
blocks),
forall doc. IsLine doc => doc
rbrace ]
)
where
info_is_in_rodata :: Bool
info_is_in_rodata = Bool
True
blocks :: [CmmBlock]
blocks = CmmGraph -> [CmmBlock]
toBlockListEntryFirst CmmGraph
graph
(SDoc
temp_decls, SDoc
extern_decls) = Platform -> [CmmBlock] -> (SDoc, SDoc)
pprTempAndExternDecls Platform
platform [CmmBlock]
blocks
RawCmmDecl
cmm_data | Just (InitOrFini
initOrFini, [CLabel]
clbls) <- RawCmmDecl -> Maybe (InitOrFini, [CLabel])
isInitOrFiniArray RawCmmDecl
cmm_data ->
Platform -> InitOrFini -> [CLabel] -> SDoc
pprCtorArray Platform
platform InitOrFini
initOrFini [CLabel]
clbls
(CmmData Section
section (CmmStaticsRaw CLabel
lbl [CmmString ByteString
str])) ->
Platform -> CLabel -> SDoc
pprExternDecl Platform
platform CLabel
lbl forall doc. IsDoc doc => doc -> doc -> doc
$$
forall doc. IsLine doc => [doc] -> doc
hcat [
CLabel -> SDoc
pprLocalness CLabel
lbl, Bool -> SDoc
pprConstness (Section -> Bool
isSecConstant Section
section), forall doc. IsLine doc => String -> doc
text String
"char ", forall doc. IsLine doc => Platform -> CLabel -> doc
pprCLabel Platform
platform CLabel
lbl,
forall doc. IsLine doc => String -> doc
text String
"[] = ", ByteString -> SDoc
pprStringInCStyle ByteString
str, forall doc. IsLine doc => doc
semi
]
(CmmData Section
section (CmmStaticsRaw CLabel
lbl [CmmUninitialised Int
size])) ->
Platform -> CLabel -> SDoc
pprExternDecl Platform
platform CLabel
lbl forall doc. IsDoc doc => doc -> doc -> doc
$$
forall doc. IsLine doc => [doc] -> doc
hcat [
CLabel -> SDoc
pprLocalness CLabel
lbl, Bool -> SDoc
pprConstness (Section -> Bool
isSecConstant Section
section), forall doc. IsLine doc => String -> doc
text String
"char ", forall doc. IsLine doc => Platform -> CLabel -> doc
pprCLabel Platform
platform CLabel
lbl,
forall doc. IsLine doc => doc -> doc
brackets (forall doc. IsLine doc => Int -> doc
int Int
size), forall doc. IsLine doc => doc
semi
]
(CmmData Section
section (CmmStaticsRaw CLabel
lbl [CmmStatic]
lits)) ->
Platform -> [CmmStatic] -> SDoc
pprDataExterns Platform
platform [CmmStatic]
lits forall doc. IsDoc doc => doc -> doc -> doc
$$
Platform -> Bool -> CLabel -> [CmmStatic] -> SDoc
pprWordArray Platform
platform (Section -> Bool
isSecConstant Section
section) CLabel
lbl [CmmStatic]
lits
where
isSecConstant :: Section -> Bool
isSecConstant Section
section = case Section -> SectionProtection
sectionProtection Section
section of
SectionProtection
ReadOnlySection -> Bool
True
SectionProtection
WriteProtectedSection -> Bool
True
SectionProtection
_ -> Bool
False
pprBBlock :: Platform -> CmmBlock -> SDoc
pprBBlock :: Platform -> CmmBlock -> SDoc
pprBBlock Platform
platform CmmBlock
block =
Int -> SDoc -> SDoc
nest Int
4 (BlockId -> SDoc
pprBlockId (forall (thing :: Extensibility -> Extensibility -> *)
(x :: Extensibility).
NonLocal thing =>
thing C x -> BlockId
entryLabel CmmBlock
block) forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon) forall doc. IsDoc doc => doc -> doc -> doc
$$
Int -> SDoc -> SDoc
nest Int
8 (forall doc. IsDoc doc => [doc] -> doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (forall (e :: Extensibility) (x :: Extensibility).
Platform -> CmmNode e x -> SDoc
pprStmt Platform
platform) (forall (n :: Extensibility -> Extensibility -> *).
Block n O O -> [n O O]
blockToList Block CmmNode O O
nodes)) forall doc. IsDoc doc => doc -> doc -> doc
$$ forall (e :: Extensibility) (x :: Extensibility).
Platform -> CmmNode e x -> SDoc
pprStmt Platform
platform CmmNode O C
last)
where
(CmmNode C O
_, Block CmmNode O O
nodes, CmmNode O C
last) = forall (n :: Extensibility -> Extensibility -> *).
Block n C C -> (n C O, Block n O O, n O C)
blockSplit CmmBlock
block
pprWordArray :: Platform -> Bool -> CLabel -> [CmmStatic] -> SDoc
pprWordArray :: Platform -> Bool -> CLabel -> [CmmStatic] -> SDoc
pprWordArray Platform
platform Bool
is_ro CLabel
lbl [CmmStatic]
ds
=
Platform -> CLabel -> SDoc
pprExternDecl Platform
platform CLabel
lbl forall doc. IsDoc doc => doc -> doc -> doc
$$
forall doc. IsLine doc => [doc] -> doc
hcat [ CLabel -> SDoc
pprLocalness CLabel
lbl, Bool -> SDoc
pprConstness Bool
is_ro, forall doc. IsLine doc => String -> doc
text String
"StgWord"
, forall doc. IsLine doc => doc
space, forall doc. IsLine doc => Platform -> CLabel -> doc
pprCLabel Platform
platform CLabel
lbl, forall doc. IsLine doc => String -> doc
text String
"[]"
, Width -> SDoc
pprAlignment (Platform -> Width
wordWidth Platform
platform)
, forall doc. IsLine doc => String -> doc
text String
"= {" ]
forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
8 ([SDoc] -> SDoc
commafy (Platform -> [CmmLit] -> [SDoc]
staticLitsToWords Platform
platform forall a b. (a -> b) -> a -> b
$ [CmmStatic] -> [CmmLit]
toLits [CmmStatic]
ds))
forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsLine doc => String -> doc
text String
"};"
where
toLits :: [CmmStatic] -> [CmmLit]
toLits :: [CmmStatic] -> [CmmLit]
toLits = forall a b. (a -> b) -> [a] -> [b]
map CmmStatic -> CmmLit
f
where
f :: CmmStatic -> CmmLit
f (CmmStaticLit CmmLit
lit) = CmmLit
lit
f CmmStatic
static = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"pprWordArray: Unexpected literal" (Platform -> CmmStatic -> SDoc
pprStatic Platform
platform CmmStatic
static)
pprAlignment :: Width -> SDoc
pprAlignment :: Width -> SDoc
pprAlignment Width
words =
forall doc. IsLine doc => String -> doc
text String
"__attribute__((aligned(" forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Int -> doc
int (Width -> Int
widthInBytes Width
words) forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
")))"
pprLocalness :: CLabel -> SDoc
pprLocalness :: CLabel -> SDoc
pprLocalness CLabel
lbl | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ CLabel -> Bool
externallyVisibleCLabel CLabel
lbl = forall doc. IsLine doc => String -> doc
text String
"static "
| Bool
otherwise = forall doc. IsOutput doc => doc
empty
pprConstness :: Bool -> SDoc
pprConstness :: Bool -> SDoc
pprConstness Bool
is_ro | Bool
is_ro = forall doc. IsLine doc => String -> doc
text String
"const "
| Bool
otherwise = forall doc. IsOutput doc => doc
empty
pprStmt :: Platform -> CmmNode e x -> SDoc
pprStmt :: forall (e :: Extensibility) (x :: Extensibility).
Platform -> CmmNode e x -> SDoc
pprStmt Platform
platform CmmNode e x
stmt =
case CmmNode e x
stmt of
CmmEntry{} -> forall doc. IsOutput doc => doc
empty
CmmComment FastString
_ -> forall doc. IsOutput doc => doc
empty
CmmTick CmmTickish
_ -> forall doc. IsOutput doc => doc
empty
CmmUnwind{} -> forall doc. IsOutput doc => doc
empty
CmmAssign CmmReg
dest CmmExpr
src -> Platform -> CmmReg -> CmmExpr -> SDoc
pprAssign Platform
platform CmmReg
dest CmmExpr
src
CmmStore CmmExpr
dest CmmExpr
src AlignmentSpec
align
| CmmType -> Width
typeWidth CmmType
rep forall a. Eq a => a -> a -> Bool
== Width
W64 Bool -> Bool -> Bool
&& Platform -> Width
wordWidth Platform
platform forall a. Eq a => a -> a -> Bool
/= Width
W64
-> (if CmmType -> Bool
isFloatType CmmType
rep then forall doc. IsLine doc => String -> doc
text String
"ASSIGN_DBL"
else forall doc. IsLine doc => String -> doc
text String
"ASSIGN_Word64") forall doc. IsLine doc => doc -> doc -> doc
<>
forall doc. IsLine doc => doc -> doc
parens (SDoc
mkP_ forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> CmmExpr -> SDoc
pprExpr1 Platform
platform CmmExpr
dest forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> CmmExpr -> SDoc
pprExpr Platform
platform CmmExpr
src) forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
semi
| Bool
otherwise
-> forall doc. IsLine doc => [doc] -> doc
hsep [ Platform -> CmmExpr -> SDoc
pprExpr Platform
platform (CmmExpr -> CmmType -> AlignmentSpec -> CmmExpr
CmmLoad CmmExpr
dest CmmType
rep AlignmentSpec
align), forall doc. IsLine doc => doc
equals, Platform -> CmmExpr -> SDoc
pprExpr Platform
platform CmmExpr
src forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
semi ]
where
rep :: CmmType
rep = Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
src
CmmUnsafeForeignCall target :: ForeignTarget
target@(ForeignTarget CmmExpr
fn ForeignConvention
conv) [LocalReg]
results [CmmExpr]
args ->
SDoc
fnCall
where
([ForeignHint]
res_hints, [ForeignHint]
arg_hints) = ForeignTarget -> ([ForeignHint], [ForeignHint])
foreignTargetHints ForeignTarget
target
hresults :: [(LocalReg, ForeignHint)]
hresults = forall a b. [a] -> [b] -> [(a, b)]
zip [LocalReg]
results [ForeignHint]
res_hints
hargs :: [(CmmExpr, ForeignHint)]
hargs = forall a b. [a] -> [b] -> [(a, b)]
zip [CmmExpr]
args [ForeignHint]
arg_hints
ForeignConvention CCallConv
cconv [ForeignHint]
_ [ForeignHint]
_ CmmReturnInfo
ret = ForeignConvention
conv
cast_fn :: SDoc
cast_fn = forall doc. IsLine doc => doc -> doc
parens (Platform -> SDoc -> CmmExpr -> SDoc
cCast Platform
platform (Platform
-> SDoc
-> CCallConv
-> [(LocalReg, ForeignHint)]
-> [(CmmExpr, ForeignHint)]
-> SDoc
pprCFunType Platform
platform (forall doc. IsLine doc => Char -> doc
char Char
'*') CCallConv
cconv [(LocalReg, ForeignHint)]
hresults [(CmmExpr, ForeignHint)]
hargs) CmmExpr
fn)
fnCall :: SDoc
fnCall =
case CmmExpr
fn of
CmmLit (CmmLabel CLabel
lbl)
| CCallConv
StdCallConv <- CCallConv
cconv ->
Platform
-> SDoc
-> CCallConv
-> [(LocalReg, ForeignHint)]
-> [(CmmExpr, ForeignHint)]
-> SDoc
pprCall Platform
platform (forall doc. IsLine doc => Platform -> CLabel -> doc
pprCLabel Platform
platform CLabel
lbl) CCallConv
cconv [(LocalReg, ForeignHint)]
hresults [(CmmExpr, ForeignHint)]
hargs
| CmmReturnInfo
CmmNeverReturns <- CmmReturnInfo
ret ->
Platform
-> SDoc
-> CCallConv
-> [(LocalReg, ForeignHint)]
-> [(CmmExpr, ForeignHint)]
-> SDoc
pprCall Platform
platform SDoc
cast_fn CCallConv
cconv [(LocalReg, ForeignHint)]
hresults [(CmmExpr, ForeignHint)]
hargs forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
semi forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
"__builtin_unreachable();"
| Bool -> Bool
not (CLabel -> Bool
isMathFun CLabel
lbl) ->
Platform
-> SDoc
-> CCallConv
-> [(LocalReg, ForeignHint)]
-> [(CmmExpr, ForeignHint)]
-> SDoc
pprForeignCall Platform
platform (forall doc. IsLine doc => Platform -> CLabel -> doc
pprCLabel Platform
platform CLabel
lbl) CCallConv
cconv [(LocalReg, ForeignHint)]
hresults [(CmmExpr, ForeignHint)]
hargs
CmmExpr
_ ->
Platform
-> SDoc
-> CCallConv
-> [(LocalReg, ForeignHint)]
-> [(CmmExpr, ForeignHint)]
-> SDoc
pprCall Platform
platform SDoc
cast_fn CCallConv
cconv [(LocalReg, ForeignHint)]
hresults [(CmmExpr, ForeignHint)]
hargs forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
semi
CmmUnsafeForeignCall (PrimTarget CallishMachOp
MO_Touch) [LocalReg]
_results [CmmExpr]
_args -> forall doc. IsOutput doc => doc
empty
CmmUnsafeForeignCall (PrimTarget (MO_Prefetch_Data Int
_)) [LocalReg]
_results [CmmExpr]
_args -> forall doc. IsOutput doc => doc
empty
CmmUnsafeForeignCall target :: ForeignTarget
target@(PrimTarget CallishMachOp
op) [LocalReg]
results [CmmExpr]
args ->
SDoc
fn_call
where
cconv :: CCallConv
cconv = CCallConv
CCallConv
fn :: SDoc
fn = CallishMachOp -> SDoc
pprCallishMachOp_for_C CallishMachOp
op
([ForeignHint]
res_hints, [ForeignHint]
arg_hints) = ForeignTarget -> ([ForeignHint], [ForeignHint])
foreignTargetHints ForeignTarget
target
hresults :: [(LocalReg, ForeignHint)]
hresults = forall a b. [a] -> [b] -> [(a, b)]
zip [LocalReg]
results [ForeignHint]
res_hints
hargs :: [(CmmExpr, ForeignHint)]
hargs = forall a b. [a] -> [b] -> [(a, b)]
zip [CmmExpr]
args [ForeignHint]
arg_hints
need_cdecl :: Bool
need_cdecl
| CallishMachOp
MO_ResumeThread <- CallishMachOp
op = Bool
True
| CallishMachOp
MO_SuspendThread <- CallishMachOp
op = Bool
True
| Bool
otherwise = Bool
False
fn_call :: SDoc
fn_call
| Bool
need_cdecl
= (forall doc. IsLine doc => String -> doc
text String
";EFF_(" forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
fn forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Char -> doc
char Char
')' forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
semi) forall doc. IsDoc doc => doc -> doc -> doc
$$
Platform
-> SDoc
-> CCallConv
-> [(LocalReg, ForeignHint)]
-> [(CmmExpr, ForeignHint)]
-> SDoc
pprForeignCall Platform
platform SDoc
fn CCallConv
cconv [(LocalReg, ForeignHint)]
hresults [(CmmExpr, ForeignHint)]
hargs
| Bool
otherwise
= Platform
-> SDoc
-> CCallConv
-> [(LocalReg, ForeignHint)]
-> [(CmmExpr, ForeignHint)]
-> SDoc
pprCall Platform
platform SDoc
fn CCallConv
cconv [(LocalReg, ForeignHint)]
hresults [(CmmExpr, ForeignHint)]
hargs
CmmBranch BlockId
ident -> BlockId -> SDoc
pprBranch BlockId
ident
CmmCondBranch CmmExpr
expr BlockId
yes BlockId
no Maybe Bool
_ -> Platform -> CmmExpr -> BlockId -> BlockId -> SDoc
pprCondBranch Platform
platform CmmExpr
expr BlockId
yes BlockId
no
CmmCall { cml_target :: CmmNode O C -> CmmExpr
cml_target = CmmExpr
expr } -> SDoc -> SDoc
mkJMP_ (Platform -> CmmExpr -> SDoc
pprExpr Platform
platform CmmExpr
expr) forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
semi
CmmSwitch CmmExpr
arg SwitchTargets
ids -> Platform -> CmmExpr -> SwitchTargets -> SDoc
pprSwitch Platform
platform CmmExpr
arg SwitchTargets
ids
CmmNode e x
_other -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"PprC.pprStmt" (forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmNode e x
stmt)
type Hinted a = (a, ForeignHint)
pprForeignCall :: Platform -> SDoc -> CCallConv -> [Hinted CmmFormal] -> [Hinted CmmActual]
-> SDoc
pprForeignCall :: Platform
-> SDoc
-> CCallConv
-> [(LocalReg, ForeignHint)]
-> [(CmmExpr, ForeignHint)]
-> SDoc
pprForeignCall Platform
platform SDoc
fn CCallConv
cconv [(LocalReg, ForeignHint)]
results [(CmmExpr, ForeignHint)]
args = SDoc
fn_call
where
fn_call :: SDoc
fn_call = forall doc. IsLine doc => doc -> doc
braces (
Platform
-> SDoc
-> CCallConv
-> [(LocalReg, ForeignHint)]
-> [(CmmExpr, ForeignHint)]
-> SDoc
pprCFunType Platform
platform (forall doc. IsLine doc => Char -> doc
char Char
'*' forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
"ghcFunPtr") CCallConv
cconv [(LocalReg, ForeignHint)]
results [(CmmExpr, ForeignHint)]
args forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
semi
forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsLine doc => String -> doc
text String
"ghcFunPtr" forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => doc
equals forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
cast_fn forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
semi
forall doc. IsDoc doc => doc -> doc -> doc
$$ Platform
-> SDoc
-> CCallConv
-> [(LocalReg, ForeignHint)]
-> [(CmmExpr, ForeignHint)]
-> SDoc
pprCall Platform
platform (forall doc. IsLine doc => String -> doc
text String
"ghcFunPtr") CCallConv
cconv [(LocalReg, ForeignHint)]
results [(CmmExpr, ForeignHint)]
args forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
semi
)
cast_fn :: SDoc
cast_fn = forall doc. IsLine doc => doc -> doc
parens (forall doc. IsLine doc => doc -> doc
parens (Platform
-> SDoc
-> CCallConv
-> [(LocalReg, ForeignHint)]
-> [(CmmExpr, ForeignHint)]
-> SDoc
pprCFunType Platform
platform (forall doc. IsLine doc => Char -> doc
char Char
'*') CCallConv
cconv [(LocalReg, ForeignHint)]
results [(CmmExpr, ForeignHint)]
args) forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
fn)
pprCFunType :: Platform -> SDoc -> CCallConv -> [Hinted CmmFormal] -> [Hinted CmmActual] -> SDoc
pprCFunType :: Platform
-> SDoc
-> CCallConv
-> [(LocalReg, ForeignHint)]
-> [(CmmExpr, ForeignHint)]
-> SDoc
pprCFunType Platform
platform SDoc
ppr_fn CCallConv
cconv [(LocalReg, ForeignHint)]
ress [(CmmExpr, ForeignHint)]
args
= let res_type :: [(LocalReg, ForeignHint)] -> SDoc
res_type [] = forall doc. IsLine doc => String -> doc
text String
"void"
res_type [(LocalReg
one, ForeignHint
hint)] = Platform -> CmmType -> ForeignHint -> SDoc
machRepHintCType Platform
platform (LocalReg -> CmmType
localRegType LocalReg
one) ForeignHint
hint
res_type [(LocalReg, ForeignHint)]
_ = forall a. HasCallStack => String -> a
panic String
"pprCFunType: only void or 1 return value supported"
arg_type :: (CmmExpr, ForeignHint) -> SDoc
arg_type (CmmExpr
expr, ForeignHint
hint) = Platform -> CmmType -> ForeignHint -> SDoc
machRepHintCType Platform
platform (Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
expr) ForeignHint
hint
in [(LocalReg, ForeignHint)] -> SDoc
res_type [(LocalReg, ForeignHint)]
ress forall doc. IsLine doc => doc -> doc -> doc
<+>
forall doc. IsLine doc => doc -> doc
parens (CCallConv -> SDoc
ccallConvAttribute CCallConv
cconv forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
ppr_fn) forall doc. IsLine doc => doc -> doc -> doc
<>
forall doc. IsLine doc => doc -> doc
parens ([SDoc] -> SDoc
commafy (forall a b. (a -> b) -> [a] -> [b]
map (CmmExpr, ForeignHint) -> SDoc
arg_type [(CmmExpr, ForeignHint)]
args))
pprBranch :: BlockId -> SDoc
pprBranch :: BlockId -> SDoc
pprBranch BlockId
ident = forall doc. IsLine doc => String -> doc
text String
"goto" forall doc. IsLine doc => doc -> doc -> doc
<+> BlockId -> SDoc
pprBlockId BlockId
ident forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
semi
pprCondBranch :: Platform -> CmmExpr -> BlockId -> BlockId -> SDoc
pprCondBranch :: Platform -> CmmExpr -> BlockId -> BlockId -> SDoc
pprCondBranch Platform
platform CmmExpr
expr BlockId
yes BlockId
no
= forall doc. IsLine doc => [doc] -> doc
hsep [ forall doc. IsLine doc => String -> doc
text String
"if" , forall doc. IsLine doc => doc -> doc
parens (Platform -> CmmExpr -> SDoc
pprExpr Platform
platform CmmExpr
expr) ,
forall doc. IsLine doc => String -> doc
text String
"goto", BlockId -> SDoc
pprBlockId BlockId
yes forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
semi,
forall doc. IsLine doc => String -> doc
text String
"else goto", BlockId -> SDoc
pprBlockId BlockId
no forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
semi ]
pprSwitch :: Platform -> CmmExpr -> SwitchTargets -> SDoc
pprSwitch :: Platform -> CmmExpr -> SwitchTargets -> SDoc
pprSwitch Platform
platform CmmExpr
e SwitchTargets
ids
= (SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => String -> doc
text String
"switch" forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => doc -> doc
parens ( Platform -> CmmExpr -> SDoc
pprExpr Platform
platform CmmExpr
e ) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => doc
lbrace)
Int
4 (forall doc. IsDoc doc => [doc] -> doc
vcat ( forall a b. (a -> b) -> [a] -> [b]
map (NonEmpty Integer, BlockId) -> SDoc
caseify [(NonEmpty Integer, BlockId)]
pairs ) forall doc. IsDoc doc => doc -> doc -> doc
$$ SDoc
def)) forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsLine doc => doc
rbrace
where
([(NonEmpty Integer, BlockId)]
pairs, Maybe BlockId
mbdef) = SwitchTargets -> ([(NonEmpty Integer, BlockId)], Maybe BlockId)
switchTargetsFallThrough SwitchTargets
ids
rep :: Width
rep = CmmType -> Width
typeWidth (Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
e)
caseify :: (NonEmpty Integer, BlockId) -> SDoc
caseify (Integer
ix:|[Integer]
ixs, BlockId
ident) = forall doc. IsDoc doc => [doc] -> doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map Integer -> SDoc
do_fallthrough [Integer]
ixs) forall doc. IsDoc doc => doc -> doc -> doc
$$ Integer -> SDoc
final_branch Integer
ix
where
do_fallthrough :: Integer -> SDoc
do_fallthrough Integer
ix =
forall doc. IsLine doc => [doc] -> doc
hsep [ forall doc. IsLine doc => String -> doc
text String
"case" , Platform -> Integer -> Width -> SDoc
pprHexVal Platform
platform Integer
ix Width
rep forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon ,
forall doc. IsLine doc => String -> doc
text String
"/* fall through */" ]
final_branch :: Integer -> SDoc
final_branch Integer
ix =
forall doc. IsLine doc => [doc] -> doc
hsep [ forall doc. IsLine doc => String -> doc
text String
"case" , Platform -> Integer -> Width -> SDoc
pprHexVal Platform
platform Integer
ix Width
rep forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon ,
forall doc. IsLine doc => String -> doc
text String
"goto" , (BlockId -> SDoc
pprBlockId BlockId
ident) forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
semi ]
def :: SDoc
def | Just BlockId
l <- Maybe BlockId
mbdef = forall doc. IsLine doc => String -> doc
text String
"default: goto" forall doc. IsLine doc => doc -> doc -> doc
<+> BlockId -> SDoc
pprBlockId BlockId
l forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
semi
| Bool
otherwise = forall doc. IsLine doc => String -> doc
text String
"default: __builtin_unreachable();"
pprExpr :: Platform -> CmmExpr -> SDoc
pprExpr :: Platform -> CmmExpr -> SDoc
pprExpr Platform
platform CmmExpr
e = case CmmExpr
e of
CmmLit CmmLit
lit -> Platform -> CmmLit -> SDoc
pprLit Platform
platform CmmLit
lit
CmmLoad CmmExpr
e CmmType
ty AlignmentSpec
align -> Platform -> CmmExpr -> CmmType -> AlignmentSpec -> SDoc
pprLoad Platform
platform CmmExpr
e CmmType
ty AlignmentSpec
align
CmmReg CmmReg
reg -> CmmReg -> SDoc
pprCastReg CmmReg
reg
CmmRegOff CmmReg
reg Int
0 -> CmmReg -> SDoc
pprCastReg CmmReg
reg
CmmRegOff CmmReg
reg Int
i -> Platform -> CmmExpr -> SDoc
pprExpr Platform
platform forall a b. (a -> b) -> a -> b
$ MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Add Width
w) [CmmReg -> CmmExpr
CmmReg CmmReg
reg, CmmLit -> CmmExpr
CmmLit forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt (forall a. Integral a => a -> Integer
toInteger Int
i) Width
w]
where w :: Width
w = Platform -> CmmReg -> Width
cmmRegWidth Platform
platform CmmReg
reg
CmmMachOp MachOp
mop [CmmExpr]
args -> Platform -> MachOp -> [CmmExpr] -> SDoc
pprMachOpApp Platform
platform MachOp
mop [CmmExpr]
args
CmmStackSlot Area
_ Int
_ -> forall a. HasCallStack => String -> a
panic String
"pprExpr: CmmStackSlot not supported!"
pprLoad :: Platform -> CmmExpr -> CmmType -> AlignmentSpec -> SDoc
pprLoad :: Platform -> CmmExpr -> CmmType -> AlignmentSpec -> SDoc
pprLoad Platform
platform CmmExpr
e CmmType
ty AlignmentSpec
_align
| Width
width forall a. Eq a => a -> a -> Bool
== Width
W64, Platform -> Width
wordWidth Platform
platform forall a. Eq a => a -> a -> Bool
/= Width
W64
= (if CmmType -> Bool
isFloatType CmmType
ty then forall doc. IsLine doc => String -> doc
text String
"PK_DBL"
else forall doc. IsLine doc => String -> doc
text String
"PK_Word64")
forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc -> doc
parens (SDoc
mkP_ forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> CmmExpr -> SDoc
pprExpr1 Platform
platform CmmExpr
e)
| Bool
otherwise
= case CmmExpr
e of
CmmReg CmmReg
r | CmmReg -> Bool
isPtrReg CmmReg
r Bool -> Bool -> Bool
&& Width
width forall a. Eq a => a -> a -> Bool
== Platform -> Width
wordWidth Platform
platform Bool -> Bool -> Bool
&& Bool -> Bool
not (CmmType -> Bool
isFloatType CmmType
ty)
-> forall doc. IsLine doc => Char -> doc
char Char
'*' forall doc. IsLine doc => doc -> doc -> doc
<> CmmReg -> SDoc
pprAsPtrReg CmmReg
r
CmmRegOff CmmReg
r Int
0 | CmmReg -> Bool
isPtrReg CmmReg
r Bool -> Bool -> Bool
&& Width
width forall a. Eq a => a -> a -> Bool
== Platform -> Width
wordWidth Platform
platform Bool -> Bool -> Bool
&& Bool -> Bool
not (CmmType -> Bool
isFloatType CmmType
ty)
-> forall doc. IsLine doc => Char -> doc
char Char
'*' forall doc. IsLine doc => doc -> doc -> doc
<> CmmReg -> SDoc
pprAsPtrReg CmmReg
r
CmmRegOff CmmReg
r Int
off | CmmReg -> Bool
isPtrReg CmmReg
r Bool -> Bool -> Bool
&& Width
width forall a. Eq a => a -> a -> Bool
== Platform -> Width
wordWidth Platform
platform
, Int
off forall a. Integral a => a -> a -> a
`rem` Platform -> Int
platformWordSizeInBytes Platform
platform forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Bool -> Bool
not (CmmType -> Bool
isFloatType CmmType
ty)
-> CmmReg -> SDoc
pprAsPtrReg CmmReg
r forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc -> doc
brackets (forall a. Outputable a => a -> SDoc
ppr (Int
off forall a. Bits a => a -> Int -> a
`shiftR` Platform -> Int
wordShift Platform
platform))
CmmExpr
_other -> Platform -> CmmExpr -> CmmType -> SDoc
cLoad Platform
platform CmmExpr
e CmmType
ty
where
width :: Width
width = CmmType -> Width
typeWidth CmmType
ty
pprExpr1 :: Platform -> CmmExpr -> SDoc
pprExpr1 :: Platform -> CmmExpr -> SDoc
pprExpr1 Platform
platform CmmExpr
e = case CmmExpr
e of
CmmLit CmmLit
lit -> Platform -> CmmLit -> SDoc
pprLit1 Platform
platform CmmLit
lit
CmmReg CmmReg
_reg -> Platform -> CmmExpr -> SDoc
pprExpr Platform
platform CmmExpr
e
CmmExpr
_ -> forall doc. IsLine doc => doc -> doc
parens (Platform -> CmmExpr -> SDoc
pprExpr Platform
platform CmmExpr
e)
pprMachOpApp :: Platform -> MachOp -> [CmmExpr] -> SDoc
pprMachOpApp :: Platform -> MachOp -> [CmmExpr] -> SDoc
pprMachOpApp Platform
platform MachOp
op [CmmExpr]
args
| MachOp -> Bool
isMulMayOfloOp MachOp
op
= forall doc. IsLine doc => String -> doc
text String
"mulIntMayOflo" forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc -> doc
parens ([SDoc] -> SDoc
commafy (forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CmmExpr -> SDoc
pprExpr Platform
platform) [CmmExpr]
args))
where isMulMayOfloOp :: MachOp -> Bool
isMulMayOfloOp (MO_S_MulMayOflo Width
_) = Bool
True
isMulMayOfloOp MachOp
_ = Bool
False
pprMachOpApp Platform
platform MachOp
mop [CmmExpr]
args
| Just SDoc
ty <- Platform -> MachOp -> [CmmType] -> Maybe SDoc
machOpNeedsCast Platform
platform MachOp
mop (forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform) [CmmExpr]
args)
= SDoc
ty forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc -> doc
parens (Platform -> MachOp -> [CmmExpr] -> SDoc
pprMachOpApp' Platform
platform MachOp
mop [CmmExpr]
args)
| Bool
otherwise
= Platform -> MachOp -> [CmmExpr] -> SDoc
pprMachOpApp' Platform
platform MachOp
mop [CmmExpr]
args
machOpNeedsCast :: Platform -> MachOp -> [CmmType] -> Maybe SDoc
machOpNeedsCast :: Platform -> MachOp -> [CmmType] -> Maybe SDoc
machOpNeedsCast Platform
platform MachOp
mop [CmmType]
args
| MachOp -> Bool
isComparisonMachOp MachOp
mop = forall a. a -> Maybe a
Just SDoc
mkW_
| MachOp -> Bool
signedOp MachOp
mop
, CmmType
res_ty <- Platform -> MachOp -> [CmmType] -> CmmType
machOpResultType Platform
platform MachOp
mop [CmmType]
args
, Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ CmmType -> Bool
isFloatType CmmType
res_ty
, let w :: Width
w = CmmType -> Width
typeWidth CmmType
res_ty
, Width
w forall a. Ord a => a -> a -> Bool
< Platform -> Width
wordWidth Platform
platform
= Width -> Maybe SDoc
cast_it Width
w
| Just Width
w <- MachOp -> Maybe Width
shiftOp MachOp
mop = Width -> Maybe SDoc
cast_it Width
w
| MO_Add Width
w <- MachOp
mop = Width -> Maybe SDoc
cast_it Width
w
| MO_Sub Width
w <- MachOp
mop = Width -> Maybe SDoc
cast_it Width
w
| MO_Mul Width
w <- MachOp
mop = Width -> Maybe SDoc
cast_it Width
w
| MO_U_Quot Width
w <- MachOp
mop = Width -> Maybe SDoc
cast_it Width
w
| MO_U_Rem Width
w <- MachOp
mop = Width -> Maybe SDoc
cast_it Width
w
| MO_And Width
w <- MachOp
mop = Width -> Maybe SDoc
cast_it Width
w
| MO_Or Width
w <- MachOp
mop = Width -> Maybe SDoc
cast_it Width
w
| MO_Xor Width
w <- MachOp
mop = Width -> Maybe SDoc
cast_it Width
w
| MO_Not Width
w <- MachOp
mop = Width -> Maybe SDoc
cast_it Width
w
| Bool
otherwise = forall a. Maybe a
Nothing
where
cast_it :: Width -> Maybe SDoc
cast_it Width
w =
let ty :: SDoc
ty = Platform -> Width -> SDoc
machRep_U_CType Platform
platform Width
w
in forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => doc -> doc
parens SDoc
ty
pprMachOpApp' :: Platform -> MachOp -> [CmmExpr] -> SDoc
pprMachOpApp' :: Platform -> MachOp -> [CmmExpr] -> SDoc
pprMachOpApp' Platform
platform MachOp
mop [CmmExpr]
args
= case [CmmExpr]
args of
[CmmExpr
x,CmmExpr
y] -> CmmExpr -> SDoc
pprArg CmmExpr
x forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> MachOp -> SDoc
pprMachOp_for_C Platform
platform MachOp
mop forall doc. IsLine doc => doc -> doc -> doc
<+> CmmExpr -> SDoc
pprArg CmmExpr
y
[CmmExpr
x] -> Platform -> MachOp -> SDoc
pprMachOp_for_C Platform
platform MachOp
mop forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc -> doc
parens (CmmExpr -> SDoc
pprArg CmmExpr
x)
[CmmExpr]
_ -> forall a. HasCallStack => String -> a
panic String
"PprC.pprMachOp : machop with wrong number of args"
where
pprArg :: CmmExpr -> SDoc
pprArg CmmExpr
e
| MachOp -> Bool
needsFCasts MachOp
mop = Platform -> SDoc -> CmmExpr -> SDoc
cCast Platform
platform (Width -> SDoc
machRep_F_CType Width
width) CmmExpr
e
| MachOp -> Bool
signedOp MachOp
mop = Platform -> SDoc -> CmmExpr -> SDoc
cCast Platform
platform (Platform -> Width -> SDoc
machRep_S_CType Platform
platform Width
width) CmmExpr
e
| MachOp -> Bool
needsUnsignedCast MachOp
mop
= Platform -> SDoc -> CmmExpr -> SDoc
cCast Platform
platform (Platform -> Width -> SDoc
machRep_U_CType Platform
platform Width
width) CmmExpr
e
| Bool
otherwise = Platform -> CmmExpr -> SDoc
pprExpr1 Platform
platform CmmExpr
e
where
width :: Width
width = CmmType -> Width
typeWidth (Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
e)
needsFCasts :: MachOp -> Bool
needsFCasts (MO_F_Neg Width
_) = Bool
True
needsFCasts (MO_F_Quot Width
_) = Bool
True
needsFCasts MachOp
mop = MachOp -> Bool
floatComparison MachOp
mop
needsUnsignedCast :: MachOp -> Bool
needsUnsignedCast (MO_Mul Width
_) = Bool
True
needsUnsignedCast (MO_U_Shr Width
_) = Bool
True
needsUnsignedCast (MO_U_Quot Width
_) = Bool
True
needsUnsignedCast (MO_U_Rem Width
_) = Bool
True
needsUnsignedCast (MO_U_Ge Width
_) = Bool
True
needsUnsignedCast (MO_U_Le Width
_) = Bool
True
needsUnsignedCast (MO_U_Gt Width
_) = Bool
True
needsUnsignedCast (MO_U_Lt Width
_) = Bool
True
needsUnsignedCast MachOp
_ = Bool
False
pprLit :: Platform -> CmmLit -> SDoc
pprLit :: Platform -> CmmLit -> SDoc
pprLit Platform
platform CmmLit
lit = case CmmLit
lit of
CmmInt Integer
i Width
rep -> Platform -> Integer -> Width -> SDoc
pprHexVal Platform
platform Integer
i Width
rep
CmmFloat Rational
f Width
w -> forall doc. IsLine doc => doc -> doc
parens (Width -> SDoc
machRep_F_CType Width
w) forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
str
where d :: Double
d = forall a. Fractional a => Rational -> a
fromRational Rational
f :: Double
str :: SDoc
str | forall a. RealFloat a => a -> Bool
isInfinite Double
d Bool -> Bool -> Bool
&& Double
d forall a. Ord a => a -> a -> Bool
< Double
0 = forall doc. IsLine doc => String -> doc
text String
"-INFINITY"
| forall a. RealFloat a => a -> Bool
isInfinite Double
d = forall doc. IsLine doc => String -> doc
text String
"INFINITY"
| forall a. RealFloat a => a -> Bool
isNaN Double
d = forall doc. IsLine doc => String -> doc
text String
"NAN"
| Bool
otherwise = forall doc. IsLine doc => String -> doc
text (forall a. Show a => a -> String
show Double
d)
CmmVec {} -> forall a. HasCallStack => String -> a
panic String
"PprC printing vector literal"
CmmBlock BlockId
bid -> SDoc
mkW_ forall doc. IsLine doc => doc -> doc -> doc
<> CLabel -> SDoc
pprCLabelAddr (BlockId -> CLabel
infoTblLbl BlockId
bid)
CmmLit
CmmHighStackMark -> forall a. HasCallStack => String -> a
panic String
"PprC printing high stack mark"
CmmLabel CLabel
clbl -> SDoc
mkW_ forall doc. IsLine doc => doc -> doc -> doc
<> CLabel -> SDoc
pprCLabelAddr CLabel
clbl
CmmLabelOff CLabel
clbl Int
i -> SDoc
mkW_ forall doc. IsLine doc => doc -> doc -> doc
<> CLabel -> SDoc
pprCLabelAddr CLabel
clbl forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Char -> doc
char Char
'+' forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Int -> doc
int Int
i
CmmLabelDiffOff CLabel
clbl1 CLabel
_ Int
i Width
_
-> SDoc
mkW_ forall doc. IsLine doc => doc -> doc -> doc
<> CLabel -> SDoc
pprCLabelAddr CLabel
clbl1 forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Char -> doc
char Char
'+' forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Int -> doc
int Int
i
where
pprCLabelAddr :: CLabel -> SDoc
pprCLabelAddr CLabel
lbl = forall doc. IsLine doc => Char -> doc
char Char
'&' forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Platform -> CLabel -> doc
pprCLabel Platform
platform CLabel
lbl
pprLit1 :: Platform -> CmmLit -> SDoc
pprLit1 :: Platform -> CmmLit -> SDoc
pprLit1 Platform
platform CmmLit
lit = case CmmLit
lit of
(CmmLabelOff CLabel
_ Int
_) -> forall doc. IsLine doc => doc -> doc
parens (Platform -> CmmLit -> SDoc
pprLit Platform
platform CmmLit
lit)
(CmmLabelDiffOff CLabel
_ CLabel
_ Int
_ Width
_) -> forall doc. IsLine doc => doc -> doc
parens (Platform -> CmmLit -> SDoc
pprLit Platform
platform CmmLit
lit)
(CmmFloat Rational
_ Width
_) -> forall doc. IsLine doc => doc -> doc
parens (Platform -> CmmLit -> SDoc
pprLit Platform
platform CmmLit
lit)
CmmLit
_ -> Platform -> CmmLit -> SDoc
pprLit Platform
platform CmmLit
lit
staticLitsToWords :: Platform -> [CmmLit] -> [SDoc]
staticLitsToWords :: Platform -> [CmmLit] -> [SDoc]
staticLitsToWords Platform
platform = [CmmLit] -> [SDoc]
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap CmmLit -> [CmmLit]
decomposeMultiWord
where
go :: [CmmLit] -> [SDoc]
go :: [CmmLit] -> [SDoc]
go [] = []
go lits :: [CmmLit]
lits@(CmmLit
lit : [CmmLit]
_)
| Just (Integer, Width)
_ <- CmmLit -> Maybe (Integer, Width)
isSubWordLit CmmLit
lit
= Int -> Integer -> [CmmLit] -> [SDoc]
goSubWord Int
wordWidthBytes Integer
0 [CmmLit]
lits
go (CmmLit
lit : [CmmLit]
rest)
= Platform -> CmmLit -> SDoc
pprLit1 Platform
platform CmmLit
lit forall a. a -> [a] -> [a]
: [CmmLit] -> [SDoc]
go [CmmLit]
rest
goSubWord :: Int -> Integer -> [CmmLit] -> [SDoc]
goSubWord :: Int -> Integer -> [CmmLit] -> [SDoc]
goSubWord Int
rem_bytes Integer
accum (CmmLit
lit : [CmmLit]
rest)
| Just (Integer
bytes, Width
w) <- CmmLit -> Maybe (Integer, Width)
isSubWordLit CmmLit
lit
, Int
rem_bytes forall a. Ord a => a -> a -> Bool
>= Width -> Int
widthInBytes Width
w
= let accum' :: Integer
accum' = (Integer
accum forall a. Bits a => a -> Int -> a
`shiftL` Width -> Int
widthInBits Width
w) forall a. Bits a => a -> a -> a
.|. Width -> Integer -> Integer
fixEndian Width
w Integer
bytes
in Int -> Integer -> [CmmLit] -> [SDoc]
goSubWord (Int
rem_bytes forall a. Num a => a -> a -> a
- Width -> Int
widthInBytes Width
w) Integer
accum' [CmmLit]
rest
goSubWord Int
rem_bytes Integer
accum [CmmLit]
rest
= Integer -> SDoc
pprWord (Width -> Integer -> Integer
fixEndian (Platform -> Width
wordWidth Platform
platform) forall a b. (a -> b) -> a -> b
$ Integer
accum forall a. Bits a => a -> Int -> a
`shiftL` (Int
8forall a. Num a => a -> a -> a
*Int
rem_bytes)) forall a. a -> [a] -> [a]
: [CmmLit] -> [SDoc]
go [CmmLit]
rest
fixEndian :: Width -> Integer -> Integer
fixEndian :: Width -> Integer -> Integer
fixEndian Width
w = case Platform -> ByteOrder
platformByteOrder Platform
platform of
ByteOrder
BigEndian -> forall a. a -> a
id
ByteOrder
LittleEndian -> Width -> Integer -> Integer
byteSwap Width
w
decomposeMultiWord :: CmmLit -> [CmmLit]
decomposeMultiWord :: CmmLit -> [CmmLit]
decomposeMultiWord (CmmFloat Rational
n Width
W64)
| Width
W32 <- Platform -> Width
wordWidth Platform
platform = CmmLit -> [CmmLit]
decomposeMultiWord (Rational -> CmmLit
doubleToWord64 Rational
n)
| Bool
otherwise = [Rational -> CmmLit
doubleToWord64 Rational
n]
decomposeMultiWord (CmmFloat Rational
n Width
W32)
= [Rational -> CmmLit
floatToWord32 Rational
n]
decomposeMultiWord (CmmInt Integer
n Width
W64)
| Width
W32 <- Platform -> Width
wordWidth Platform
platform
= case Platform -> ByteOrder
platformByteOrder Platform
platform of
ByteOrder
BigEndian -> [Integer -> Width -> CmmLit
CmmInt Integer
hi Width
W32, Integer -> Width -> CmmLit
CmmInt Integer
lo Width
W32]
ByteOrder
LittleEndian -> [Integer -> Width -> CmmLit
CmmInt Integer
lo Width
W32, Integer -> Width -> CmmLit
CmmInt Integer
hi Width
W32]
where
hi :: Integer
hi = Integer
n forall a. Bits a => a -> Int -> a
`shiftR` Int
32
lo :: Integer
lo = Integer
n forall a. Bits a => a -> a -> a
.&. Integer
0xffffffff
decomposeMultiWord CmmLit
lit = [CmmLit
lit]
isSubWordLit :: CmmLit -> Maybe (Integer, Width)
isSubWordLit :: CmmLit -> Maybe (Integer, Width)
isSubWordLit CmmLit
lit =
case CmmLit
lit of
CmmInt Integer
n Width
w
| Width
w forall a. Ord a => a -> a -> Bool
< Platform -> Width
wordWidth Platform
platform -> forall a. a -> Maybe a
Just (Integer
n, Width
w)
CmmLit
_ -> forall a. Maybe a
Nothing
wordWidthBytes :: Int
wordWidthBytes = Width -> Int
widthInBytes forall a b. (a -> b) -> a -> b
$ Platform -> Width
wordWidth Platform
platform
pprWord :: Integer -> SDoc
pprWord :: Integer -> SDoc
pprWord Integer
n = Platform -> Integer -> Width -> SDoc
pprHexVal Platform
platform Integer
n (Platform -> Width
wordWidth Platform
platform)
byteSwap :: Width -> Integer -> Integer
byteSwap :: Width -> Integer -> Integer
byteSwap Width
width Integer
n = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Bits a => a -> a -> a
f Integer
0 [Integer]
bytes
where
f :: a -> a -> a
f a
acc a
m = (a
acc forall a. Bits a => a -> Int -> a
`shiftL` Int
8) forall a. Bits a => a -> a -> a
.|. a
m
bytes :: [Integer]
bytes = [ Int -> Integer
byte Int
i | Int
i <- [Int
0..Width -> Int
widthInBytes Width
width forall a. Num a => a -> a -> a
- Int
1] ]
byte :: Int -> Integer
byte Int
i = (Integer
n forall a. Bits a => a -> Int -> a
`shiftR` (Int
iforall a. Num a => a -> a -> a
*Int
8)) forall a. Bits a => a -> a -> a
.&. Integer
0xff
pprStatic :: Platform -> CmmStatic -> SDoc
pprStatic :: Platform -> CmmStatic -> SDoc
pprStatic Platform
platform CmmStatic
s = case CmmStatic
s of
CmmStaticLit CmmLit
lit -> Int -> SDoc -> SDoc
nest Int
4 (Platform -> CmmLit -> SDoc
pprLit Platform
platform CmmLit
lit)
CmmUninitialised Int
i -> Int -> SDoc -> SDoc
nest Int
4 (SDoc
mkC_ forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc -> doc
brackets (forall doc. IsLine doc => Int -> doc
int Int
i))
CmmString ByteString
s' -> Int -> SDoc -> SDoc
nest Int
4 (SDoc
mkW_ forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc -> doc
parens(ByteString -> SDoc
pprStringInCStyle ByteString
s'))
CmmFileEmbed {} -> forall a. HasCallStack => String -> a
panic String
"Unexpected CmmFileEmbed literal"
pprBlockId :: BlockId -> SDoc
pprBlockId :: BlockId -> SDoc
pprBlockId BlockId
b = forall doc. IsLine doc => Char -> doc
char Char
'_' forall doc. IsLine doc => doc -> doc -> doc
<> forall a. Outputable a => a -> SDoc
ppr (forall a. Uniquable a => a -> Unique
getUnique BlockId
b)
pprMachOp_for_C :: Platform -> MachOp -> SDoc
pprMachOp_for_C :: Platform -> MachOp -> SDoc
pprMachOp_for_C Platform
platform MachOp
mop = case MachOp
mop of
MO_Add Width
_ -> forall doc. IsLine doc => Char -> doc
char Char
'+'
MO_Sub Width
_ -> forall doc. IsLine doc => Char -> doc
char Char
'-'
MO_Eq Width
_ -> forall doc. IsLine doc => String -> doc
text String
"=="
MO_Ne Width
_ -> forall doc. IsLine doc => String -> doc
text String
"!="
MO_Mul Width
_ -> forall doc. IsLine doc => Char -> doc
char Char
'*'
MO_S_Quot Width
_ -> forall doc. IsLine doc => Char -> doc
char Char
'/'
MO_S_Rem Width
_ -> forall doc. IsLine doc => Char -> doc
char Char
'%'
MO_S_Neg Width
_ -> forall doc. IsLine doc => Char -> doc
char Char
'-'
MO_U_Quot Width
_ -> forall doc. IsLine doc => Char -> doc
char Char
'/'
MO_U_Rem Width
_ -> forall doc. IsLine doc => Char -> doc
char Char
'%'
MO_F_Add Width
_ -> forall doc. IsLine doc => Char -> doc
char Char
'+'
MO_F_Sub Width
_ -> forall doc. IsLine doc => Char -> doc
char Char
'-'
MO_F_Neg Width
_ -> forall doc. IsLine doc => Char -> doc
char Char
'-'
MO_F_Mul Width
_ -> forall doc. IsLine doc => Char -> doc
char Char
'*'
MO_F_Quot Width
_ -> forall doc. IsLine doc => Char -> doc
char Char
'/'
MO_S_Ge Width
_ -> forall doc. IsLine doc => String -> doc
text String
">="
MO_S_Le Width
_ -> forall doc. IsLine doc => String -> doc
text String
"<="
MO_S_Gt Width
_ -> forall doc. IsLine doc => Char -> doc
char Char
'>'
MO_S_Lt Width
_ -> forall doc. IsLine doc => Char -> doc
char Char
'<'
MO_U_Ge Width
_ -> forall doc. IsLine doc => String -> doc
text String
">="
MO_U_Le Width
_ -> forall doc. IsLine doc => String -> doc
text String
"<="
MO_U_Gt Width
_ -> forall doc. IsLine doc => Char -> doc
char Char
'>'
MO_U_Lt Width
_ -> forall doc. IsLine doc => Char -> doc
char Char
'<'
MO_F_Eq Width
_ -> forall doc. IsLine doc => String -> doc
text String
"=="
MO_F_Ne Width
_ -> forall doc. IsLine doc => String -> doc
text String
"!="
MO_F_Ge Width
_ -> forall doc. IsLine doc => String -> doc
text String
">="
MO_F_Le Width
_ -> forall doc. IsLine doc => String -> doc
text String
"<="
MO_F_Gt Width
_ -> forall doc. IsLine doc => Char -> doc
char Char
'>'
MO_F_Lt Width
_ -> forall doc. IsLine doc => Char -> doc
char Char
'<'
MO_And Width
_ -> forall doc. IsLine doc => Char -> doc
char Char
'&'
MO_Or Width
_ -> forall doc. IsLine doc => Char -> doc
char Char
'|'
MO_Xor Width
_ -> forall doc. IsLine doc => Char -> doc
char Char
'^'
MO_Not Width
_ -> forall doc. IsLine doc => Char -> doc
char Char
'~'
MO_Shl Width
_ -> forall doc. IsLine doc => String -> doc
text String
"<<"
MO_U_Shr Width
_ -> forall doc. IsLine doc => String -> doc
text String
">>"
MO_S_Shr Width
_ -> forall doc. IsLine doc => String -> doc
text String
">>"
MO_UU_Conv Width
from Width
to | Width
from forall a. Eq a => a -> a -> Bool
== Width
to -> forall doc. IsOutput doc => doc
empty
MO_UU_Conv Width
_from Width
to -> forall doc. IsLine doc => doc -> doc
parens (Platform -> Width -> SDoc
machRep_U_CType Platform
platform Width
to)
MO_SS_Conv Width
from Width
to | Width
from forall a. Eq a => a -> a -> Bool
== Width
to -> forall doc. IsOutput doc => doc
empty
MO_SS_Conv Width
_from Width
to -> forall doc. IsLine doc => doc -> doc
parens (Platform -> Width -> SDoc
machRep_S_CType Platform
platform Width
to)
MO_XX_Conv Width
from Width
to | Width
from forall a. Eq a => a -> a -> Bool
== Width
to -> forall doc. IsOutput doc => doc
empty
MO_XX_Conv Width
_from Width
to -> forall doc. IsLine doc => doc -> doc
parens (Platform -> Width -> SDoc
machRep_U_CType Platform
platform Width
to)
MO_FF_Conv Width
from Width
to | Width
from forall a. Eq a => a -> a -> Bool
== Width
to -> forall doc. IsOutput doc => doc
empty
MO_FF_Conv Width
_from Width
to -> forall doc. IsLine doc => doc -> doc
parens (Width -> SDoc
machRep_F_CType Width
to)
MO_SF_Conv Width
_from Width
to -> forall doc. IsLine doc => doc -> doc
parens (Width -> SDoc
machRep_F_CType Width
to)
MO_FS_Conv Width
_from Width
to -> forall doc. IsLine doc => doc -> doc
parens (Platform -> Width -> SDoc
machRep_S_CType Platform
platform Width
to)
MO_S_MulMayOflo Width
_ -> forall a. String -> SDoc -> a -> a
pprTrace String
"offending mop:"
(forall doc. IsLine doc => String -> doc
text String
"MO_S_MulMayOflo")
(forall a. HasCallStack => String -> a
panic forall a b. (a -> b) -> a -> b
$ String
"PprC.pprMachOp_for_C: MO_S_MulMayOflo"
forall a. [a] -> [a] -> [a]
++ String
" should have been handled earlier!")
MO_V_Insert {} -> forall a. String -> SDoc -> a -> a
pprTrace String
"offending mop:"
(forall doc. IsLine doc => String -> doc
text String
"MO_V_Insert")
(forall a. HasCallStack => String -> a
panic forall a b. (a -> b) -> a -> b
$ String
"PprC.pprMachOp_for_C: MO_V_Insert"
forall a. [a] -> [a] -> [a]
++ String
" should have been handled earlier!")
MO_V_Extract {} -> forall a. String -> SDoc -> a -> a
pprTrace String
"offending mop:"
(forall doc. IsLine doc => String -> doc
text String
"MO_V_Extract")
(forall a. HasCallStack => String -> a
panic forall a b. (a -> b) -> a -> b
$ String
"PprC.pprMachOp_for_C: MO_V_Extract"
forall a. [a] -> [a] -> [a]
++ String
" should have been handled earlier!")
MO_V_Add {} -> forall a. String -> SDoc -> a -> a
pprTrace String
"offending mop:"
(forall doc. IsLine doc => String -> doc
text String
"MO_V_Add")
(forall a. HasCallStack => String -> a
panic forall a b. (a -> b) -> a -> b
$ String
"PprC.pprMachOp_for_C: MO_V_Add"
forall a. [a] -> [a] -> [a]
++ String
" should have been handled earlier!")
MO_V_Sub {} -> forall a. String -> SDoc -> a -> a
pprTrace String
"offending mop:"
(forall doc. IsLine doc => String -> doc
text String
"MO_V_Sub")
(forall a. HasCallStack => String -> a
panic forall a b. (a -> b) -> a -> b
$ String
"PprC.pprMachOp_for_C: MO_V_Sub"
forall a. [a] -> [a] -> [a]
++ String
" should have been handled earlier!")
MO_V_Mul {} -> forall a. String -> SDoc -> a -> a
pprTrace String
"offending mop:"
(forall doc. IsLine doc => String -> doc
text String
"MO_V_Mul")
(forall a. HasCallStack => String -> a
panic forall a b. (a -> b) -> a -> b
$ String
"PprC.pprMachOp_for_C: MO_V_Mul"
forall a. [a] -> [a] -> [a]
++ String
" should have been handled earlier!")
MO_VS_Quot {} -> forall a. String -> SDoc -> a -> a
pprTrace String
"offending mop:"
(forall doc. IsLine doc => String -> doc
text String
"MO_VS_Quot")
(forall a. HasCallStack => String -> a
panic forall a b. (a -> b) -> a -> b
$ String
"PprC.pprMachOp_for_C: MO_VS_Quot"
forall a. [a] -> [a] -> [a]
++ String
" should have been handled earlier!")
MO_VS_Rem {} -> forall a. String -> SDoc -> a -> a
pprTrace String
"offending mop:"
(forall doc. IsLine doc => String -> doc
text String
"MO_VS_Rem")
(forall a. HasCallStack => String -> a
panic forall a b. (a -> b) -> a -> b
$ String
"PprC.pprMachOp_for_C: MO_VS_Rem"
forall a. [a] -> [a] -> [a]
++ String
" should have been handled earlier!")
MO_VS_Neg {} -> forall a. String -> SDoc -> a -> a
pprTrace String
"offending mop:"
(forall doc. IsLine doc => String -> doc
text String
"MO_VS_Neg")
(forall a. HasCallStack => String -> a
panic forall a b. (a -> b) -> a -> b
$ String
"PprC.pprMachOp_for_C: MO_VS_Neg"
forall a. [a] -> [a] -> [a]
++ String
" should have been handled earlier!")
MO_VU_Quot {} -> forall a. String -> SDoc -> a -> a
pprTrace String
"offending mop:"
(forall doc. IsLine doc => String -> doc
text String
"MO_VU_Quot")
(forall a. HasCallStack => String -> a
panic forall a b. (a -> b) -> a -> b
$ String
"PprC.pprMachOp_for_C: MO_VU_Quot"
forall a. [a] -> [a] -> [a]
++ String
" should have been handled earlier!")
MO_VU_Rem {} -> forall a. String -> SDoc -> a -> a
pprTrace String
"offending mop:"
(forall doc. IsLine doc => String -> doc
text String
"MO_VU_Rem")
(forall a. HasCallStack => String -> a
panic forall a b. (a -> b) -> a -> b
$ String
"PprC.pprMachOp_for_C: MO_VU_Rem"
forall a. [a] -> [a] -> [a]
++ String
" should have been handled earlier!")
MO_VF_Insert {} -> forall a. String -> SDoc -> a -> a
pprTrace String
"offending mop:"
(forall doc. IsLine doc => String -> doc
text String
"MO_VF_Insert")
(forall a. HasCallStack => String -> a
panic forall a b. (a -> b) -> a -> b
$ String
"PprC.pprMachOp_for_C: MO_VF_Insert"
forall a. [a] -> [a] -> [a]
++ String
" should have been handled earlier!")
MO_VF_Extract {} -> forall a. String -> SDoc -> a -> a
pprTrace String
"offending mop:"
(forall doc. IsLine doc => String -> doc
text String
"MO_VF_Extract")
(forall a. HasCallStack => String -> a
panic forall a b. (a -> b) -> a -> b
$ String
"PprC.pprMachOp_for_C: MO_VF_Extract"
forall a. [a] -> [a] -> [a]
++ String
" should have been handled earlier!")
MO_VF_Add {} -> forall a. String -> SDoc -> a -> a
pprTrace String
"offending mop:"
(forall doc. IsLine doc => String -> doc
text String
"MO_VF_Add")
(forall a. HasCallStack => String -> a
panic forall a b. (a -> b) -> a -> b
$ String
"PprC.pprMachOp_for_C: MO_VF_Add"
forall a. [a] -> [a] -> [a]
++ String
" should have been handled earlier!")
MO_VF_Sub {} -> forall a. String -> SDoc -> a -> a
pprTrace String
"offending mop:"
(forall doc. IsLine doc => String -> doc
text String
"MO_VF_Sub")
(forall a. HasCallStack => String -> a
panic forall a b. (a -> b) -> a -> b
$ String
"PprC.pprMachOp_for_C: MO_VF_Sub"
forall a. [a] -> [a] -> [a]
++ String
" should have been handled earlier!")
MO_VF_Neg {} -> forall a. String -> SDoc -> a -> a
pprTrace String
"offending mop:"
(forall doc. IsLine doc => String -> doc
text String
"MO_VF_Neg")
(forall a. HasCallStack => String -> a
panic forall a b. (a -> b) -> a -> b
$ String
"PprC.pprMachOp_for_C: MO_VF_Neg"
forall a. [a] -> [a] -> [a]
++ String
" should have been handled earlier!")
MO_VF_Mul {} -> forall a. String -> SDoc -> a -> a
pprTrace String
"offending mop:"
(forall doc. IsLine doc => String -> doc
text String
"MO_VF_Mul")
(forall a. HasCallStack => String -> a
panic forall a b. (a -> b) -> a -> b
$ String
"PprC.pprMachOp_for_C: MO_VF_Mul"
forall a. [a] -> [a] -> [a]
++ String
" should have been handled earlier!")
MO_VF_Quot {} -> forall a. String -> SDoc -> a -> a
pprTrace String
"offending mop:"
(forall doc. IsLine doc => String -> doc
text String
"MO_VF_Quot")
(forall a. HasCallStack => String -> a
panic forall a b. (a -> b) -> a -> b
$ String
"PprC.pprMachOp_for_C: MO_VF_Quot"
forall a. [a] -> [a] -> [a]
++ String
" should have been handled earlier!")
MO_AlignmentCheck {} -> forall a. HasCallStack => String -> a
panic String
"-falignment-sanitisation not supported by unregisterised backend"
signedOp :: MachOp -> Bool
signedOp :: MachOp -> Bool
signedOp (MO_S_Quot Width
_) = Bool
True
signedOp (MO_S_Rem Width
_) = Bool
True
signedOp (MO_S_Neg Width
_) = Bool
True
signedOp (MO_S_Ge Width
_) = Bool
True
signedOp (MO_S_Le Width
_) = Bool
True
signedOp (MO_S_Gt Width
_) = Bool
True
signedOp (MO_S_Lt Width
_) = Bool
True
signedOp (MO_S_Shr Width
_) = Bool
True
signedOp (MO_SS_Conv Width
_ Width
_) = Bool
True
signedOp (MO_SF_Conv Width
_ Width
_) = Bool
True
signedOp MachOp
_ = Bool
False
shiftOp :: MachOp -> Maybe Width
shiftOp :: MachOp -> Maybe Width
shiftOp (MO_Shl Width
w) = forall a. a -> Maybe a
Just Width
w
shiftOp (MO_U_Shr Width
w) = forall a. a -> Maybe a
Just Width
w
shiftOp (MO_S_Shr Width
w) = forall a. a -> Maybe a
Just Width
w
shiftOp MachOp
_ = forall a. Maybe a
Nothing
floatComparison :: MachOp -> Bool
floatComparison :: MachOp -> Bool
floatComparison (MO_F_Eq Width
_) = Bool
True
floatComparison (MO_F_Ne Width
_) = Bool
True
floatComparison (MO_F_Ge Width
_) = Bool
True
floatComparison (MO_F_Le Width
_) = Bool
True
floatComparison (MO_F_Gt Width
_) = Bool
True
floatComparison (MO_F_Lt Width
_) = Bool
True
floatComparison MachOp
_ = Bool
False
pprCallishMachOp_for_C :: CallishMachOp -> SDoc
pprCallishMachOp_for_C :: CallishMachOp -> SDoc
pprCallishMachOp_for_C CallishMachOp
mop
= case CallishMachOp
mop of
CallishMachOp
MO_F64_Pwr -> forall doc. IsLine doc => String -> doc
text String
"pow"
CallishMachOp
MO_F64_Sin -> forall doc. IsLine doc => String -> doc
text String
"sin"
CallishMachOp
MO_F64_Cos -> forall doc. IsLine doc => String -> doc
text String
"cos"
CallishMachOp
MO_F64_Tan -> forall doc. IsLine doc => String -> doc
text String
"tan"
CallishMachOp
MO_F64_Sinh -> forall doc. IsLine doc => String -> doc
text String
"sinh"
CallishMachOp
MO_F64_Cosh -> forall doc. IsLine doc => String -> doc
text String
"cosh"
CallishMachOp
MO_F64_Tanh -> forall doc. IsLine doc => String -> doc
text String
"tanh"
CallishMachOp
MO_F64_Asin -> forall doc. IsLine doc => String -> doc
text String
"asin"
CallishMachOp
MO_F64_Acos -> forall doc. IsLine doc => String -> doc
text String
"acos"
CallishMachOp
MO_F64_Atanh -> forall doc. IsLine doc => String -> doc
text String
"atanh"
CallishMachOp
MO_F64_Asinh -> forall doc. IsLine doc => String -> doc
text String
"asinh"
CallishMachOp
MO_F64_Acosh -> forall doc. IsLine doc => String -> doc
text String
"acosh"
CallishMachOp
MO_F64_Atan -> forall doc. IsLine doc => String -> doc
text String
"atan"
CallishMachOp
MO_F64_Log -> forall doc. IsLine doc => String -> doc
text String
"log"
CallishMachOp
MO_F64_Log1P -> forall doc. IsLine doc => String -> doc
text String
"log1p"
CallishMachOp
MO_F64_Exp -> forall doc. IsLine doc => String -> doc
text String
"exp"
CallishMachOp
MO_F64_ExpM1 -> forall doc. IsLine doc => String -> doc
text String
"expm1"
CallishMachOp
MO_F64_Sqrt -> forall doc. IsLine doc => String -> doc
text String
"sqrt"
CallishMachOp
MO_F64_Fabs -> forall doc. IsLine doc => String -> doc
text String
"fabs"
CallishMachOp
MO_F32_Pwr -> forall doc. IsLine doc => String -> doc
text String
"powf"
CallishMachOp
MO_F32_Sin -> forall doc. IsLine doc => String -> doc
text String
"sinf"
CallishMachOp
MO_F32_Cos -> forall doc. IsLine doc => String -> doc
text String
"cosf"
CallishMachOp
MO_F32_Tan -> forall doc. IsLine doc => String -> doc
text String
"tanf"
CallishMachOp
MO_F32_Sinh -> forall doc. IsLine doc => String -> doc
text String
"sinhf"
CallishMachOp
MO_F32_Cosh -> forall doc. IsLine doc => String -> doc
text String
"coshf"
CallishMachOp
MO_F32_Tanh -> forall doc. IsLine doc => String -> doc
text String
"tanhf"
CallishMachOp
MO_F32_Asin -> forall doc. IsLine doc => String -> doc
text String
"asinf"
CallishMachOp
MO_F32_Acos -> forall doc. IsLine doc => String -> doc
text String
"acosf"
CallishMachOp
MO_F32_Atan -> forall doc. IsLine doc => String -> doc
text String
"atanf"
CallishMachOp
MO_F32_Asinh -> forall doc. IsLine doc => String -> doc
text String
"asinhf"
CallishMachOp
MO_F32_Acosh -> forall doc. IsLine doc => String -> doc
text String
"acoshf"
CallishMachOp
MO_F32_Atanh -> forall doc. IsLine doc => String -> doc
text String
"atanhf"
CallishMachOp
MO_F32_Log -> forall doc. IsLine doc => String -> doc
text String
"logf"
CallishMachOp
MO_F32_Log1P -> forall doc. IsLine doc => String -> doc
text String
"log1pf"
CallishMachOp
MO_F32_Exp -> forall doc. IsLine doc => String -> doc
text String
"expf"
CallishMachOp
MO_F32_ExpM1 -> forall doc. IsLine doc => String -> doc
text String
"expm1f"
CallishMachOp
MO_F32_Sqrt -> forall doc. IsLine doc => String -> doc
text String
"sqrtf"
CallishMachOp
MO_F32_Fabs -> forall doc. IsLine doc => String -> doc
text String
"fabsf"
CallishMachOp
MO_ReadBarrier -> forall doc. IsLine doc => String -> doc
text String
"load_load_barrier"
CallishMachOp
MO_WriteBarrier -> forall doc. IsLine doc => String -> doc
text String
"write_barrier"
MO_Memcpy Int
_ -> forall doc. IsLine doc => String -> doc
text String
"__builtin_memcpy"
MO_Memset Int
_ -> forall doc. IsLine doc => String -> doc
text String
"__builtin_memset"
MO_Memmove Int
_ -> forall doc. IsLine doc => String -> doc
text String
"__builtin_memmove"
MO_Memcmp Int
_ -> forall doc. IsLine doc => String -> doc
text String
"__builtin_memcmp"
CallishMachOp
MO_SuspendThread -> forall doc. IsLine doc => String -> doc
text String
"suspendThread"
CallishMachOp
MO_ResumeThread -> forall doc. IsLine doc => String -> doc
text String
"resumeThread"
MO_BSwap Width
w -> forall doc. IsLine doc => FastString -> doc
ftext (Width -> FastString
bSwapLabel Width
w)
MO_BRev Width
w -> forall doc. IsLine doc => FastString -> doc
ftext (Width -> FastString
bRevLabel Width
w)
MO_PopCnt Width
w -> forall doc. IsLine doc => FastString -> doc
ftext (Width -> FastString
popCntLabel Width
w)
MO_Pext Width
w -> forall doc. IsLine doc => FastString -> doc
ftext (Width -> FastString
pextLabel Width
w)
MO_Pdep Width
w -> forall doc. IsLine doc => FastString -> doc
ftext (Width -> FastString
pdepLabel Width
w)
MO_Clz Width
w -> forall doc. IsLine doc => FastString -> doc
ftext (Width -> FastString
clzLabel Width
w)
MO_Ctz Width
w -> forall doc. IsLine doc => FastString -> doc
ftext (Width -> FastString
ctzLabel Width
w)
MO_AtomicRMW Width
w AtomicMachOp
amop -> forall doc. IsLine doc => FastString -> doc
ftext (Width -> AtomicMachOp -> FastString
atomicRMWLabel Width
w AtomicMachOp
amop)
MO_Cmpxchg Width
w -> forall doc. IsLine doc => FastString -> doc
ftext (Width -> FastString
cmpxchgLabel Width
w)
MO_Xchg Width
w -> forall doc. IsLine doc => FastString -> doc
ftext (Width -> FastString
xchgLabel Width
w)
MO_AtomicRead Width
w MemoryOrdering
_ -> forall doc. IsLine doc => FastString -> doc
ftext (Width -> FastString
atomicReadLabel Width
w)
MO_AtomicWrite Width
w MemoryOrdering
_ -> forall doc. IsLine doc => FastString -> doc
ftext (Width -> FastString
atomicWriteLabel Width
w)
MO_UF_Conv Width
w -> forall doc. IsLine doc => FastString -> doc
ftext (Width -> FastString
word2FloatLabel Width
w)
MO_S_Mul2 {} -> SDoc
unsupported
MO_S_QuotRem {} -> SDoc
unsupported
MO_U_QuotRem {} -> SDoc
unsupported
MO_U_QuotRem2 {} -> SDoc
unsupported
MO_Add2 {} -> SDoc
unsupported
MO_AddWordC {} -> SDoc
unsupported
MO_SubWordC {} -> SDoc
unsupported
MO_AddIntC {} -> SDoc
unsupported
MO_SubIntC {} -> SDoc
unsupported
MO_U_Mul2 {} -> SDoc
unsupported
CallishMachOp
MO_Touch -> SDoc
unsupported
(MO_Prefetch_Data Int
_ ) -> SDoc
unsupported
CallishMachOp
MO_I64_ToI -> forall doc. IsLine doc => String -> doc
text String
"hs_int64ToInt"
CallishMachOp
MO_I64_FromI -> forall doc. IsLine doc => String -> doc
text String
"hs_intToInt64"
CallishMachOp
MO_W64_ToW -> forall doc. IsLine doc => String -> doc
text String
"hs_word64ToWord"
CallishMachOp
MO_W64_FromW -> forall doc. IsLine doc => String -> doc
text String
"hs_wordToWord64"
CallishMachOp
MO_x64_Neg -> forall doc. IsLine doc => String -> doc
text String
"hs_neg64"
CallishMachOp
MO_x64_Add -> forall doc. IsLine doc => String -> doc
text String
"hs_add64"
CallishMachOp
MO_x64_Sub -> forall doc. IsLine doc => String -> doc
text String
"hs_sub64"
CallishMachOp
MO_x64_Mul -> forall doc. IsLine doc => String -> doc
text String
"hs_mul64"
CallishMachOp
MO_I64_Quot -> forall doc. IsLine doc => String -> doc
text String
"hs_quotInt64"
CallishMachOp
MO_I64_Rem -> forall doc. IsLine doc => String -> doc
text String
"hs_remInt64"
CallishMachOp
MO_W64_Quot -> forall doc. IsLine doc => String -> doc
text String
"hs_quotWord64"
CallishMachOp
MO_W64_Rem -> forall doc. IsLine doc => String -> doc
text String
"hs_remWord64"
CallishMachOp
MO_x64_And -> forall doc. IsLine doc => String -> doc
text String
"hs_and64"
CallishMachOp
MO_x64_Or -> forall doc. IsLine doc => String -> doc
text String
"hs_or64"
CallishMachOp
MO_x64_Xor -> forall doc. IsLine doc => String -> doc
text String
"hs_xor64"
CallishMachOp
MO_x64_Not -> forall doc. IsLine doc => String -> doc
text String
"hs_not64"
CallishMachOp
MO_x64_Shl -> forall doc. IsLine doc => String -> doc
text String
"hs_uncheckedShiftL64"
CallishMachOp
MO_I64_Shr -> forall doc. IsLine doc => String -> doc
text String
"hs_uncheckedIShiftRA64"
CallishMachOp
MO_W64_Shr -> forall doc. IsLine doc => String -> doc
text String
"hs_uncheckedShiftRL64"
CallishMachOp
MO_x64_Eq -> forall doc. IsLine doc => String -> doc
text String
"hs_eq64"
CallishMachOp
MO_x64_Ne -> forall doc. IsLine doc => String -> doc
text String
"hs_ne64"
CallishMachOp
MO_I64_Ge -> forall doc. IsLine doc => String -> doc
text String
"hs_geInt64"
CallishMachOp
MO_I64_Gt -> forall doc. IsLine doc => String -> doc
text String
"hs_gtInt64"
CallishMachOp
MO_I64_Le -> forall doc. IsLine doc => String -> doc
text String
"hs_leInt64"
CallishMachOp
MO_I64_Lt -> forall doc. IsLine doc => String -> doc
text String
"hs_ltInt64"
CallishMachOp
MO_W64_Ge -> forall doc. IsLine doc => String -> doc
text String
"hs_geWord64"
CallishMachOp
MO_W64_Gt -> forall doc. IsLine doc => String -> doc
text String
"hs_gtWord64"
CallishMachOp
MO_W64_Le -> forall doc. IsLine doc => String -> doc
text String
"hs_leWord64"
CallishMachOp
MO_W64_Lt -> forall doc. IsLine doc => String -> doc
text String
"hs_ltWord64"
where unsupported :: SDoc
unsupported = forall a. HasCallStack => String -> a
panic (String
"pprCallishMachOp_for_C: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CallishMachOp
mop
forall a. [a] -> [a] -> [a]
++ String
" not supported!")
mkJMP_, mkFN_, mkIF_ :: SDoc -> SDoc
mkJMP_ :: SDoc -> SDoc
mkJMP_ SDoc
i = forall doc. IsLine doc => String -> doc
text String
"JMP_" forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc -> doc
parens SDoc
i
mkFN_ :: SDoc -> SDoc
mkFN_ SDoc
i = forall doc. IsLine doc => String -> doc
text String
"FN_" forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc -> doc
parens SDoc
i
mkIF_ :: SDoc -> SDoc
mkIF_ SDoc
i = forall doc. IsLine doc => String -> doc
text String
"IF_" forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc -> doc
parens SDoc
i
mkC_,mkW_,mkP_ :: SDoc
mkC_ :: SDoc
mkC_ = forall doc. IsLine doc => String -> doc
text String
"(C_)"
mkW_ :: SDoc
mkW_ = forall doc. IsLine doc => String -> doc
text String
"(W_)"
mkP_ :: SDoc
mkP_ = forall doc. IsLine doc => String -> doc
text String
"(P_)"
pprAssign :: Platform -> CmmReg -> CmmExpr -> SDoc
pprAssign :: Platform -> CmmReg -> CmmExpr -> SDoc
pprAssign Platform
_ CmmReg
r1 (CmmReg CmmReg
r2)
| CmmReg -> Bool
isPtrReg CmmReg
r1 Bool -> Bool -> Bool
&& CmmReg -> Bool
isPtrReg CmmReg
r2
= forall doc. IsLine doc => [doc] -> doc
hcat [ CmmReg -> SDoc
pprAsPtrReg CmmReg
r1, forall doc. IsLine doc => doc
equals, CmmReg -> SDoc
pprAsPtrReg CmmReg
r2, forall doc. IsLine doc => doc
semi ]
pprAssign Platform
platform CmmReg
r1 (CmmRegOff CmmReg
r2 Int
off)
| CmmReg -> Bool
isPtrReg CmmReg
r1 Bool -> Bool -> Bool
&& CmmReg -> Bool
isPtrReg CmmReg
r2 Bool -> Bool -> Bool
&& (Int
off forall a. Integral a => a -> a -> a
`rem` Platform -> Int
platformWordSizeInBytes Platform
platform forall a. Eq a => a -> a -> Bool
== Int
0)
= forall doc. IsLine doc => [doc] -> doc
hcat [ CmmReg -> SDoc
pprAsPtrReg CmmReg
r1, forall doc. IsLine doc => doc
equals, CmmReg -> SDoc
pprAsPtrReg CmmReg
r2, SDoc
op, forall doc. IsLine doc => Int -> doc
int Int
off', forall doc. IsLine doc => doc
semi ]
where
off1 :: Int
off1 = Int
off forall a. Bits a => a -> Int -> a
`shiftR` Platform -> Int
wordShift Platform
platform
(SDoc
op,Int
off') | Int
off forall a. Ord a => a -> a -> Bool
>= Int
0 = (forall doc. IsLine doc => Char -> doc
char Char
'+', Int
off1)
| Bool
otherwise = (forall doc. IsLine doc => Char -> doc
char Char
'-', -Int
off1)
pprAssign Platform
platform CmmReg
r1 CmmExpr
r2
| CmmReg -> Bool
isFixedPtrReg CmmReg
r1 = SDoc -> SDoc
mkAssign (SDoc
mkP_ forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> CmmExpr -> SDoc
pprExpr1 Platform
platform CmmExpr
r2)
| Just SDoc
ty <- CmmReg -> Maybe SDoc
strangeRegType CmmReg
r1 = SDoc -> SDoc
mkAssign (forall doc. IsLine doc => doc -> doc
parens SDoc
ty forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> CmmExpr -> SDoc
pprExpr1 Platform
platform CmmExpr
r2)
| Bool
otherwise = SDoc -> SDoc
mkAssign (Platform -> CmmExpr -> SDoc
pprExpr Platform
platform CmmExpr
r2)
where mkAssign :: SDoc -> SDoc
mkAssign SDoc
x = if CmmReg
r1 forall a. Eq a => a -> a -> Bool
== GlobalReg -> CmmReg
CmmGlobal GlobalReg
BaseReg
then forall doc. IsLine doc => String -> doc
text String
"ASSIGN_BaseReg" forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc -> doc
parens SDoc
x forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
semi
else CmmReg -> SDoc
pprReg CmmReg
r1 forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
" = " forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
x forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
semi
pprCastReg :: CmmReg -> SDoc
pprCastReg :: CmmReg -> SDoc
pprCastReg CmmReg
reg
| CmmReg -> Bool
isStrangeTypeReg CmmReg
reg = SDoc
mkW_ forall doc. IsLine doc => doc -> doc -> doc
<> CmmReg -> SDoc
pprReg CmmReg
reg
| Bool
otherwise = CmmReg -> SDoc
pprReg CmmReg
reg
isFixedPtrReg :: CmmReg -> Bool
isFixedPtrReg :: CmmReg -> Bool
isFixedPtrReg (CmmLocal LocalReg
_) = Bool
False
isFixedPtrReg (CmmGlobal GlobalReg
r) = GlobalReg -> Bool
isFixedPtrGlobalReg GlobalReg
r
isPtrReg :: CmmReg -> Bool
isPtrReg :: CmmReg -> Bool
isPtrReg (CmmLocal LocalReg
_) = Bool
False
isPtrReg (CmmGlobal (VanillaReg Int
_ VGcPtr
VGcPtr)) = Bool
True
isPtrReg (CmmGlobal (VanillaReg Int
_ VGcPtr
VNonGcPtr)) = Bool
False
isPtrReg (CmmGlobal GlobalReg
reg) = GlobalReg -> Bool
isFixedPtrGlobalReg GlobalReg
reg
isFixedPtrGlobalReg :: GlobalReg -> Bool
isFixedPtrGlobalReg :: GlobalReg -> Bool
isFixedPtrGlobalReg GlobalReg
Sp = Bool
True
isFixedPtrGlobalReg GlobalReg
Hp = Bool
True
isFixedPtrGlobalReg GlobalReg
HpLim = Bool
True
isFixedPtrGlobalReg GlobalReg
SpLim = Bool
True
isFixedPtrGlobalReg GlobalReg
_ = Bool
False
isStrangeTypeReg :: CmmReg -> Bool
isStrangeTypeReg :: CmmReg -> Bool
isStrangeTypeReg (CmmLocal LocalReg
_) = Bool
False
isStrangeTypeReg (CmmGlobal GlobalReg
g) = GlobalReg -> Bool
isStrangeTypeGlobal GlobalReg
g
isStrangeTypeGlobal :: GlobalReg -> Bool
isStrangeTypeGlobal :: GlobalReg -> Bool
isStrangeTypeGlobal GlobalReg
CCCS = Bool
True
isStrangeTypeGlobal GlobalReg
CurrentTSO = Bool
True
isStrangeTypeGlobal GlobalReg
CurrentNursery = Bool
True
isStrangeTypeGlobal GlobalReg
BaseReg = Bool
True
isStrangeTypeGlobal GlobalReg
r = GlobalReg -> Bool
isFixedPtrGlobalReg GlobalReg
r
strangeRegType :: CmmReg -> Maybe SDoc
strangeRegType :: CmmReg -> Maybe SDoc
strangeRegType (CmmGlobal GlobalReg
CCCS) = forall a. a -> Maybe a
Just (forall doc. IsLine doc => String -> doc
text String
"struct CostCentreStack_ *")
strangeRegType (CmmGlobal GlobalReg
CurrentTSO) = forall a. a -> Maybe a
Just (forall doc. IsLine doc => String -> doc
text String
"struct StgTSO_ *")
strangeRegType (CmmGlobal GlobalReg
CurrentNursery) = forall a. a -> Maybe a
Just (forall doc. IsLine doc => String -> doc
text String
"struct bdescr_ *")
strangeRegType (CmmGlobal GlobalReg
BaseReg) = forall a. a -> Maybe a
Just (forall doc. IsLine doc => String -> doc
text String
"struct StgRegTable_ *")
strangeRegType CmmReg
_ = forall a. Maybe a
Nothing
pprReg :: CmmReg -> SDoc
pprReg :: CmmReg -> SDoc
pprReg CmmReg
r = case CmmReg
r of
CmmLocal LocalReg
local -> LocalReg -> SDoc
pprLocalReg LocalReg
local
CmmGlobal GlobalReg
global -> GlobalReg -> SDoc
pprGlobalReg GlobalReg
global
pprAsPtrReg :: CmmReg -> SDoc
pprAsPtrReg :: CmmReg -> SDoc
pprAsPtrReg (CmmGlobal (VanillaReg Int
n VGcPtr
gcp))
= forall a. HasCallStack => Bool -> String -> SDoc -> a -> a
warnPprTrace (VGcPtr
gcp forall a. Eq a => a -> a -> Bool
/= VGcPtr
VGcPtr) String
"pprAsPtrReg" (forall a. Outputable a => a -> SDoc
ppr Int
n) forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => Char -> doc
char Char
'R' forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Int -> doc
int Int
n forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
".p"
pprAsPtrReg CmmReg
other_reg = CmmReg -> SDoc
pprReg CmmReg
other_reg
pprGlobalReg :: GlobalReg -> SDoc
pprGlobalReg :: GlobalReg -> SDoc
pprGlobalReg GlobalReg
gr = case GlobalReg
gr of
VanillaReg Int
n VGcPtr
_ -> forall doc. IsLine doc => Char -> doc
char Char
'R' forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Int -> doc
int Int
n forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
".w"
FloatReg Int
n -> forall doc. IsLine doc => Char -> doc
char Char
'F' forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Int -> doc
int Int
n
DoubleReg Int
n -> forall doc. IsLine doc => Char -> doc
char Char
'D' forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Int -> doc
int Int
n
LongReg Int
n -> forall doc. IsLine doc => Char -> doc
char Char
'L' forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Int -> doc
int Int
n
GlobalReg
Sp -> forall doc. IsLine doc => String -> doc
text String
"Sp"
GlobalReg
SpLim -> forall doc. IsLine doc => String -> doc
text String
"SpLim"
GlobalReg
Hp -> forall doc. IsLine doc => String -> doc
text String
"Hp"
GlobalReg
HpLim -> forall doc. IsLine doc => String -> doc
text String
"HpLim"
GlobalReg
CCCS -> forall doc. IsLine doc => String -> doc
text String
"CCCS"
GlobalReg
CurrentTSO -> forall doc. IsLine doc => String -> doc
text String
"CurrentTSO"
GlobalReg
CurrentNursery -> forall doc. IsLine doc => String -> doc
text String
"CurrentNursery"
GlobalReg
HpAlloc -> forall doc. IsLine doc => String -> doc
text String
"HpAlloc"
GlobalReg
BaseReg -> forall doc. IsLine doc => String -> doc
text String
"BaseReg"
GlobalReg
EagerBlackholeInfo -> forall doc. IsLine doc => String -> doc
text String
"stg_EAGER_BLACKHOLE_info"
GlobalReg
GCEnter1 -> forall doc. IsLine doc => String -> doc
text String
"stg_gc_enter_1"
GlobalReg
GCFun -> forall doc. IsLine doc => String -> doc
text String
"stg_gc_fun"
GlobalReg
other -> forall a. HasCallStack => String -> a
panic forall a b. (a -> b) -> a -> b
$ String
"pprGlobalReg: Unsupported register: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show GlobalReg
other
pprLocalReg :: LocalReg -> SDoc
pprLocalReg :: LocalReg -> SDoc
pprLocalReg (LocalReg Unique
uniq CmmType
_) = forall doc. IsLine doc => Char -> doc
char Char
'_' forall doc. IsLine doc => doc -> doc -> doc
<> forall a. Outputable a => a -> SDoc
ppr Unique
uniq
pprCall :: Platform -> SDoc -> CCallConv -> [Hinted CmmFormal] -> [Hinted CmmActual] -> SDoc
pprCall :: Platform
-> SDoc
-> CCallConv
-> [(LocalReg, ForeignHint)]
-> [(CmmExpr, ForeignHint)]
-> SDoc
pprCall Platform
platform SDoc
ppr_fn CCallConv
cconv [(LocalReg, ForeignHint)]
results [(CmmExpr, ForeignHint)]
args
| Bool -> Bool
not (CCallConv -> Bool
is_cishCC CCallConv
cconv)
= forall a. HasCallStack => String -> a
panic forall a b. (a -> b) -> a -> b
$ String
"pprCall: unknown calling convention"
| Bool
otherwise
=
[(LocalReg, ForeignHint)] -> SDoc -> SDoc
ppr_assign [(LocalReg, ForeignHint)]
results (SDoc
ppr_fn forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc -> doc
parens ([SDoc] -> SDoc
commafy (forall a b. (a -> b) -> [a] -> [b]
map (CmmExpr, ForeignHint) -> SDoc
pprArg [(CmmExpr, ForeignHint)]
args))) forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
semi
where
ppr_assign :: [(LocalReg, ForeignHint)] -> SDoc -> SDoc
ppr_assign [] SDoc
rhs = SDoc
rhs
ppr_assign [(LocalReg
one,ForeignHint
hint)] SDoc
rhs
= LocalReg -> SDoc
pprLocalReg LocalReg
one forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
" = "
forall doc. IsLine doc => doc -> doc -> doc
<> ForeignHint -> CmmType -> SDoc
pprUnHint ForeignHint
hint (LocalReg -> CmmType
localRegType LocalReg
one) forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
rhs
ppr_assign [(LocalReg, ForeignHint)]
_other SDoc
_rhs = forall a. HasCallStack => String -> a
panic String
"pprCall: multiple results"
pprArg :: (CmmExpr, ForeignHint) -> SDoc
pprArg (CmmExpr
expr, ForeignHint
AddrHint)
= Platform -> SDoc -> CmmExpr -> SDoc
cCast Platform
platform (forall doc. IsLine doc => String -> doc
text String
"void *") CmmExpr
expr
pprArg (CmmExpr
expr, ForeignHint
SignedHint)
= Platform -> SDoc -> CmmExpr -> SDoc
cCast Platform
platform (Platform -> Width -> SDoc
machRep_S_CType Platform
platform forall a b. (a -> b) -> a -> b
$ CmmType -> Width
typeWidth forall a b. (a -> b) -> a -> b
$ Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
expr) CmmExpr
expr
pprArg (CmmExpr
expr, ForeignHint
_other)
= Platform -> CmmExpr -> SDoc
pprExpr Platform
platform CmmExpr
expr
pprUnHint :: ForeignHint -> CmmType -> SDoc
pprUnHint ForeignHint
AddrHint CmmType
rep = forall doc. IsLine doc => doc -> doc
parens (Platform -> CmmType -> SDoc
machRepCType Platform
platform CmmType
rep)
pprUnHint ForeignHint
SignedHint CmmType
rep = forall doc. IsLine doc => doc -> doc
parens (Platform -> CmmType -> SDoc
machRepCType Platform
platform CmmType
rep)
pprUnHint ForeignHint
_ CmmType
_ = forall doc. IsOutput doc => doc
empty
is_cishCC :: CCallConv -> Bool
is_cishCC :: CCallConv -> Bool
is_cishCC CCallConv
CCallConv = Bool
True
is_cishCC CCallConv
CApiConv = Bool
True
is_cishCC CCallConv
StdCallConv = Bool
True
is_cishCC CCallConv
PrimCallConv = Bool
False
is_cishCC CCallConv
JavaScriptCallConv = Bool
False
pprTempAndExternDecls :: Platform -> [CmmBlock] -> (SDoc, SDoc)
pprTempAndExternDecls :: Platform -> [CmmBlock] -> (SDoc, SDoc)
pprTempAndExternDecls Platform
platform [CmmBlock]
stmts
= (forall key a. UniqFM key a -> ([a] -> SDoc) -> SDoc
pprUFM (forall a. UniqSet a -> UniqFM a a
getUniqSet UniqSet LocalReg
temps) (forall doc. IsDoc doc => [doc] -> doc
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Platform -> LocalReg -> SDoc
pprTempDecl Platform
platform)),
forall doc. IsDoc doc => [doc] -> doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CLabel -> SDoc
pprExternDecl Platform
platform) (forall k a. Map k a -> [k]
Map.keys Map CLabel ()
lbls)))
where (UniqSet LocalReg
temps, Map CLabel ()
lbls) = TE () -> (UniqSet LocalReg, Map CLabel ())
runTE (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ CmmBlock -> TE ()
te_BB [CmmBlock]
stmts)
pprDataExterns :: Platform -> [CmmStatic] -> SDoc
pprDataExterns :: Platform -> [CmmStatic] -> SDoc
pprDataExterns Platform
platform [CmmStatic]
statics
= forall doc. IsDoc doc => [doc] -> doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CLabel -> SDoc
pprExternDecl Platform
platform) (forall k a. Map k a -> [k]
Map.keys Map CLabel ()
lbls))
where (UniqSet LocalReg
_, Map CLabel ()
lbls) = TE () -> (UniqSet LocalReg, Map CLabel ())
runTE (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ CmmStatic -> TE ()
te_Static [CmmStatic]
statics)
pprTempDecl :: Platform -> LocalReg -> SDoc
pprTempDecl :: Platform -> LocalReg -> SDoc
pprTempDecl Platform
platform l :: LocalReg
l@(LocalReg Unique
_ CmmType
rep)
= forall doc. IsLine doc => [doc] -> doc
hcat [ Platform -> CmmType -> SDoc
machRepCType Platform
platform CmmType
rep, forall doc. IsLine doc => doc
space, LocalReg -> SDoc
pprLocalReg LocalReg
l, forall doc. IsLine doc => doc
semi ]
pprExternDecl :: Platform -> CLabel -> SDoc
pprExternDecl :: Platform -> CLabel -> SDoc
pprExternDecl Platform
platform CLabel
lbl
| Bool -> Bool
not (CLabel -> Bool
needsCDecl CLabel
lbl) = forall doc. IsOutput doc => doc
empty
| Just Int
sz <- CLabel -> Maybe Int
foreignLabelStdcallInfo CLabel
lbl = Int -> SDoc
stdcall_decl Int
sz
| Bool
otherwise =
forall doc. IsLine doc => [doc] -> doc
hcat [ SDoc
visibility, forall {doc}. IsLine doc => CLabel -> doc
label_type CLabel
lbl , forall doc. IsLine doc => doc
lparen, forall doc. IsLine doc => Platform -> CLabel -> doc
pprCLabel Platform
platform CLabel
lbl, forall doc. IsLine doc => String -> doc
text String
");"
]
where
label_type :: CLabel -> doc
label_type CLabel
lbl | CLabel -> Bool
isBytesLabel CLabel
lbl = forall doc. IsLine doc => String -> doc
text String
"B_"
| CLabel -> Bool
isForeignLabel CLabel
lbl Bool -> Bool -> Bool
&& CLabel -> Bool
isCFunctionLabel CLabel
lbl
= forall doc. IsLine doc => String -> doc
text String
"FF_"
| CLabel -> Bool
isCFunctionLabel CLabel
lbl = forall doc. IsLine doc => String -> doc
text String
"F_"
| CLabel -> Bool
isStaticClosureLabel CLabel
lbl = forall doc. IsLine doc => String -> doc
text String
"C_"
| CLabel -> Bool
isSomeRODataLabel CLabel
lbl = forall doc. IsLine doc => String -> doc
text String
"RO_"
| Bool
otherwise = forall doc. IsLine doc => String -> doc
text String
"RW_"
visibility :: SDoc
visibility
| CLabel -> Bool
externallyVisibleCLabel CLabel
lbl = forall doc. IsLine doc => Char -> doc
char Char
'E'
| Bool
otherwise = forall doc. IsLine doc => Char -> doc
char Char
'I'
stdcall_decl :: Int -> SDoc
stdcall_decl Int
sz =
forall doc. IsLine doc => String -> doc
text String
"extern __attribute__((stdcall)) void " forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Platform -> CLabel -> doc
pprCLabel Platform
platform CLabel
lbl
forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc -> doc
parens ([SDoc] -> SDoc
commafy (forall a. Int -> a -> [a]
replicate (Int
sz forall a. Integral a => a -> a -> a
`quot` Platform -> Int
platformWordSizeInBytes Platform
platform) (Platform -> Width -> SDoc
machRep_U_CType Platform
platform (Platform -> Width
wordWidth Platform
platform))))
forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
semi
type TEState = (UniqSet LocalReg, Map CLabel ())
newtype TE a = TE' (State TEState a)
deriving stock (forall a b. a -> TE b -> TE a
forall a b. (a -> b) -> TE a -> TE b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> TE b -> TE a
$c<$ :: forall a b. a -> TE b -> TE a
fmap :: forall a b. (a -> b) -> TE a -> TE b
$cfmap :: forall a b. (a -> b) -> TE a -> TE b
Functor)
deriving (Functor TE
forall a. a -> TE a
forall a b. TE a -> TE b -> TE a
forall a b. TE a -> TE b -> TE b
forall a b. TE (a -> b) -> TE a -> TE b
forall a b c. (a -> b -> c) -> TE a -> TE b -> TE c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. TE a -> TE b -> TE a
$c<* :: forall a b. TE a -> TE b -> TE a
*> :: forall a b. TE a -> TE b -> TE b
$c*> :: forall a b. TE a -> TE b -> TE b
liftA2 :: forall a b c. (a -> b -> c) -> TE a -> TE b -> TE c
$cliftA2 :: forall a b c. (a -> b -> c) -> TE a -> TE b -> TE c
<*> :: forall a b. TE (a -> b) -> TE a -> TE b
$c<*> :: forall a b. TE (a -> b) -> TE a -> TE b
pure :: forall a. a -> TE a
$cpure :: forall a. a -> TE a
Applicative, Applicative TE
forall a. a -> TE a
forall a b. TE a -> TE b -> TE b
forall a b. TE a -> (a -> TE b) -> TE b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> TE a
$creturn :: forall a. a -> TE a
>> :: forall a b. TE a -> TE b -> TE b
$c>> :: forall a b. TE a -> TE b -> TE b
>>= :: forall a b. TE a -> (a -> TE b) -> TE b
$c>>= :: forall a b. TE a -> (a -> TE b) -> TE b
Monad) via State TEState
pattern TE :: (TEState -> (a, TEState)) -> TE a
pattern $bTE :: forall a.
((UniqSet LocalReg, Map CLabel ())
-> (a, (UniqSet LocalReg, Map CLabel ())))
-> TE a
$mTE :: forall {r} {a}.
TE a
-> (((UniqSet LocalReg, Map CLabel ())
-> (a, (UniqSet LocalReg, Map CLabel ())))
-> r)
-> ((# #) -> r)
-> r
TE f <- TE' (runState -> f)
where TE (UniqSet LocalReg, Map CLabel ())
-> (a, (UniqSet LocalReg, Map CLabel ()))
f = forall a. State (UniqSet LocalReg, Map CLabel ()) a -> TE a
TE' (forall s a. (s -> (a, s)) -> State s a
state (UniqSet LocalReg, Map CLabel ())
-> (a, (UniqSet LocalReg, Map CLabel ()))
f)
{-# COMPLETE TE #-}
te_lbl :: CLabel -> TE ()
te_lbl :: CLabel -> TE ()
te_lbl CLabel
lbl = forall a.
((UniqSet LocalReg, Map CLabel ())
-> (a, (UniqSet LocalReg, Map CLabel ())))
-> TE a
TE forall a b. (a -> b) -> a -> b
$ \(UniqSet LocalReg
temps,Map CLabel ()
lbls) -> ((), (UniqSet LocalReg
temps, forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert CLabel
lbl () Map CLabel ()
lbls))
te_temp :: LocalReg -> TE ()
te_temp :: LocalReg -> TE ()
te_temp LocalReg
r = forall a.
((UniqSet LocalReg, Map CLabel ())
-> (a, (UniqSet LocalReg, Map CLabel ())))
-> TE a
TE forall a b. (a -> b) -> a -> b
$ \(UniqSet LocalReg
temps,Map CLabel ()
lbls) -> ((), (forall a. Uniquable a => UniqSet a -> a -> UniqSet a
addOneToUniqSet UniqSet LocalReg
temps LocalReg
r, Map CLabel ()
lbls))
runTE :: TE () -> TEState
runTE :: TE () -> (UniqSet LocalReg, Map CLabel ())
runTE (TE (UniqSet LocalReg, Map CLabel ())
-> ((), (UniqSet LocalReg, Map CLabel ()))
m) = forall a b. (a, b) -> b
snd ((UniqSet LocalReg, Map CLabel ())
-> ((), (UniqSet LocalReg, Map CLabel ()))
m (forall a. UniqSet a
emptyUniqSet, forall k a. Map k a
Map.empty))
te_Static :: CmmStatic -> TE ()
te_Static :: CmmStatic -> TE ()
te_Static (CmmStaticLit CmmLit
lit) = CmmLit -> TE ()
te_Lit CmmLit
lit
te_Static CmmStatic
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
te_BB :: CmmBlock -> TE ()
te_BB :: CmmBlock -> TE ()
te_BB CmmBlock
block = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (e :: Extensibility) (x :: Extensibility).
CmmNode e x -> TE ()
te_Stmt (forall (n :: Extensibility -> Extensibility -> *).
Block n O O -> [n O O]
blockToList Block CmmNode O O
mid) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (e :: Extensibility) (x :: Extensibility).
CmmNode e x -> TE ()
te_Stmt CmmNode O C
last
where (CmmNode C O
_, Block CmmNode O O
mid, CmmNode O C
last) = forall (n :: Extensibility -> Extensibility -> *).
Block n C C -> (n C O, Block n O O, n O C)
blockSplit CmmBlock
block
te_Lit :: CmmLit -> TE ()
te_Lit :: CmmLit -> TE ()
te_Lit (CmmLabel CLabel
l) = CLabel -> TE ()
te_lbl CLabel
l
te_Lit (CmmLabelOff CLabel
l Int
_) = CLabel -> TE ()
te_lbl CLabel
l
te_Lit (CmmLabelDiffOff CLabel
l1 CLabel
_ Int
_ Width
_) = CLabel -> TE ()
te_lbl CLabel
l1
te_Lit CmmLit
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
te_Stmt :: CmmNode e x -> TE ()
te_Stmt :: forall (e :: Extensibility) (x :: Extensibility).
CmmNode e x -> TE ()
te_Stmt (CmmAssign CmmReg
r CmmExpr
e) = CmmReg -> TE ()
te_Reg CmmReg
r forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CmmExpr -> TE ()
te_Expr CmmExpr
e
te_Stmt (CmmStore CmmExpr
l CmmExpr
r AlignmentSpec
_) = CmmExpr -> TE ()
te_Expr CmmExpr
l forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CmmExpr -> TE ()
te_Expr CmmExpr
r
te_Stmt (CmmUnsafeForeignCall ForeignTarget
target [LocalReg]
rs [CmmExpr]
es)
= do ForeignTarget -> TE ()
te_Target ForeignTarget
target
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LocalReg -> TE ()
te_temp [LocalReg]
rs
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ CmmExpr -> TE ()
te_Expr [CmmExpr]
es
te_Stmt (CmmCondBranch CmmExpr
e BlockId
_ BlockId
_ Maybe Bool
_) = CmmExpr -> TE ()
te_Expr CmmExpr
e
te_Stmt (CmmSwitch CmmExpr
e SwitchTargets
_) = CmmExpr -> TE ()
te_Expr CmmExpr
e
te_Stmt (CmmCall { cml_target :: CmmNode O C -> CmmExpr
cml_target = CmmExpr
e }) = CmmExpr -> TE ()
te_Expr CmmExpr
e
te_Stmt CmmNode e x
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
te_Target :: ForeignTarget -> TE ()
te_Target :: ForeignTarget -> TE ()
te_Target (ForeignTarget CmmExpr
e ForeignConvention
_) = CmmExpr -> TE ()
te_Expr CmmExpr
e
te_Target (PrimTarget{}) = forall (m :: * -> *) a. Monad m => a -> m a
return ()
te_Expr :: CmmExpr -> TE ()
te_Expr :: CmmExpr -> TE ()
te_Expr (CmmLit CmmLit
lit) = CmmLit -> TE ()
te_Lit CmmLit
lit
te_Expr (CmmLoad CmmExpr
e CmmType
_ AlignmentSpec
_) = CmmExpr -> TE ()
te_Expr CmmExpr
e
te_Expr (CmmReg CmmReg
r) = CmmReg -> TE ()
te_Reg CmmReg
r
te_Expr (CmmMachOp MachOp
_ [CmmExpr]
es) = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ CmmExpr -> TE ()
te_Expr [CmmExpr]
es
te_Expr (CmmRegOff CmmReg
r Int
_) = CmmReg -> TE ()
te_Reg CmmReg
r
te_Expr (CmmStackSlot Area
_ Int
_) = forall a. HasCallStack => String -> a
panic String
"te_Expr: CmmStackSlot not supported!"
te_Reg :: CmmReg -> TE ()
te_Reg :: CmmReg -> TE ()
te_Reg (CmmLocal LocalReg
l) = LocalReg -> TE ()
te_temp LocalReg
l
te_Reg CmmReg
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
cCast :: Platform -> SDoc -> CmmExpr -> SDoc
cCast :: Platform -> SDoc -> CmmExpr -> SDoc
cCast Platform
platform SDoc
ty CmmExpr
expr = forall doc. IsLine doc => doc -> doc
parens SDoc
ty forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> CmmExpr -> SDoc
pprExpr1 Platform
platform CmmExpr
expr
cLoad :: Platform -> CmmExpr -> CmmType -> SDoc
cLoad :: Platform -> CmmExpr -> CmmType -> SDoc
cLoad Platform
platform CmmExpr
expr CmmType
rep
= if Arch -> Bool
bewareLoadStoreAlignment (Platform -> Arch
platformArch Platform
platform)
then let decl :: SDoc
decl = Platform -> CmmType -> SDoc
machRepCType Platform
platform CmmType
rep forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"x" forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
semi
struct :: SDoc
struct = forall doc. IsLine doc => String -> doc
text String
"struct" forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => doc -> doc
braces (SDoc
decl)
packed_attr :: SDoc
packed_attr = forall doc. IsLine doc => String -> doc
text String
"__attribute__((packed))"
cast :: SDoc
cast = forall doc. IsLine doc => doc -> doc
parens (SDoc
struct forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
packed_attr forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Char -> doc
char Char
'*')
in forall doc. IsLine doc => doc -> doc
parens (SDoc
cast forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> CmmExpr -> SDoc
pprExpr1 Platform
platform CmmExpr
expr) forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
"->x"
else forall doc. IsLine doc => Char -> doc
char Char
'*' forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc -> doc
parens (Platform -> SDoc -> CmmExpr -> SDoc
cCast Platform
platform (Platform -> CmmType -> SDoc
machRepPtrCType Platform
platform CmmType
rep) CmmExpr
expr)
where
bewareLoadStoreAlignment :: Arch -> Bool
bewareLoadStoreAlignment Arch
ArchAlpha = Bool
True
bewareLoadStoreAlignment Arch
ArchMipseb = Bool
True
bewareLoadStoreAlignment Arch
ArchMipsel = Bool
True
bewareLoadStoreAlignment (ArchARM {}) = Bool
True
bewareLoadStoreAlignment Arch
ArchAArch64 = Bool
True
bewareLoadStoreAlignment Arch
ArchUnknown = Bool
True
bewareLoadStoreAlignment Arch
_ = Bool
False
isCmmWordType :: Platform -> CmmType -> Bool
isCmmWordType :: Platform -> CmmType -> Bool
isCmmWordType Platform
platform CmmType
ty = Bool -> Bool
not (CmmType -> Bool
isFloatType CmmType
ty)
Bool -> Bool -> Bool
&& CmmType -> Width
typeWidth CmmType
ty forall a. Eq a => a -> a -> Bool
== Platform -> Width
wordWidth Platform
platform
machRepHintCType :: Platform -> CmmType -> ForeignHint -> SDoc
machRepHintCType :: Platform -> CmmType -> ForeignHint -> SDoc
machRepHintCType Platform
platform CmmType
rep = \case
ForeignHint
AddrHint -> forall doc. IsLine doc => String -> doc
text String
"void *"
ForeignHint
SignedHint -> Platform -> Width -> SDoc
machRep_S_CType Platform
platform (CmmType -> Width
typeWidth CmmType
rep)
ForeignHint
_other -> Platform -> CmmType -> SDoc
machRepCType Platform
platform CmmType
rep
machRepPtrCType :: Platform -> CmmType -> SDoc
machRepPtrCType :: Platform -> CmmType -> SDoc
machRepPtrCType Platform
platform CmmType
r
= if Platform -> CmmType -> Bool
isCmmWordType Platform
platform CmmType
r
then forall doc. IsLine doc => String -> doc
text String
"P_"
else Platform -> CmmType -> SDoc
machRepCType Platform
platform CmmType
r forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Char -> doc
char Char
'*'
machRepCType :: Platform -> CmmType -> SDoc
machRepCType :: Platform -> CmmType -> SDoc
machRepCType Platform
platform CmmType
ty
| CmmType -> Bool
isFloatType CmmType
ty = Width -> SDoc
machRep_F_CType Width
w
| Bool
otherwise = Platform -> Width -> SDoc
machRep_U_CType Platform
platform Width
w
where
w :: Width
w = CmmType -> Width
typeWidth CmmType
ty
machRep_F_CType :: Width -> SDoc
machRep_F_CType :: Width -> SDoc
machRep_F_CType Width
W32 = forall doc. IsLine doc => String -> doc
text String
"StgFloat"
machRep_F_CType Width
W64 = forall doc. IsLine doc => String -> doc
text String
"StgDouble"
machRep_F_CType Width
_ = forall a. HasCallStack => String -> a
panic String
"machRep_F_CType"
machRep_U_CType :: Platform -> Width -> SDoc
machRep_U_CType :: Platform -> Width -> SDoc
machRep_U_CType Platform
platform Width
w
= case Width
w of
Width
_ | Width
w forall a. Eq a => a -> a -> Bool
== Platform -> Width
wordWidth Platform
platform -> forall doc. IsLine doc => String -> doc
text String
"W_"
Width
W8 -> forall doc. IsLine doc => String -> doc
text String
"StgWord8"
Width
W16 -> forall doc. IsLine doc => String -> doc
text String
"StgWord16"
Width
W32 -> forall doc. IsLine doc => String -> doc
text String
"StgWord32"
Width
W64 -> forall doc. IsLine doc => String -> doc
text String
"StgWord64"
Width
_ -> forall a. HasCallStack => String -> a
panic String
"machRep_U_CType"
machRep_S_CType :: Platform -> Width -> SDoc
machRep_S_CType :: Platform -> Width -> SDoc
machRep_S_CType Platform
platform Width
w
= case Width
w of
Width
_ | Width
w forall a. Eq a => a -> a -> Bool
== Platform -> Width
wordWidth Platform
platform -> forall doc. IsLine doc => String -> doc
text String
"I_"
Width
W8 -> forall doc. IsLine doc => String -> doc
text String
"StgInt8"
Width
W16 -> forall doc. IsLine doc => String -> doc
text String
"StgInt16"
Width
W32 -> forall doc. IsLine doc => String -> doc
text String
"StgInt32"
Width
W64 -> forall doc. IsLine doc => String -> doc
text String
"StgInt64"
Width
_ -> forall a. HasCallStack => String -> a
panic String
"machRep_S_CType"
pprStringInCStyle :: ByteString -> SDoc
pprStringInCStyle :: ByteString -> SDoc
pprStringInCStyle ByteString
s = forall doc. IsLine doc => doc -> doc
doubleQuotes (forall doc. IsLine doc => String -> doc
text (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Word8 -> String
charToC (ByteString -> [Word8]
BS.unpack ByteString
s)))
floatToWord32 :: Rational -> CmmLit
floatToWord32 :: Rational -> CmmLit
floatToWord32 Rational
r = Integer -> Width -> CmmLit
CmmInt (forall a. Integral a => a -> Integer
toInteger (Float -> Word32
castFloatToWord32 (forall a. Fractional a => Rational -> a
fromRational Rational
r))) Width
W32
doubleToWord64 :: Rational -> CmmLit
doubleToWord64 :: Rational -> CmmLit
doubleToWord64 Rational
r = Integer -> Width -> CmmLit
CmmInt (forall a. Integral a => a -> Integer
toInteger (Double -> Word64
castDoubleToWord64 (forall a. Fractional a => Rational -> a
fromRational Rational
r))) Width
W64
wordShift :: Platform -> Int
wordShift :: Platform -> Int
wordShift Platform
platform = Width -> Int
widthInLog (Platform -> Width
wordWidth Platform
platform)
commafy :: [SDoc] -> SDoc
commafy :: [SDoc] -> SDoc
commafy [SDoc]
xs = forall doc. IsLine doc => [doc] -> doc
hsep forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate forall doc. IsLine doc => doc
comma [SDoc]
xs
pprHexVal :: Platform -> Integer -> Width -> SDoc
pprHexVal :: Platform -> Integer -> Width -> SDoc
pprHexVal Platform
platform Integer
w Width
rep = forall doc. IsLine doc => doc -> doc
parens SDoc
ctype forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
rawlit
where
rawlit :: SDoc
rawlit
| Integer
w forall a. Ord a => a -> a -> Bool
< Integer
0 = forall doc. IsLine doc => doc -> doc
parens (forall doc. IsLine doc => Char -> doc
char Char
'-' forall doc. IsLine doc => doc -> doc -> doc
<>
forall doc. IsLine doc => String -> doc
text String
"0x" forall doc. IsLine doc => doc -> doc -> doc
<> Integer -> SDoc
intToDoc (-Integer
w) forall doc. IsLine doc => doc -> doc -> doc
<> Width -> SDoc
repsuffix Width
rep)
| Bool
otherwise = forall doc. IsLine doc => String -> doc
text String
"0x" forall doc. IsLine doc => doc -> doc -> doc
<> Integer -> SDoc
intToDoc Integer
w forall doc. IsLine doc => doc -> doc -> doc
<> Width -> SDoc
repsuffix Width
rep
ctype :: SDoc
ctype = Platform -> Width -> SDoc
machRep_U_CType Platform
platform Width
rep
constants :: PlatformConstants
constants = Platform -> PlatformConstants
platformConstants Platform
platform
repsuffix :: Width -> SDoc
repsuffix Width
W64 =
if PlatformConstants -> Int
pc_CINT_SIZE PlatformConstants
constants forall a. Eq a => a -> a -> Bool
== Int
8 then forall doc. IsLine doc => Char -> doc
char Char
'U'
else if PlatformConstants -> Int
pc_CLONG_SIZE PlatformConstants
constants forall a. Eq a => a -> a -> Bool
== Int
8 then forall doc. IsLine doc => String -> doc
text String
"UL"
else if PlatformConstants -> Int
pc_CLONG_LONG_SIZE PlatformConstants
constants forall a. Eq a => a -> a -> Bool
== Int
8 then forall doc. IsLine doc => String -> doc
text String
"ULL"
else forall a. HasCallStack => String -> a
panic String
"pprHexVal: Can't find a 64-bit type"
repsuffix Width
_ = forall doc. IsLine doc => Char -> doc
char Char
'U'
intToDoc :: Integer -> SDoc
intToDoc :: Integer -> SDoc
intToDoc Integer
i = case Integer -> Integer
truncInt Integer
i of
Integer
0 -> forall doc. IsLine doc => Char -> doc
char Char
'0'
Integer
v -> forall {doc}. IsLine doc => Integer -> doc
go Integer
v
truncInt :: Integer -> Integer
truncInt :: Integer -> Integer
truncInt Integer
i =
case Width
rep of
Width
W8 -> Integer
i forall a. Integral a => a -> a -> a
`rem` (Integer
2forall a b. (Num a, Integral b) => a -> b -> a
^(Int
8 :: Int))
Width
W16 -> Integer
i forall a. Integral a => a -> a -> a
`rem` (Integer
2forall a b. (Num a, Integral b) => a -> b -> a
^(Int
16 :: Int))
Width
W32 -> Integer
i forall a. Integral a => a -> a -> a
`rem` (Integer
2forall a b. (Num a, Integral b) => a -> b -> a
^(Int
32 :: Int))
Width
W64 -> Integer
i forall a. Integral a => a -> a -> a
`rem` (Integer
2forall a b. (Num a, Integral b) => a -> b -> a
^(Int
64 :: Int))
Width
_ -> forall a. HasCallStack => String -> a
panic (String
"pprHexVal/truncInt: C backend can't encode "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Width
rep forall a. [a] -> [a] -> [a]
++ String
" literals")
go :: Integer -> doc
go Integer
0 = forall doc. IsOutput doc => doc
empty
go Integer
w' = Integer -> doc
go Integer
q forall doc. IsLine doc => doc -> doc -> doc
<> doc
dig
where
(Integer
q,Integer
r) = Integer
w' forall a. Integral a => a -> a -> (a, a)
`quotRem` Integer
16
dig :: doc
dig | Integer
r forall a. Ord a => a -> a -> Bool
< Integer
10 = forall doc. IsLine doc => Char -> doc
char (Int -> Char
chr (forall a. Num a => Integer -> a
fromInteger Integer
r forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
'0'))
| Bool
otherwise = forall doc. IsLine doc => Char -> doc
char (Int -> Char
chr (forall a. Num a => Integer -> a
fromInteger Integer
r forall a. Num a => a -> a -> a
- Int
10 forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
'a'))
pprCtorArray :: Platform -> InitOrFini -> [CLabel] -> SDoc
pprCtorArray :: Platform -> InitOrFini -> [CLabel] -> SDoc
pprCtorArray Platform
platform InitOrFini
initOrFini [CLabel]
lbls =
SDoc
decls
forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
"static __attribute__((" forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
attribute forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
"))"
forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
"void _hs_" forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
attribute forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
"()"
forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc -> doc
braces SDoc
body
where
body :: SDoc
body = forall doc. IsDoc doc => [doc] -> doc
vcat [ forall doc. IsLine doc => Platform -> CLabel -> doc
pprCLabel Platform
platform CLabel
lbl forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
" ();" | CLabel
lbl <- [CLabel]
lbls ]
decls :: SDoc
decls = forall doc. IsDoc doc => [doc] -> doc
vcat [ forall doc. IsLine doc => String -> doc
text String
"void" forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => Platform -> CLabel -> doc
pprCLabel Platform
platform CLabel
lbl forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
" (void);" | CLabel
lbl <- [CLabel]
lbls ]
attribute :: SDoc
attribute = case InitOrFini
initOrFini of
InitOrFini
IsInitArray -> forall doc. IsLine doc => String -> doc
text String
"constructor"
InitOrFini
IsFiniArray -> forall doc. IsLine doc => String -> doc
text String
"destructor"