projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Fix #2838: we should narrow a CmmInt before converting to ImmInteger
[ghc-hetmet.git]
/
compiler
/
nativeGen
/
MachRegs.lhs
diff --git
a/compiler/nativeGen/MachRegs.lhs
b/compiler/nativeGen/MachRegs.lhs
index
2e578c0
..
0c21f21
100644
(file)
--- a/
compiler/nativeGen/MachRegs.lhs
+++ b/
compiler/nativeGen/MachRegs.lhs
@@
-96,6
+96,7
@@
module MachRegs (
#include "../includes/MachRegs.h"
#include "../includes/MachRegs.h"
+import BlockId
import Cmm
import CgUtils ( get_GlobalReg_addr )
import CLabel ( CLabel, mkMainCapabilityLabel )
import Cmm
import CgUtils ( get_GlobalReg_addr )
import CLabel ( CLabel, mkMainCapabilityLabel )
@@
-228,7
+229,10
@@
data Imm
strImmLit s = ImmLit (text s)
litToImm :: CmmLit -> Imm
strImmLit s = ImmLit (text s)
litToImm :: CmmLit -> Imm
-litToImm (CmmInt i _) = ImmInteger i
+litToImm (CmmInt i w) = ImmInteger (narrowS w i)
+ -- narrow to the width: a CmmInt might be out of
+ -- range, but we assume that ImmInteger only contains
+ -- in-range values. A signed value should be fine here.
litToImm (CmmFloat f W32) = ImmFloat f
litToImm (CmmFloat f W64) = ImmDouble f
litToImm (CmmLabel l) = ImmCLbl l
litToImm (CmmFloat f W32) = ImmFloat f
litToImm (CmmFloat f W64) = ImmDouble f
litToImm (CmmLabel l) = ImmCLbl l
@@
-237,6
+241,7
@@
litToImm (CmmLabelDiffOff l1 l2 off)
= ImmConstantSum
(ImmConstantDiff (ImmCLbl l1) (ImmCLbl l2))
(ImmInt off)
= ImmConstantSum
(ImmConstantDiff (ImmCLbl l1) (ImmCLbl l2))
(ImmInt off)
+litToImm (CmmBlock id) = ImmCLbl (infoTblLbl id)
-- -----------------------------------------------------------------------------
-- Addressing modes
-- -----------------------------------------------------------------------------
-- Addressing modes
@@
-614,7
+619,6
@@
trivColorable :: RegClass -> UniqSet Reg -> UniqSet Reg -> Bool
trivColorable classN conflicts exclusions
= {-# SCC "trivColorable" #-}
let
trivColorable classN conflicts exclusions
= {-# SCC "trivColorable" #-}
let
- {-# INLINE isSqueesed #-}
isSqueesed cI cF ufm
= case ufm of
NodeUFM _ _ left right
isSqueesed cI cF ufm
= case ufm of
NodeUFM _ _ left right