projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Print infix function definitions correctly in HsSyn
[ghc-hetmet.git]
/
compiler
/
nativeGen
/
MachCodeGen.hs
diff --git
a/compiler/nativeGen/MachCodeGen.hs
b/compiler/nativeGen/MachCodeGen.hs
index
cc94074
..
eb3a5cd
100644
(file)
--- a/
compiler/nativeGen/MachCodeGen.hs
+++ b/
compiler/nativeGen/MachCodeGen.hs
@@
-42,8
+42,10
@@
import FastTypes ( isFastTrue )
import Constants ( wORD_SIZE )
#ifdef DEBUG
import Constants ( wORD_SIZE )
#ifdef DEBUG
+import Outputable ( assertPanic )
import Debug.Trace ( trace )
#endif
import Debug.Trace ( trace )
#endif
+import Debug.Trace ( trace )
import Control.Monad ( mapAndUnzipM )
import Data.Maybe ( fromJust )
import Control.Monad ( mapAndUnzipM )
import Data.Maybe ( fromJust )
@@
-119,7
+121,7
@@
stmtToInstrs stmt = case stmt of
| otherwise -> assignMem_IntCode kind addr src
where kind = cmmExprRep src
| otherwise -> assignMem_IntCode kind addr src
where kind = cmmExprRep src
- CmmCall target result_regs args _
+ CmmCall target result_regs args _ _
-> genCCall target result_regs args
CmmBranch id -> genBranch id
-> genCCall target result_regs args
CmmBranch id -> genBranch id
@@
-784,7
+786,8
@@
getRegister leaf
getRegister (CmmLit (CmmFloat f F32)) = do
lbl <- getNewLabelNat
getRegister (CmmLit (CmmFloat f F32)) = do
lbl <- getNewLabelNat
- dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl
+ dflags <- getDynFlagsNat
+ dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
Amode addr addr_code <- getAmode dynRef
let code dst =
LDATA ReadOnlyData
Amode addr addr_code <- getAmode dynRef
let code dst =
LDATA ReadOnlyData
@@
-807,7
+810,8
@@
getRegister (CmmLit (CmmFloat d F64))
| otherwise = do
lbl <- getNewLabelNat
| otherwise = do
lbl <- getNewLabelNat
- dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl
+ dflags <- getDynFlagsNat
+ dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
Amode addr addr_code <- getAmode dynRef
let code dst =
LDATA ReadOnlyData
Amode addr addr_code <- getAmode dynRef
let code dst =
LDATA ReadOnlyData
@@
-1727,7
+1731,8
@@
getRegister (CmmLit (CmmInt i rep))
getRegister (CmmLit (CmmFloat f frep)) = do
lbl <- getNewLabelNat
getRegister (CmmLit (CmmFloat f frep)) = do
lbl <- getNewLabelNat
- dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl
+ dflags <- getDynFlagsNat
+ dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
Amode addr addr_code <- getAmode dynRef
let code dst =
LDATA ReadOnlyData [CmmDataLabel lbl,
Amode addr addr_code <- getAmode dynRef
let code dst =
LDATA ReadOnlyData [CmmDataLabel lbl,
@@
-3084,11
+3089,11
@@
genCCall target dest_regs args = do
(callinsns,cconv) <-
case target of
-- CmmPrim -> ...
(callinsns,cconv) <-
case target of
-- CmmPrim -> ...
- CmmForeignCall (CmmLit (CmmLabel lbl)) conv
+ CmmCallee (CmmLit (CmmLabel lbl)) conv
-> -- ToDo: stdcall arg sizes
return (unitOL (CALL (Left fn_imm) []), conv)
where fn_imm = ImmCLbl lbl
-> -- ToDo: stdcall arg sizes
return (unitOL (CALL (Left fn_imm) []), conv)
where fn_imm = ImmCLbl lbl
- CmmForeignCall expr conv
+ CmmCallee expr conv
-> do (dyn_c, dyn_r, dyn_rep) <- get_op expr
ASSERT(dyn_rep == I32)
return (dyn_c `snocOL` CALL (Right dyn_r) [], conv)
-> do (dyn_c, dyn_r, dyn_rep) <- get_op expr
ASSERT(dyn_rep == I32)
return (dyn_c `snocOL` CALL (Right dyn_r) [], conv)
@@
-3195,18
+3200,19
@@
outOfLineFloatOp :: CallishMachOp -> CmmFormal -> CmmActuals
-> NatM InstrBlock
outOfLineFloatOp mop res args
= do
-> NatM InstrBlock
outOfLineFloatOp mop res args
= do
- targetExpr <- cmmMakeDynamicReference addImportNat CallReference lbl
- let target = CmmForeignCall targetExpr CCallConv
+ dflags <- getDynFlagsNat
+ targetExpr <- cmmMakeDynamicReference dflags addImportNat CallReference lbl
+ let target = CmmCallee targetExpr CCallConv
if localRegRep res == F64
then
if localRegRep res == F64
then
- stmtToInstrs (CmmCall target [(res,FloatHint)] args CmmUnsafe)
+ stmtToInstrs (CmmCall target [(res,FloatHint)] args CmmUnsafe CmmMayReturn)
else do
uq <- getUniqueNat
let
tmp = LocalReg uq F64 KindNonPtr
-- in
else do
uq <- getUniqueNat
let
tmp = LocalReg uq F64 KindNonPtr
-- in
- code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)] args CmmUnsafe)
+ code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)] args CmmUnsafe CmmMayReturn)
code2 <- stmtToInstrs (CmmAssign (CmmLocal res) (CmmReg (CmmLocal tmp)))
return (code1 `appOL` code2)
where
code2 <- stmtToInstrs (CmmAssign (CmmLocal res) (CmmReg (CmmLocal tmp)))
return (code1 `appOL` code2)
where
@@
-3301,11
+3307,11
@@
genCCall target dest_regs args = do
(callinsns,cconv) <-
case target of
-- CmmPrim -> ...
(callinsns,cconv) <-
case target of
-- CmmPrim -> ...
- CmmForeignCall (CmmLit (CmmLabel lbl)) conv
+ CmmCallee (CmmLit (CmmLabel lbl)) conv
-> -- ToDo: stdcall arg sizes
return (unitOL (CALL (Left fn_imm) arg_regs), conv)
where fn_imm = ImmCLbl lbl
-> -- ToDo: stdcall arg sizes
return (unitOL (CALL (Left fn_imm) arg_regs), conv)
where fn_imm = ImmCLbl lbl
- CmmForeignCall expr conv
+ CmmCallee expr conv
-> do (dyn_r, dyn_c) <- getSomeReg expr
return (dyn_c `snocOL` CALL (Right dyn_r) arg_regs, conv)
-> do (dyn_r, dyn_c) <- getSomeReg expr
return (dyn_c `snocOL` CALL (Right dyn_r) arg_regs, conv)
@@
-3455,9
+3461,9
@@
genCCall target dest_regs argsAndHints = do
vregs = concat vregss
-- deal with static vs dynamic call targets
callinsns <- (case target of
vregs = concat vregss
-- deal with static vs dynamic call targets
callinsns <- (case target of
- CmmForeignCall (CmmLit (CmmLabel lbl)) conv -> do
+ CmmCallee (CmmLit (CmmLabel lbl)) conv -> do
return (unitOL (CALL (Left (litToImm (CmmLabel lbl))) n_argRegs_used False))
return (unitOL (CALL (Left (litToImm (CmmLabel lbl))) n_argRegs_used False))
- CmmForeignCall expr conv -> do
+ CmmCallee expr conv -> do
(dyn_c, [dyn_r]) <- arg_to_int_vregs expr
return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False)
CmmPrim mop -> do
(dyn_c, [dyn_r]) <- arg_to_int_vregs expr
return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False)
CmmPrim mop -> do
@@
-3551,7
+3557,8
@@
genCCall target dest_regs argsAndHints = do
)
outOfLineFloatOp mop =
do
)
outOfLineFloatOp mop =
do
- mopExpr <- cmmMakeDynamicReference addImportNat CallReference $
+ dflags <- getDynFlagsNat
+ mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference $
mkForeignLabel functionName Nothing True
let mopLabelOrExpr = case mopExpr of
CmmLit (CmmLabel lbl) -> Left lbl
mkForeignLabel functionName Nothing True
let mopLabelOrExpr = case mopExpr of
CmmLit (CmmLabel lbl) -> Left lbl
@@
-3651,8
+3658,8
@@
genCCall target dest_regs argsAndHints
(toOL []) []
(labelOrExpr, reduceToF32) <- case target of
(toOL []) []
(labelOrExpr, reduceToF32) <- case target of
- CmmForeignCall (CmmLit (CmmLabel lbl)) conv -> return (Left lbl, False)
- CmmForeignCall expr conv -> return (Right expr, False)
+ CmmCallee (CmmLit (CmmLabel lbl)) conv -> return (Left lbl, False)
+ CmmCallee expr conv -> return (Right expr, False)
CmmPrim mop -> outOfLineFloatOp mop
let codeBefore = move_sp_down finalStack `appOL` passArgumentsCode
CmmPrim mop -> outOfLineFloatOp mop
let codeBefore = move_sp_down finalStack `appOL` passArgumentsCode
@@
-3806,7
+3813,8
@@
genCCall target dest_regs argsAndHints
outOfLineFloatOp mop =
do
outOfLineFloatOp mop =
do
- mopExpr <- cmmMakeDynamicReference addImportNat CallReference $
+ dflags <- getDynFlagsNat
+ mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference $
mkForeignLabel functionName Nothing True
let mopLabelOrExpr = case mopExpr of
CmmLit (CmmLabel lbl) -> Left lbl
mkForeignLabel functionName Nothing True
let mopLabelOrExpr = case mopExpr of
CmmLit (CmmLabel lbl) -> Left lbl
@@
-3866,7
+3874,8
@@
genSwitch expr ids
= do
(reg,e_code) <- getSomeReg expr
lbl <- getNewLabelNat
= do
(reg,e_code) <- getSomeReg expr
lbl <- getNewLabelNat
- dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl
+ dflags <- getDynFlagsNat
+ dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
(tableReg,t_code) <- getSomeReg $ dynRef
let
jumpTable = map jumpTableEntryRel ids
(tableReg,t_code) <- getSomeReg $ dynRef
let
jumpTable = map jumpTableEntryRel ids
@@
-3920,7
+3929,8
@@
genSwitch expr ids
(reg,e_code) <- getSomeReg expr
tmp <- getNewRegNat I32
lbl <- getNewLabelNat
(reg,e_code) <- getSomeReg expr
tmp <- getNewRegNat I32
lbl <- getNewLabelNat
- dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl
+ dflags <- getDynFlagsNat
+ dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
(tableReg,t_code) <- getSomeReg $ dynRef
let
jumpTable = map jumpTableEntryRel ids
(tableReg,t_code) <- getSomeReg $ dynRef
let
jumpTable = map jumpTableEntryRel ids
@@
-4761,7
+4771,8
@@
coerceInt2FP fromRep toRep x = do
lbl <- getNewLabelNat
itmp <- getNewRegNat I32
ftmp <- getNewRegNat F64
lbl <- getNewLabelNat
itmp <- getNewRegNat I32
ftmp <- getNewRegNat F64
- dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl
+ dflags <- getDynFlagsNat
+ dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
Amode addr addr_code <- getAmode dynRef
let
code' dst = code `appOL` maybe_exts `appOL` toOL [
Amode addr addr_code <- getAmode dynRef
let
code' dst = code `appOL` maybe_exts `appOL` toOL [