summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'compiler')
-rw-r--r--compiler/cmm/CmmType.hs23
-rw-r--r--compiler/codeGen/CgInfoTbls.hs14
-rw-r--r--compiler/codeGen/CgPrimOp.hs12
-rw-r--r--compiler/codeGen/StgCmmLayout.hs14
-rw-r--r--compiler/codeGen/StgCmmPrim.hs44
5 files changed, 63 insertions, 44 deletions
diff --git a/compiler/cmm/CmmType.hs b/compiler/cmm/CmmType.hs
index 59455d3b54..d108e85431 100644
--- a/compiler/cmm/CmmType.hs
+++ b/compiler/cmm/CmmType.hs
@@ -20,6 +20,7 @@ where
import Constants
import FastString
import Outputable
+import Platform
import Data.Word
import Data.Int
@@ -95,10 +96,14 @@ f32 = cmmFloat W32
f64 = cmmFloat W64
-- CmmTypes of native word widths
-bWord, bHalfWord, gcWord :: CmmType
-bWord = cmmBits wordWidth
-bHalfWord = cmmBits halfWordWidth
-gcWord = CmmType GcPtrCat wordWidth
+bWord :: CmmType
+bWord = cmmBits wordWidth
+
+bHalfWord :: Platform -> CmmType
+bHalfWord platform = cmmBits (halfWordWidth platform)
+
+gcWord :: CmmType
+gcWord = CmmType GcPtrCat wordWidth
cInt, cLong :: CmmType
cInt = cmmBits cIntWidth
@@ -155,14 +160,16 @@ mrStr W80 = sLit("W80")
-------- Common Widths ------------
-wordWidth, halfWordWidth :: Width
+wordWidth :: Width
wordWidth | wORD_SIZE == 4 = W32
| wORD_SIZE == 8 = W64
| otherwise = panic "MachOp.wordRep: Unknown word size"
-halfWordWidth | wORD_SIZE == 4 = W16
- | wORD_SIZE == 8 = W32
- | otherwise = panic "MachOp.halfWordRep: Unknown word size"
+halfWordWidth :: Platform -> Width
+halfWordWidth _
+ | wORD_SIZE == 4 = W16
+ | wORD_SIZE == 8 = W32
+ | otherwise = panic "MachOp.halfWordRep: Unknown word size"
halfWordMask :: Integer
halfWordMask | wORD_SIZE == 4 = 0xFFFF
diff --git a/compiler/codeGen/CgInfoTbls.hs b/compiler/codeGen/CgInfoTbls.hs
index 3f8e6c0222..ceccec2415 100644
--- a/compiler/codeGen/CgInfoTbls.hs
+++ b/compiler/codeGen/CgInfoTbls.hs
@@ -294,16 +294,18 @@ getConstrTag :: DynFlags -> CmmExpr -> CmmExpr
-- This lives in the SRT field of the info table
-- (constructors don't need SRTs).
getConstrTag dflags closure_ptr
- = CmmMachOp (MO_UU_Conv halfWordWidth wordWidth) [infoTableConstrTag dflags info_table]
+ = CmmMachOp (MO_UU_Conv (halfWordWidth platform) wordWidth) [infoTableConstrTag dflags info_table]
where
+ platform = targetPlatform dflags
info_table = infoTable dflags (closureInfoPtr closure_ptr)
cmmGetClosureType :: DynFlags -> CmmExpr -> CmmExpr
-- Takes a closure pointer, and return the closure type
-- obtained from the info table
cmmGetClosureType dflags closure_ptr
- = CmmMachOp (MO_UU_Conv halfWordWidth wordWidth) [infoTableClosureType dflags info_table]
+ = CmmMachOp (MO_UU_Conv (halfWordWidth platform) wordWidth) [infoTableClosureType dflags info_table]
where
+ platform = targetPlatform dflags
info_table = infoTable dflags (closureInfoPtr closure_ptr)
infoTable :: DynFlags -> CmmExpr -> CmmExpr
@@ -323,21 +325,21 @@ infoTableSrtBitmap :: DynFlags -> CmmExpr -> CmmExpr
-- Takes an info table pointer (from infoTable) and returns the srt_bitmap
-- field of the info table
infoTableSrtBitmap dflags info_tbl
- = CmmLoad (cmmOffsetB info_tbl (stdSrtBitmapOffset dflags)) bHalfWord
+ = CmmLoad (cmmOffsetB info_tbl (stdSrtBitmapOffset dflags)) (bHalfWord (targetPlatform dflags))
infoTableClosureType :: DynFlags -> CmmExpr -> CmmExpr
-- Takes an info table pointer (from infoTable) and returns the closure type
-- field of the info table.
infoTableClosureType dflags info_tbl
- = CmmLoad (cmmOffsetB info_tbl (stdClosureTypeOffset dflags)) bHalfWord
+ = CmmLoad (cmmOffsetB info_tbl (stdClosureTypeOffset dflags)) (bHalfWord (targetPlatform dflags))
infoTablePtrs :: DynFlags -> CmmExpr -> CmmExpr
infoTablePtrs dflags info_tbl
- = CmmLoad (cmmOffsetB info_tbl (stdPtrsOffset dflags)) bHalfWord
+ = CmmLoad (cmmOffsetB info_tbl (stdPtrsOffset dflags)) (bHalfWord (targetPlatform dflags))
infoTableNonPtrs :: DynFlags -> CmmExpr -> CmmExpr
infoTableNonPtrs dflags info_tbl
- = CmmLoad (cmmOffsetB info_tbl (stdNonPtrsOffset dflags)) bHalfWord
+ = CmmLoad (cmmOffsetB info_tbl (stdNonPtrsOffset dflags)) (bHalfWord (targetPlatform dflags))
funInfoTable :: DynFlags -> CmmExpr -> CmmExpr
-- Takes the info pointer of a function,
diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs
index 88d60b654d..1f572bf486 100644
--- a/compiler/codeGen/CgPrimOp.hs
+++ b/compiler/codeGen/CgPrimOp.hs
@@ -544,7 +544,9 @@ emitPrimOp [res_q, res_r] WordQuotRem2Op [arg_x_high, arg_x_low, arg_y] _
stmtC stmt
emitPrimOp [res_h, res_l] WordAdd2Op [arg_x, arg_y] _
- = do r1 <- newLocalReg (cmmExprType arg_x)
+ = do dflags <- getDynFlags
+ let platform = targetPlatform dflags
+ r1 <- newLocalReg (cmmExprType arg_x)
r2 <- newLocalReg (cmmExprType arg_x)
-- This generic implementation is very simple and slow. We might
-- well be able to do better, but for now this at least works.
@@ -564,7 +566,7 @@ emitPrimOp [res_h, res_l] WordAdd2Op [arg_x, arg_y] _
bottomHalf x = CmmMachOp (MO_And wordWidth) [x, hwm]
add x y = CmmMachOp (MO_Add wordWidth) [x, y]
or x y = CmmMachOp (MO_Or wordWidth) [x, y]
- hww = CmmLit (CmmInt (fromIntegral (widthInBits halfWordWidth))
+ hww = CmmLit (CmmInt (fromIntegral (widthInBits (halfWordWidth platform)))
wordWidth)
hwm = CmmLit (CmmInt halfWordMask wordWidth)
stmt = CmmCall (CmmPrim (MO_Add2 wordWidth) (Just genericImpl))
@@ -575,7 +577,9 @@ emitPrimOp [res_h, res_l] WordAdd2Op [arg_x, arg_y] _
CmmMayReturn
stmtC stmt
emitPrimOp [res_h, res_l] WordMul2Op [arg_x, arg_y] _
- = do let t = cmmExprType arg_x
+ = do dflags <- getDynFlags
+ let platform = targetPlatform dflags
+ t = cmmExprType arg_x
xlyl <- liftM CmmLocal $ newLocalReg t
xlyh <- liftM CmmLocal $ newLocalReg t
xhyl <- liftM CmmLocal $ newLocalReg t
@@ -608,7 +612,7 @@ emitPrimOp [res_h, res_l] WordMul2Op [arg_x, arg_y] _
sum = foldl1 add
mul x y = CmmMachOp (MO_Mul wordWidth) [x, y]
or x y = CmmMachOp (MO_Or wordWidth) [x, y]
- hww = CmmLit (CmmInt (fromIntegral (widthInBits halfWordWidth))
+ hww = CmmLit (CmmInt (fromIntegral (widthInBits (halfWordWidth platform)))
wordWidth)
hwm = CmmLit (CmmInt halfWordMask wordWidth)
stmt = CmmCall (CmmPrim (MO_U_Mul2 wordWidth) (Just genericImpl))
diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs
index e20e4a29bd..3f29bf67ec 100644
--- a/compiler/codeGen/StgCmmLayout.hs
+++ b/compiler/codeGen/StgCmmLayout.hs
@@ -609,16 +609,18 @@ getConstrTag :: DynFlags -> CmmExpr -> CmmExpr
-- This lives in the SRT field of the info table
-- (constructors don't need SRTs).
getConstrTag dflags closure_ptr
- = CmmMachOp (MO_UU_Conv halfWordWidth wordWidth) [infoTableConstrTag dflags info_table]
+ = CmmMachOp (MO_UU_Conv (halfWordWidth platform) wordWidth) [infoTableConstrTag dflags info_table]
where
+ platform = targetPlatform dflags
info_table = infoTable dflags (closureInfoPtr closure_ptr)
cmmGetClosureType :: DynFlags -> CmmExpr -> CmmExpr
-- Takes a closure pointer, and return the closure type
-- obtained from the info table
cmmGetClosureType dflags closure_ptr
- = CmmMachOp (MO_UU_Conv halfWordWidth wordWidth) [infoTableClosureType dflags info_table]
+ = CmmMachOp (MO_UU_Conv (halfWordWidth platform) wordWidth) [infoTableClosureType dflags info_table]
where
+ platform = targetPlatform dflags
info_table = infoTable dflags (closureInfoPtr closure_ptr)
infoTable :: DynFlags -> CmmExpr -> CmmExpr
@@ -638,21 +640,21 @@ infoTableSrtBitmap :: DynFlags -> CmmExpr -> CmmExpr
-- Takes an info table pointer (from infoTable) and returns the srt_bitmap
-- field of the info table
infoTableSrtBitmap dflags info_tbl
- = CmmLoad (cmmOffsetB info_tbl (stdSrtBitmapOffset dflags)) bHalfWord
+ = CmmLoad (cmmOffsetB info_tbl (stdSrtBitmapOffset dflags)) (bHalfWord (targetPlatform dflags))
infoTableClosureType :: DynFlags -> CmmExpr -> CmmExpr
-- Takes an info table pointer (from infoTable) and returns the closure type
-- field of the info table.
infoTableClosureType dflags info_tbl
- = CmmLoad (cmmOffsetB info_tbl (stdClosureTypeOffset dflags)) bHalfWord
+ = CmmLoad (cmmOffsetB info_tbl (stdClosureTypeOffset dflags)) (bHalfWord (targetPlatform dflags))
infoTablePtrs :: DynFlags -> CmmExpr -> CmmExpr
infoTablePtrs dflags info_tbl
- = CmmLoad (cmmOffsetB info_tbl (stdPtrsOffset dflags)) bHalfWord
+ = CmmLoad (cmmOffsetB info_tbl (stdPtrsOffset dflags)) (bHalfWord (targetPlatform dflags))
infoTableNonPtrs :: DynFlags -> CmmExpr -> CmmExpr
infoTableNonPtrs dflags info_tbl
- = CmmLoad (cmmOffsetB info_tbl (stdNonPtrsOffset dflags)) bHalfWord
+ = CmmLoad (cmmOffsetB info_tbl (stdNonPtrsOffset dflags)) (bHalfWord (targetPlatform dflags))
funInfoTable :: DynFlags -> CmmExpr -> CmmExpr
-- Takes the info pointer of a function,
diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs
index 6c6005e88a..07b8ddf406 100644
--- a/compiler/codeGen/StgCmmPrim.hs
+++ b/compiler/codeGen/StgCmmPrim.hs
@@ -630,8 +630,18 @@ genericWordQuotRem2Op _ _ = panic "genericWordQuotRem2Op"
genericWordAdd2Op :: GenericOp
genericWordAdd2Op [res_h, res_l] [arg_x, arg_y]
- = do r1 <- newTemp (cmmExprType arg_x)
+ = do dflags <- getDynFlags
+ let platform = targetPlatform dflags
+ r1 <- newTemp (cmmExprType arg_x)
r2 <- newTemp (cmmExprType arg_x)
+ let topHalf x = CmmMachOp (MO_U_Shr wordWidth) [x, hww]
+ toTopHalf x = CmmMachOp (MO_Shl wordWidth) [x, hww]
+ bottomHalf x = CmmMachOp (MO_And wordWidth) [x, hwm]
+ add x y = CmmMachOp (MO_Add wordWidth) [x, y]
+ or x y = CmmMachOp (MO_Or wordWidth) [x, y]
+ hww = CmmLit (CmmInt (fromIntegral (widthInBits (halfWordWidth platform)))
+ wordWidth)
+ hwm = CmmLit (CmmInt halfWordMask wordWidth)
emit $ catAGraphs
[mkAssign (CmmLocal r1)
(add (bottomHalf arg_x) (bottomHalf arg_y)),
@@ -643,25 +653,29 @@ genericWordAdd2Op [res_h, res_l] [arg_x, arg_y]
mkAssign (CmmLocal res_l)
(or (toTopHalf (CmmReg (CmmLocal r2)))
(bottomHalf (CmmReg (CmmLocal r1))))]
- where topHalf x = CmmMachOp (MO_U_Shr wordWidth) [x, hww]
- toTopHalf x = CmmMachOp (MO_Shl wordWidth) [x, hww]
- bottomHalf x = CmmMachOp (MO_And wordWidth) [x, hwm]
- add x y = CmmMachOp (MO_Add wordWidth) [x, y]
- or x y = CmmMachOp (MO_Or wordWidth) [x, y]
- hww = CmmLit (CmmInt (fromIntegral (widthInBits halfWordWidth))
- wordWidth)
- hwm = CmmLit (CmmInt halfWordMask wordWidth)
genericWordAdd2Op _ _ = panic "genericWordAdd2Op"
genericWordMul2Op :: GenericOp
genericWordMul2Op [res_h, res_l] [arg_x, arg_y]
- = do let t = cmmExprType arg_x
+ = do dflags <- getDynFlags
+ let platform = targetPlatform dflags
+ t = cmmExprType arg_x
xlyl <- liftM CmmLocal $ newTemp t
xlyh <- liftM CmmLocal $ newTemp t
xhyl <- liftM CmmLocal $ newTemp t
r <- liftM CmmLocal $ newTemp t
-- This generic implementation is very simple and slow. We might
-- well be able to do better, but for now this at least works.
+ let topHalf x = CmmMachOp (MO_U_Shr wordWidth) [x, hww]
+ toTopHalf x = CmmMachOp (MO_Shl wordWidth) [x, hww]
+ bottomHalf x = CmmMachOp (MO_And wordWidth) [x, hwm]
+ add x y = CmmMachOp (MO_Add wordWidth) [x, y]
+ sum = foldl1 add
+ mul x y = CmmMachOp (MO_Mul wordWidth) [x, y]
+ or x y = CmmMachOp (MO_Or wordWidth) [x, y]
+ hww = CmmLit (CmmInt (fromIntegral (widthInBits (halfWordWidth platform)))
+ wordWidth)
+ hwm = CmmLit (CmmInt halfWordMask wordWidth)
emit $ catAGraphs
[mkAssign xlyl
(mul (bottomHalf arg_x) (bottomHalf arg_y)),
@@ -681,16 +695,6 @@ genericWordMul2Op [res_h, res_l] [arg_x, arg_y]
topHalf (CmmReg xhyl),
topHalf (CmmReg xlyh),
topHalf (CmmReg r)])]
- where topHalf x = CmmMachOp (MO_U_Shr wordWidth) [x, hww]
- toTopHalf x = CmmMachOp (MO_Shl wordWidth) [x, hww]
- bottomHalf x = CmmMachOp (MO_And wordWidth) [x, hwm]
- add x y = CmmMachOp (MO_Add wordWidth) [x, y]
- sum = foldl1 add
- mul x y = CmmMachOp (MO_Mul wordWidth) [x, y]
- or x y = CmmMachOp (MO_Or wordWidth) [x, y]
- hww = CmmLit (CmmInt (fromIntegral (widthInBits halfWordWidth))
- wordWidth)
- hwm = CmmLit (CmmInt halfWordMask wordWidth)
genericWordMul2Op _ _ = panic "genericWordMul2Op"
-- These PrimOps are NOPs in Cmm
View Lorry Controller Status