Commit 26ebd1b7 authored by ian@well-typed.com's avatar ian@well-typed.com
Browse files

Pass Platform down to halfWordWidth

We don't actually use it yet
parent da5b7ba3
...@@ -20,6 +20,7 @@ where ...@@ -20,6 +20,7 @@ where
import Constants import Constants
import FastString import FastString
import Outputable import Outputable
import Platform
import Data.Word import Data.Word
import Data.Int import Data.Int
...@@ -95,10 +96,14 @@ f32 = cmmFloat W32 ...@@ -95,10 +96,14 @@ f32 = cmmFloat W32
f64 = cmmFloat W64 f64 = cmmFloat W64
-- CmmTypes of native word widths -- CmmTypes of native word widths
bWord, bHalfWord, gcWord :: CmmType bWord :: CmmType
bWord = cmmBits wordWidth bWord = cmmBits wordWidth
bHalfWord = cmmBits halfWordWidth
gcWord = CmmType GcPtrCat wordWidth bHalfWord :: Platform -> CmmType
bHalfWord platform = cmmBits (halfWordWidth platform)
gcWord :: CmmType
gcWord = CmmType GcPtrCat wordWidth
cInt, cLong :: CmmType cInt, cLong :: CmmType
cInt = cmmBits cIntWidth cInt = cmmBits cIntWidth
...@@ -155,14 +160,16 @@ mrStr W80 = sLit("W80") ...@@ -155,14 +160,16 @@ mrStr W80 = sLit("W80")
-------- Common Widths ------------ -------- Common Widths ------------
wordWidth, halfWordWidth :: Width wordWidth :: Width
wordWidth | wORD_SIZE == 4 = W32 wordWidth | wORD_SIZE == 4 = W32
| wORD_SIZE == 8 = W64 | wORD_SIZE == 8 = W64
| otherwise = panic "MachOp.wordRep: Unknown word size" | otherwise = panic "MachOp.wordRep: Unknown word size"
halfWordWidth | wORD_SIZE == 4 = W16 halfWordWidth :: Platform -> Width
| wORD_SIZE == 8 = W32 halfWordWidth _
| otherwise = panic "MachOp.halfWordRep: Unknown word size" | wORD_SIZE == 4 = W16
| wORD_SIZE == 8 = W32
| otherwise = panic "MachOp.halfWordRep: Unknown word size"
halfWordMask :: Integer halfWordMask :: Integer
halfWordMask | wORD_SIZE == 4 = 0xFFFF halfWordMask | wORD_SIZE == 4 = 0xFFFF
......
...@@ -294,16 +294,18 @@ getConstrTag :: DynFlags -> CmmExpr -> CmmExpr ...@@ -294,16 +294,18 @@ getConstrTag :: DynFlags -> CmmExpr -> CmmExpr
-- This lives in the SRT field of the info table -- This lives in the SRT field of the info table
-- (constructors don't need SRTs). -- (constructors don't need SRTs).
getConstrTag dflags closure_ptr 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 where
platform = targetPlatform dflags
info_table = infoTable dflags (closureInfoPtr closure_ptr) info_table = infoTable dflags (closureInfoPtr closure_ptr)
cmmGetClosureType :: DynFlags -> CmmExpr -> CmmExpr cmmGetClosureType :: DynFlags -> CmmExpr -> CmmExpr
-- Takes a closure pointer, and return the closure type -- Takes a closure pointer, and return the closure type
-- obtained from the info table -- obtained from the info table
cmmGetClosureType dflags closure_ptr 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 where
platform = targetPlatform dflags
info_table = infoTable dflags (closureInfoPtr closure_ptr) info_table = infoTable dflags (closureInfoPtr closure_ptr)
infoTable :: DynFlags -> CmmExpr -> CmmExpr infoTable :: DynFlags -> CmmExpr -> CmmExpr
...@@ -323,21 +325,21 @@ infoTableSrtBitmap :: DynFlags -> CmmExpr -> CmmExpr ...@@ -323,21 +325,21 @@ infoTableSrtBitmap :: DynFlags -> CmmExpr -> CmmExpr
-- Takes an info table pointer (from infoTable) and returns the srt_bitmap -- Takes an info table pointer (from infoTable) and returns the srt_bitmap
-- field of the info table -- field of the info table
infoTableSrtBitmap dflags info_tbl infoTableSrtBitmap dflags info_tbl
= CmmLoad (cmmOffsetB info_tbl (stdSrtBitmapOffset dflags)) bHalfWord = CmmLoad (cmmOffsetB info_tbl (stdSrtBitmapOffset dflags)) (bHalfWord (targetPlatform dflags))
infoTableClosureType :: DynFlags -> CmmExpr -> CmmExpr infoTableClosureType :: DynFlags -> CmmExpr -> CmmExpr
-- Takes an info table pointer (from infoTable) and returns the closure type -- Takes an info table pointer (from infoTable) and returns the closure type
-- field of the info table. -- field of the info table.
infoTableClosureType dflags info_tbl 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 :: DynFlags -> CmmExpr -> CmmExpr
infoTablePtrs dflags info_tbl 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 :: DynFlags -> CmmExpr -> CmmExpr
infoTableNonPtrs dflags info_tbl infoTableNonPtrs dflags info_tbl
= CmmLoad (cmmOffsetB info_tbl (stdNonPtrsOffset dflags)) bHalfWord = CmmLoad (cmmOffsetB info_tbl (stdNonPtrsOffset dflags)) (bHalfWord (targetPlatform dflags))
funInfoTable :: DynFlags -> CmmExpr -> CmmExpr funInfoTable :: DynFlags -> CmmExpr -> CmmExpr
-- Takes the info pointer of a function, -- Takes the info pointer of a function,
......
...@@ -544,7 +544,9 @@ emitPrimOp [res_q, res_r] WordQuotRem2Op [arg_x_high, arg_x_low, arg_y] _ ...@@ -544,7 +544,9 @@ emitPrimOp [res_q, res_r] WordQuotRem2Op [arg_x_high, arg_x_low, arg_y] _
stmtC stmt stmtC stmt
emitPrimOp [res_h, res_l] WordAdd2Op [arg_x, arg_y] _ 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) r2 <- newLocalReg (cmmExprType arg_x)
-- This generic implementation is very simple and slow. We might -- This generic implementation is very simple and slow. We might
-- well be able to do better, but for now this at least works. -- 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] _ ...@@ -564,7 +566,7 @@ emitPrimOp [res_h, res_l] WordAdd2Op [arg_x, arg_y] _
bottomHalf x = CmmMachOp (MO_And wordWidth) [x, hwm] bottomHalf x = CmmMachOp (MO_And wordWidth) [x, hwm]
add x y = CmmMachOp (MO_Add wordWidth) [x, y] add x y = CmmMachOp (MO_Add wordWidth) [x, y]
or x y = CmmMachOp (MO_Or 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) wordWidth)
hwm = CmmLit (CmmInt halfWordMask wordWidth) hwm = CmmLit (CmmInt halfWordMask wordWidth)
stmt = CmmCall (CmmPrim (MO_Add2 wordWidth) (Just genericImpl)) stmt = CmmCall (CmmPrim (MO_Add2 wordWidth) (Just genericImpl))
...@@ -575,7 +577,9 @@ emitPrimOp [res_h, res_l] WordAdd2Op [arg_x, arg_y] _ ...@@ -575,7 +577,9 @@ emitPrimOp [res_h, res_l] WordAdd2Op [arg_x, arg_y] _
CmmMayReturn CmmMayReturn
stmtC stmt stmtC stmt
emitPrimOp [res_h, res_l] WordMul2Op [arg_x, arg_y] _ 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 xlyl <- liftM CmmLocal $ newLocalReg t
xlyh <- liftM CmmLocal $ newLocalReg t xlyh <- liftM CmmLocal $ newLocalReg t
xhyl <- liftM CmmLocal $ newLocalReg t xhyl <- liftM CmmLocal $ newLocalReg t
...@@ -608,7 +612,7 @@ emitPrimOp [res_h, res_l] WordMul2Op [arg_x, arg_y] _ ...@@ -608,7 +612,7 @@ emitPrimOp [res_h, res_l] WordMul2Op [arg_x, arg_y] _
sum = foldl1 add sum = foldl1 add
mul x y = CmmMachOp (MO_Mul wordWidth) [x, y] mul x y = CmmMachOp (MO_Mul wordWidth) [x, y]
or x y = CmmMachOp (MO_Or 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) wordWidth)
hwm = CmmLit (CmmInt halfWordMask wordWidth) hwm = CmmLit (CmmInt halfWordMask wordWidth)
stmt = CmmCall (CmmPrim (MO_U_Mul2 wordWidth) (Just genericImpl)) stmt = CmmCall (CmmPrim (MO_U_Mul2 wordWidth) (Just genericImpl))
......
...@@ -609,16 +609,18 @@ getConstrTag :: DynFlags -> CmmExpr -> CmmExpr ...@@ -609,16 +609,18 @@ getConstrTag :: DynFlags -> CmmExpr -> CmmExpr
-- This lives in the SRT field of the info table -- This lives in the SRT field of the info table
-- (constructors don't need SRTs). -- (constructors don't need SRTs).
getConstrTag dflags closure_ptr 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 where
platform = targetPlatform dflags
info_table = infoTable dflags (closureInfoPtr closure_ptr) info_table = infoTable dflags (closureInfoPtr closure_ptr)
cmmGetClosureType :: DynFlags -> CmmExpr -> CmmExpr cmmGetClosureType :: DynFlags -> CmmExpr -> CmmExpr
-- Takes a closure pointer, and return the closure type -- Takes a closure pointer, and return the closure type
-- obtained from the info table -- obtained from the info table
cmmGetClosureType dflags closure_ptr 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 where
platform = targetPlatform dflags
info_table = infoTable dflags (closureInfoPtr closure_ptr) info_table = infoTable dflags (closureInfoPtr closure_ptr)
infoTable :: DynFlags -> CmmExpr -> CmmExpr infoTable :: DynFlags -> CmmExpr -> CmmExpr
...@@ -638,21 +640,21 @@ infoTableSrtBitmap :: DynFlags -> CmmExpr -> CmmExpr ...@@ -638,21 +640,21 @@ infoTableSrtBitmap :: DynFlags -> CmmExpr -> CmmExpr
-- Takes an info table pointer (from infoTable) and returns the srt_bitmap -- Takes an info table pointer (from infoTable) and returns the srt_bitmap
-- field of the info table -- field of the info table
infoTableSrtBitmap dflags info_tbl infoTableSrtBitmap dflags info_tbl
= CmmLoad (cmmOffsetB info_tbl (stdSrtBitmapOffset dflags)) bHalfWord = CmmLoad (cmmOffsetB info_tbl (stdSrtBitmapOffset dflags)) (bHalfWord (targetPlatform dflags))
infoTableClosureType :: DynFlags -> CmmExpr -> CmmExpr infoTableClosureType :: DynFlags -> CmmExpr -> CmmExpr
-- Takes an info table pointer (from infoTable) and returns the closure type -- Takes an info table pointer (from infoTable) and returns the closure type
-- field of the info table. -- field of the info table.
infoTableClosureType dflags info_tbl 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 :: DynFlags -> CmmExpr -> CmmExpr
infoTablePtrs dflags info_tbl 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 :: DynFlags -> CmmExpr -> CmmExpr
infoTableNonPtrs dflags info_tbl infoTableNonPtrs dflags info_tbl
= CmmLoad (cmmOffsetB info_tbl (stdNonPtrsOffset dflags)) bHalfWord = CmmLoad (cmmOffsetB info_tbl (stdNonPtrsOffset dflags)) (bHalfWord (targetPlatform dflags))
funInfoTable :: DynFlags -> CmmExpr -> CmmExpr funInfoTable :: DynFlags -> CmmExpr -> CmmExpr
-- Takes the info pointer of a function, -- Takes the info pointer of a function,
......
...@@ -630,8 +630,18 @@ genericWordQuotRem2Op _ _ = panic "genericWordQuotRem2Op" ...@@ -630,8 +630,18 @@ genericWordQuotRem2Op _ _ = panic "genericWordQuotRem2Op"
genericWordAdd2Op :: GenericOp genericWordAdd2Op :: GenericOp
genericWordAdd2Op [res_h, res_l] [arg_x, arg_y] 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) 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 emit $ catAGraphs
[mkAssign (CmmLocal r1) [mkAssign (CmmLocal r1)
(add (bottomHalf arg_x) (bottomHalf arg_y)), (add (bottomHalf arg_x) (bottomHalf arg_y)),
...@@ -643,25 +653,29 @@ genericWordAdd2Op [res_h, res_l] [arg_x, arg_y] ...@@ -643,25 +653,29 @@ genericWordAdd2Op [res_h, res_l] [arg_x, arg_y]
mkAssign (CmmLocal res_l) mkAssign (CmmLocal res_l)
(or (toTopHalf (CmmReg (CmmLocal r2))) (or (toTopHalf (CmmReg (CmmLocal r2)))
(bottomHalf (CmmReg (CmmLocal r1))))] (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" genericWordAdd2Op _ _ = panic "genericWordAdd2Op"
genericWordMul2Op :: GenericOp genericWordMul2Op :: GenericOp
genericWordMul2Op [res_h, res_l] [arg_x, arg_y] 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 xlyl <- liftM CmmLocal $ newTemp t
xlyh <- liftM CmmLocal $ newTemp t xlyh <- liftM CmmLocal $ newTemp t
xhyl <- liftM CmmLocal $ newTemp t xhyl <- liftM CmmLocal $ newTemp t
r <- liftM CmmLocal $ newTemp t r <- liftM CmmLocal $ newTemp t
-- This generic implementation is very simple and slow. We might -- This generic implementation is very simple and slow. We might
-- well be able to do better, but for now this at least works. -- 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 emit $ catAGraphs
[mkAssign xlyl [mkAssign xlyl
(mul (bottomHalf arg_x) (bottomHalf arg_y)), (mul (bottomHalf arg_x) (bottomHalf arg_y)),
...@@ -681,16 +695,6 @@ genericWordMul2Op [res_h, res_l] [arg_x, arg_y] ...@@ -681,16 +695,6 @@ genericWordMul2Op [res_h, res_l] [arg_x, arg_y]
topHalf (CmmReg xhyl), topHalf (CmmReg xhyl),
topHalf (CmmReg xlyh), topHalf (CmmReg xlyh),
topHalf (CmmReg r)])] 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" genericWordMul2Op _ _ = panic "genericWordMul2Op"
-- These PrimOps are NOPs in Cmm -- These PrimOps are NOPs in Cmm
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment