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

Move wORD_SIZE into platformConstants

parent a62b56ef
...@@ -24,7 +24,6 @@ module Bitmap ( ...@@ -24,7 +24,6 @@ module Bitmap (
#include "../includes/MachDeps.h" #include "../includes/MachDeps.h"
import SMRep import SMRep
import Constants
import DynFlags import DynFlags
import Util import Util
...@@ -84,9 +83,10 @@ possible, or fall back to an external pointer when the bitmap is too ...@@ -84,9 +83,10 @@ possible, or fall back to an external pointer when the bitmap is too
large. This value represents the largest size of bitmap that can be large. This value represents the largest size of bitmap that can be
packed into a single word. packed into a single word.
-} -}
mAX_SMALL_BITMAP_SIZE :: Int mAX_SMALL_BITMAP_SIZE :: DynFlags -> Int
mAX_SMALL_BITMAP_SIZE | wORD_SIZE == 4 = 27 mAX_SMALL_BITMAP_SIZE dflags
| otherwise = 58 | wORD_SIZE dflags == 4 = 27
| otherwise = 58
seqBitmap :: Bitmap -> a -> a seqBitmap :: Bitmap -> a -> a
seqBitmap = seqList seqBitmap = seqList
......
...@@ -233,7 +233,7 @@ to_SRT dflags top_srt off len bmp ...@@ -233,7 +233,7 @@ to_SRT dflags top_srt off len bmp
let srt_desc_lbl = mkLargeSRTLabel id let srt_desc_lbl = mkLargeSRTLabel id
tbl = CmmData RelocatableReadOnlyData $ tbl = CmmData RelocatableReadOnlyData $
Statics srt_desc_lbl $ map CmmStaticLit Statics srt_desc_lbl $ map CmmStaticLit
( cmmLabelOffW top_srt off ( cmmLabelOffW dflags top_srt off
: mkWordCLit dflags (fromIntegral len) : mkWordCLit dflags (fromIntegral len)
: map (mkWordCLit dflags) bmp) : map (mkWordCLit dflags) bmp)
return (Just tbl, C_SRT srt_desc_lbl 0 srt_escape) return (Just tbl, C_SRT srt_desc_lbl 0 srt_escape)
......
...@@ -18,7 +18,6 @@ import SMRep ...@@ -18,7 +18,6 @@ import SMRep
import Cmm (Convention(..)) import Cmm (Convention(..))
import PprCmm () import PprCmm ()
import Constants
import qualified Data.List as L import qualified Data.List as L
import DynFlags import DynFlags
import Outputable import Outputable
...@@ -92,7 +91,7 @@ assignArgumentsPos dflags conv arg_ty reps = assignments ...@@ -92,7 +91,7 @@ assignArgumentsPos dflags conv arg_ty reps = assignments
assign_stk _ assts [] = assts assign_stk _ assts [] = assts
assign_stk offset assts (r:rs) = assign_stk off' ((r, StackParam off') : assts) rs assign_stk offset assts (r:rs) = assign_stk off' ((r, StackParam off') : assts) rs
where w = typeWidth (arg_ty r) where w = typeWidth (arg_ty r)
size = (((widthInBytes w - 1) `div` wORD_SIZE) + 1) * wORD_SIZE size = (((widthInBytes w - 1) `div` wORD_SIZE dflags) + 1) * wORD_SIZE dflags
off' = offset + size off' = offset + size
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
......
...@@ -173,7 +173,7 @@ mkInfoTableContents dflags ...@@ -173,7 +173,7 @@ mkInfoTableContents dflags
| StackRep frame <- smrep | StackRep frame <- smrep
= do { (prof_lits, prof_data) <- mkProfLits dflags prof = do { (prof_lits, prof_data) <- mkProfLits dflags prof
; let (srt_label, srt_bitmap) = mkSRTLit srt ; let (srt_label, srt_bitmap) = mkSRTLit dflags srt
; (liveness_lit, liveness_data) <- mkLivenessBits dflags frame ; (liveness_lit, liveness_data) <- mkLivenessBits dflags frame
; let ; let
std_info = mkStdInfoTable dflags prof_lits rts_tag srt_bitmap liveness_lit std_info = mkStdInfoTable dflags prof_lits rts_tag srt_bitmap liveness_lit
...@@ -186,7 +186,7 @@ mkInfoTableContents dflags ...@@ -186,7 +186,7 @@ mkInfoTableContents dflags
| HeapRep _ ptrs nonptrs closure_type <- smrep | HeapRep _ ptrs nonptrs closure_type <- smrep
= do { let layout = packHalfWordsCLit dflags ptrs nonptrs = do { let layout = packHalfWordsCLit dflags ptrs nonptrs
; (prof_lits, prof_data) <- mkProfLits dflags prof ; (prof_lits, prof_data) <- mkProfLits dflags prof
; let (srt_label, srt_bitmap) = mkSRTLit srt ; let (srt_label, srt_bitmap) = mkSRTLit dflags srt
; (mb_srt_field, mb_layout, extra_bits, ct_data) ; (mb_srt_field, mb_layout, extra_bits, ct_data)
<- mk_pieces closure_type srt_label <- mk_pieces closure_type srt_label
; let std_info = mkStdInfoTable dflags prof_lits ; let std_info = mkStdInfoTable dflags prof_lits
...@@ -233,11 +233,12 @@ mkInfoTableContents dflags ...@@ -233,11 +233,12 @@ mkInfoTableContents dflags
mkInfoTableContents _ _ _ = panic "mkInfoTableContents" -- NonInfoTable dealt with earlier mkInfoTableContents _ _ _ = panic "mkInfoTableContents" -- NonInfoTable dealt with earlier
mkSRTLit :: C_SRT mkSRTLit :: DynFlags
-> C_SRT
-> ([CmmLit], -- srt_label, if any -> ([CmmLit], -- srt_label, if any
StgHalfWord) -- srt_bitmap StgHalfWord) -- srt_bitmap
mkSRTLit NoC_SRT = ([], 0) mkSRTLit _ NoC_SRT = ([], 0)
mkSRTLit (C_SRT lbl off bitmap) = ([cmmLabelOffW lbl off], bitmap) mkSRTLit dflags (C_SRT lbl off bitmap) = ([cmmLabelOffW dflags lbl off], bitmap)
------------------------------------------------------------------------- -------------------------------------------------------------------------
...@@ -303,7 +304,7 @@ mkLivenessBits :: DynFlags -> Liveness -> UniqSM (CmmLit, [RawCmmDecl]) ...@@ -303,7 +304,7 @@ mkLivenessBits :: DynFlags -> Liveness -> UniqSM (CmmLit, [RawCmmDecl])
-- 2. Large bitmap CmmData if needed -- 2. Large bitmap CmmData if needed
mkLivenessBits dflags liveness mkLivenessBits dflags liveness
| n_bits > mAX_SMALL_BITMAP_SIZE -- does not fit in one word | n_bits > mAX_SMALL_BITMAP_SIZE dflags -- does not fit in one word
= do { uniq <- getUniqueUs = do { uniq <- getUniqueUs
; let bitmap_lbl = mkBitmapLabel uniq ; let bitmap_lbl = mkBitmapLabel uniq
; return (CmmLabel bitmap_lbl, ; return (CmmLabel bitmap_lbl,
......
...@@ -17,7 +17,6 @@ import CmmLive ...@@ -17,7 +17,6 @@ import CmmLive
import CmmProcPoint import CmmProcPoint
import SMRep import SMRep
import Hoopl import Hoopl
import Constants
import UniqSupply import UniqSupply
import Maybes import Maybes
import UniqFM import UniqFM
...@@ -345,7 +344,7 @@ handleLastNode dflags procpoints liveness cont_info stackmaps ...@@ -345,7 +344,7 @@ handleLastNode dflags procpoints liveness cont_info stackmaps
return $ lastCall cont_lbl cml_args cml_ret_args cml_ret_off return $ lastCall cont_lbl cml_args cml_ret_args cml_ret_off
CmmForeignCall{ succ = cont_lbl, .. } -> do CmmForeignCall{ succ = cont_lbl, .. } -> do
return $ lastCall cont_lbl wORD_SIZE wORD_SIZE (sm_ret_off stack0) return $ lastCall cont_lbl (wORD_SIZE dflags) (wORD_SIZE dflags) (sm_ret_off stack0)
-- one word each for args and results: the return address -- one word each for args and results: the return address
CmmBranch{..} -> handleBranches CmmBranch{..} -> handleBranches
...@@ -381,7 +380,7 @@ handleLastNode dflags procpoints liveness cont_info stackmaps ...@@ -381,7 +380,7 @@ handleLastNode dflags procpoints liveness cont_info stackmaps
= (save_assignments, new_cont_stack) = (save_assignments, new_cont_stack)
where where
(new_cont_stack, save_assignments) (new_cont_stack, save_assignments)
= setupStackFrame lbl liveness cml_ret_off cml_ret_args stack0 = setupStackFrame dflags lbl liveness cml_ret_off cml_ret_args stack0
-- For other last nodes (branches), if any of the targets is a -- For other last nodes (branches), if any of the targets is a
...@@ -404,7 +403,7 @@ handleLastNode dflags procpoints liveness cont_info stackmaps ...@@ -404,7 +403,7 @@ handleLastNode dflags procpoints liveness cont_info stackmaps
out = mapFromList [ (l', cont_stack) out = mapFromList [ (l', cont_stack)
| l' <- successors last ] | l' <- successors last ]
return ( assigs return ( assigs
, spOffsetForCall sp0 cont_stack wORD_SIZE , spOffsetForCall sp0 cont_stack (wORD_SIZE dflags)
, last , last
, [] , []
, out) , out)
...@@ -440,7 +439,7 @@ handleLastNode dflags procpoints liveness cont_info stackmaps ...@@ -440,7 +439,7 @@ handleLastNode dflags procpoints liveness cont_info stackmaps
(stack2, assigs) = (stack2, assigs) =
--pprTrace "first visit to proc point" --pprTrace "first visit to proc point"
-- (ppr l <+> ppr stack1) $ -- (ppr l <+> ppr stack1) $
setupStackFrame l liveness (sm_ret_off stack0) setupStackFrame dflags l liveness (sm_ret_off stack0)
cont_args stack0 cont_args stack0
-- --
(tmp_lbl, block) <- makeFixupBlock dflags sp0 l stack2 assigs (tmp_lbl, block) <- makeFixupBlock dflags sp0 l stack2 assigs
...@@ -496,14 +495,15 @@ fixupStack old_stack new_stack = concatMap move new_locs ...@@ -496,14 +495,15 @@ fixupStack old_stack new_stack = concatMap move new_locs
setupStackFrame setupStackFrame
:: BlockId -- label of continuation :: DynFlags
-> BlockId -- label of continuation
-> BlockEnv CmmLive -- liveness -> BlockEnv CmmLive -- liveness
-> ByteOff -- updfr -> ByteOff -- updfr
-> ByteOff -- bytes of return values on stack -> ByteOff -- bytes of return values on stack
-> StackMap -- current StackMap -> StackMap -- current StackMap
-> (StackMap, [CmmNode O O]) -> (StackMap, [CmmNode O O])
setupStackFrame lbl liveness updfr_off ret_args stack0 setupStackFrame dflags lbl liveness updfr_off ret_args stack0
= (cont_stack, assignments) = (cont_stack, assignments)
where where
-- get the set of LocalRegs live in the continuation -- get the set of LocalRegs live in the continuation
...@@ -519,7 +519,7 @@ setupStackFrame lbl liveness updfr_off ret_args stack0 ...@@ -519,7 +519,7 @@ setupStackFrame lbl liveness updfr_off ret_args stack0
-- everything up to updfr_off is off-limits -- everything up to updfr_off is off-limits
-- stack1 contains updfr_off, plus everything we need to save -- stack1 contains updfr_off, plus everything we need to save
(stack1, assignments) = allocate updfr_off live stack0 (stack1, assignments) = allocate dflags updfr_off live stack0
-- And the Sp at the continuation is: -- And the Sp at the continuation is:
-- sm_sp stack1 + ret_args -- sm_sp stack1 + ret_args
...@@ -600,9 +600,10 @@ futureContinuation middle = foldBlockNodesB f middle Nothing ...@@ -600,9 +600,10 @@ futureContinuation middle = foldBlockNodesB f middle Nothing
-- on the stack and return the new StackMap and the assignments to do -- on the stack and return the new StackMap and the assignments to do
-- the saving. -- the saving.
-- --
allocate :: ByteOff -> RegSet -> StackMap -> (StackMap, [CmmNode O O]) allocate :: DynFlags -> ByteOff -> RegSet -> StackMap
allocate ret_off live stackmap@StackMap{ sm_sp = sp0 -> (StackMap, [CmmNode O O])
, sm_regs = regs0 } allocate dflags ret_off live stackmap@StackMap{ sm_sp = sp0
, sm_regs = regs0 }
= =
-- pprTrace "allocate" (ppr live $$ ppr stackmap) $ -- pprTrace "allocate" (ppr live $$ ppr stackmap) $
...@@ -613,37 +614,37 @@ allocate ret_off live stackmap@StackMap{ sm_sp = sp0 ...@@ -613,37 +614,37 @@ allocate ret_off live stackmap@StackMap{ sm_sp = sp0
-- make a map of the stack -- make a map of the stack
let stack = reverse $ Array.elems $ let stack = reverse $ Array.elems $
accumArray (\_ x -> x) Empty (1, toWords (max sp0 ret_off)) $ accumArray (\_ x -> x) Empty (1, toWords dflags (max sp0 ret_off)) $
ret_words ++ live_words ret_words ++ live_words
where ret_words = where ret_words =
[ (x, Occupied) [ (x, Occupied)
| x <- [ 1 .. toWords ret_off] ] | x <- [ 1 .. toWords dflags ret_off] ]
live_words = live_words =
[ (toWords x, Occupied) [ (toWords dflags x, Occupied)
| (r,off) <- eltsUFM regs1, | (r,off) <- eltsUFM regs1,
let w = localRegBytes r, let w = localRegBytes dflags r,
x <- [ off, off-wORD_SIZE .. off - w + 1] ] x <- [ off, off - wORD_SIZE dflags .. off - w + 1] ]
in in
-- Pass over the stack: find slots to save all the new live variables, -- Pass over the stack: find slots to save all the new live variables,
-- choosing the oldest slots first (hence a foldr). -- choosing the oldest slots first (hence a foldr).
let let
save slot ([], stack, n, assigs, regs) -- no more regs to save save slot ([], stack, n, assigs, regs) -- no more regs to save
= ([], slot:stack, n `plusW` 1, assigs, regs) = ([], slot:stack, plusW dflags n 1, assigs, regs)
save slot (to_save, stack, n, assigs, regs) save slot (to_save, stack, n, assigs, regs)
= case slot of = case slot of
Occupied -> (to_save, Occupied:stack, n `plusW` 1, assigs, regs) Occupied -> (to_save, Occupied:stack, plusW dflags n 1, assigs, regs)
Empty Empty
| Just (stack', r, to_save') <- | Just (stack', r, to_save') <-
select_save to_save (slot:stack) select_save to_save (slot:stack)
-> let assig = CmmStore (CmmStackSlot Old n') -> let assig = CmmStore (CmmStackSlot Old n')
(CmmReg (CmmLocal r)) (CmmReg (CmmLocal r))
n' = n `plusW` 1 n' = plusW dflags n 1
in in
(to_save', stack', n', assig : assigs, (r,(r,n')):regs) (to_save', stack', n', assig : assigs, (r,(r,n')):regs)
| otherwise | otherwise
-> (to_save, slot:stack, n `plusW` 1, assigs, regs) -> (to_save, slot:stack, plusW dflags n 1, assigs, regs)
-- we should do better here: right now we'll fit the smallest first, -- we should do better here: right now we'll fit the smallest first,
-- but it would make more sense to fit the biggest first. -- but it would make more sense to fit the biggest first.
...@@ -656,7 +657,7 @@ allocate ret_off live stackmap@StackMap{ sm_sp = sp0 ...@@ -656,7 +657,7 @@ allocate ret_off live stackmap@StackMap{ sm_sp = sp0
= Just (replicate words Occupied ++ rest, r, rs++no_fit) = Just (replicate words Occupied ++ rest, r, rs++no_fit)
| otherwise | otherwise
= go rs (r:no_fit) = go rs (r:no_fit)
where words = localRegWords r where words = localRegWords dflags r
-- fill in empty slots as much as possible -- fill in empty slots as much as possible
(still_to_save, save_stack, n, save_assigs, save_regs) (still_to_save, save_stack, n, save_assigs, save_regs)
...@@ -669,14 +670,14 @@ allocate ret_off live stackmap@StackMap{ sm_sp = sp0 ...@@ -669,14 +670,14 @@ allocate ret_off live stackmap@StackMap{ sm_sp = sp0
push r (n, assigs, regs) push r (n, assigs, regs)
= (n', assig : assigs, (r,(r,n')) : regs) = (n', assig : assigs, (r,(r,n')) : regs)
where where
n' = n + localRegBytes r n' = n + localRegBytes dflags r
assig = CmmStore (CmmStackSlot Old n') assig = CmmStore (CmmStackSlot Old n')
(CmmReg (CmmLocal r)) (CmmReg (CmmLocal r))
trim_sp trim_sp
| not (null push_regs) = push_sp | not (null push_regs) = push_sp
| otherwise | otherwise
= n `plusW` (- length (takeWhile isEmpty save_stack)) = plusW dflags n (- length (takeWhile isEmpty save_stack))
final_regs = regs1 `addListToUFM` push_regs final_regs = regs1 `addListToUFM` push_regs
`addListToUFM` save_regs `addListToUFM` save_regs
...@@ -685,7 +686,7 @@ allocate ret_off live stackmap@StackMap{ sm_sp = sp0 ...@@ -685,7 +686,7 @@ allocate ret_off live stackmap@StackMap{ sm_sp = sp0
-- XXX should be an assert -- XXX should be an assert
if ( n /= max sp0 ret_off ) then pprPanic "allocate" (ppr n <+> ppr sp0 <+> ppr ret_off) else if ( n /= max sp0 ret_off ) then pprPanic "allocate" (ppr n <+> ppr sp0 <+> ppr ret_off) else
if (trim_sp .&. (wORD_SIZE - 1)) /= 0 then pprPanic "allocate2" (ppr trim_sp <+> ppr final_regs <+> ppr push_sp) else if (trim_sp .&. (wORD_SIZE dflags - 1)) /= 0 then pprPanic "allocate2" (ppr trim_sp <+> ppr final_regs <+> ppr push_sp) else
( stackmap { sm_regs = final_regs , sm_sp = trim_sp } ( stackmap { sm_regs = final_regs , sm_sp = trim_sp }
, push_assigs ++ save_assigs ) , push_assigs ++ save_assigs )
...@@ -843,8 +844,8 @@ elimStackStores stackmap stackmaps area_off nodes ...@@ -843,8 +844,8 @@ elimStackStores stackmap stackmaps area_off nodes
-- Update info tables to include stack liveness -- Update info tables to include stack liveness
setInfoTableStackMap :: BlockEnv StackMap -> CmmDecl -> CmmDecl setInfoTableStackMap :: DynFlags -> BlockEnv StackMap -> CmmDecl -> CmmDecl
setInfoTableStackMap stackmaps (CmmProc top_info@TopInfo{..} l g) setInfoTableStackMap dflags stackmaps (CmmProc top_info@TopInfo{..} l g)
= CmmProc top_info{ info_tbls = mapMapWithKey fix_info info_tbls } l g = CmmProc top_info{ info_tbls = mapMapWithKey fix_info info_tbls } l g
where where
fix_info lbl info_tbl@CmmInfoTable{ cit_rep = StackRep _ } = fix_info lbl info_tbl@CmmInfoTable{ cit_rep = StackRep _ } =
...@@ -855,18 +856,18 @@ setInfoTableStackMap stackmaps (CmmProc top_info@TopInfo{..} l g) ...@@ -855,18 +856,18 @@ setInfoTableStackMap stackmaps (CmmProc top_info@TopInfo{..} l g)
get_liveness lbl get_liveness lbl
= case mapLookup lbl stackmaps of = case mapLookup lbl stackmaps of
Nothing -> pprPanic "setInfoTableStackMap" (ppr lbl <+> ppr info_tbls) Nothing -> pprPanic "setInfoTableStackMap" (ppr lbl <+> ppr info_tbls)
Just sm -> stackMapToLiveness sm Just sm -> stackMapToLiveness dflags sm
setInfoTableStackMap _ d = d setInfoTableStackMap _ _ d = d
stackMapToLiveness :: StackMap -> Liveness stackMapToLiveness :: DynFlags -> StackMap -> Liveness
stackMapToLiveness StackMap{..} = stackMapToLiveness dflags StackMap{..} =
reverse $ Array.elems $ reverse $ Array.elems $
accumArray (\_ x -> x) True (toWords sm_ret_off + 1, accumArray (\_ x -> x) True (toWords dflags sm_ret_off + 1,
toWords (sm_sp - sm_args)) live_words toWords dflags (sm_sp - sm_args)) live_words
where where
live_words = [ (toWords off, False) live_words = [ (toWords dflags off, False)
| (r,off) <- eltsUFM sm_regs, isGcPtrType (localRegType r) ] | (r,off) <- eltsUFM sm_regs, isGcPtrType (localRegType r) ]
...@@ -982,8 +983,8 @@ callResumeThread new_base id = ...@@ -982,8 +983,8 @@ callResumeThread new_base id =
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
plusW :: ByteOff -> WordOff -> ByteOff plusW :: DynFlags -> ByteOff -> WordOff -> ByteOff
plusW b w = b + w * wORD_SIZE plusW dflags b w = b + w * wORD_SIZE dflags
dropEmpty :: WordOff -> [StackSlot] -> Maybe [StackSlot] dropEmpty :: WordOff -> [StackSlot] -> Maybe [StackSlot]
dropEmpty 0 ss = Just ss dropEmpty 0 ss = Just ss
...@@ -994,14 +995,15 @@ isEmpty :: StackSlot -> Bool ...@@ -994,14 +995,15 @@ isEmpty :: StackSlot -> Bool
isEmpty Empty = True isEmpty Empty = True
isEmpty _ = False isEmpty _ = False
localRegBytes :: LocalReg -> ByteOff localRegBytes :: DynFlags -> LocalReg -> ByteOff
localRegBytes r = roundUpToWords (widthInBytes (typeWidth (localRegType r))) localRegBytes dflags r
= roundUpToWords dflags (widthInBytes (typeWidth (localRegType r)))
localRegWords :: LocalReg -> WordOff localRegWords :: DynFlags -> LocalReg -> WordOff
localRegWords = toWords . localRegBytes localRegWords dflags = toWords dflags . localRegBytes dflags
toWords :: ByteOff -> WordOff toWords :: DynFlags -> ByteOff -> WordOff
toWords x = x `quot` wORD_SIZE toWords dflags x = x `quot` wORD_SIZE dflags
insertReloads :: StackMap -> [CmmNode O O] insertReloads :: StackMap -> [CmmNode O O]
......
...@@ -18,7 +18,6 @@ import PprCmm () ...@@ -18,7 +18,6 @@ import PprCmm ()
import BlockId import BlockId
import FastString import FastString
import Outputable import Outputable
import Constants
import DynFlags import DynFlags
import Data.Maybe import Data.Maybe
...@@ -108,6 +107,7 @@ cmmCheckMachOp op _ tys ...@@ -108,6 +107,7 @@ cmmCheckMachOp op _ tys
= do dflags <- getDynFlags = do dflags <- getDynFlags
return (machOpResultType dflags op tys) return (machOpResultType dflags op tys)
{-
isOffsetOp :: MachOp -> Bool isOffsetOp :: MachOp -> Bool
isOffsetOp (MO_Add _) = True isOffsetOp (MO_Add _) = True
isOffsetOp (MO_Sub _) = True isOffsetOp (MO_Sub _) = True
...@@ -117,10 +117,10 @@ isOffsetOp _ = False ...@@ -117,10 +117,10 @@ isOffsetOp _ = False
-- check for funny-looking sub-word offsets. -- check for funny-looking sub-word offsets.
_cmmCheckWordAddress :: CmmExpr -> CmmLint () _cmmCheckWordAddress :: CmmExpr -> CmmLint ()
_cmmCheckWordAddress e@(CmmMachOp op [arg, CmmLit (CmmInt i _)]) _cmmCheckWordAddress e@(CmmMachOp op [arg, CmmLit (CmmInt i _)])
| isOffsetOp op && notNodeReg arg && i `rem` fromIntegral wORD_SIZE /= 0 | isOffsetOp op && notNodeReg arg && i `rem` fromIntegral (wORD_SIZE dflags) /= 0
= cmmLintDubiousWordOffset e = cmmLintDubiousWordOffset e
_cmmCheckWordAddress e@(CmmMachOp op [CmmLit (CmmInt i _), arg]) _cmmCheckWordAddress e@(CmmMachOp op [CmmLit (CmmInt i _), arg])
| isOffsetOp op && notNodeReg arg && i `rem` fromIntegral wORD_SIZE /= 0 | isOffsetOp op && notNodeReg arg && i `rem` fromIntegral (wORD_SIZE dflags) /= 0
= cmmLintDubiousWordOffset e = cmmLintDubiousWordOffset e
_cmmCheckWordAddress _ _cmmCheckWordAddress _
= return () = return ()
...@@ -130,6 +130,7 @@ _cmmCheckWordAddress _ ...@@ -130,6 +130,7 @@ _cmmCheckWordAddress _
notNodeReg :: CmmExpr -> Bool notNodeReg :: CmmExpr -> Bool
notNodeReg (CmmReg reg) | reg == nodeReg = False notNodeReg (CmmReg reg) | reg == nodeReg = False
notNodeReg _ = True notNodeReg _ = True
-}
lintCmmMiddle :: CmmNode O O -> CmmLint () lintCmmMiddle :: CmmNode O O -> CmmLint ()
lintCmmMiddle node = case node of lintCmmMiddle node = case node of
...@@ -239,7 +240,10 @@ cmmLintAssignErr stmt e_ty r_ty ...@@ -239,7 +240,10 @@ cmmLintAssignErr stmt e_ty r_ty
text "Rhs ty:" <+> ppr e_ty])) text "Rhs ty:" <+> ppr e_ty]))
{-
cmmLintDubiousWordOffset :: CmmExpr -> CmmLint a cmmLintDubiousWordOffset :: CmmExpr -> CmmLint a
cmmLintDubiousWordOffset expr cmmLintDubiousWordOffset expr
= cmmLintErr (text "offset is not a multiple of words: " $$ = cmmLintErr (text "offset is not a multiple of words: " $$
nest 2 (ppr expr)) nest 2 (ppr expr))
-}
...@@ -340,9 +340,10 @@ info :: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) } ...@@ -340,9 +340,10 @@ info :: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
| 'INFO_TABLE_RET' '(' NAME ',' INT ',' formals_without_hints0 ')' | 'INFO_TABLE_RET' '(' NAME ',' INT ',' formals_without_hints0 ')'
-- closure type, live regs -- closure type, live regs
{% withThisPackage $ \pkg -> {% withThisPackage $ \pkg ->
do live <- sequence (map (liftM Just) $7) do dflags <- getDynFlags
live <- sequence (map (liftM Just) $7)
let prof = NoProfilingInfo let prof = NoProfilingInfo
bitmap = mkLiveness live bitmap = mkLiveness dflags live
rep = mkRTSRep (fromIntegral $5) $ mkStackRep bitmap rep = mkRTSRep (fromIntegral $5) $ mkStackRep bitmap
return (mkCmmRetLabel pkg $3, return (mkCmmRetLabel pkg $3,
CmmInfoTable { cit_lbl = mkCmmInfoLabel pkg $3 CmmInfoTable { cit_lbl = mkCmmInfoLabel pkg $3
...@@ -888,7 +889,7 @@ adjCallTarget :: DynFlags -> CCallConv -> CmmExpr -> [CmmHinted CmmExpr] ...@@ -888,7 +889,7 @@ adjCallTarget :: DynFlags -> CCallConv -> CmmExpr -> [CmmHinted CmmExpr]
adjCallTarget dflags StdCallConv (CmmLit (CmmLabel lbl)) args adjCallTarget dflags StdCallConv (CmmLit (CmmLabel lbl)) args
| platformOS (targetPlatform dflags) == OSMinGW32 | platformOS (targetPlatform dflags) == OSMinGW32
= CmmLit (CmmLabel (addLabelSize lbl (sum (map size args)))) = CmmLit (CmmLabel (addLabelSize lbl (sum (map size args))))
where size (CmmHinted e _) = max wORD_SIZE (widthInBytes (typeWidth (cmmExprType dflags e))) where size (CmmHinted e _) = max (wORD_SIZE dflags) (widthInBytes (typeWidth (cmmExprType dflags e)))
-- c.f. CgForeignCall.emitForeignCall -- c.f. CgForeignCall.emitForeignCall
adjCallTarget _ _ expr _ adjCallTarget _ _ expr _
= expr = expr
...@@ -943,8 +944,8 @@ emitRetUT args = do ...@@ -943,8 +944,8 @@ emitRetUT args = do
emitSimultaneously stmts -- NB. the args might overlap with the stack slots emitSimultaneously stmts -- NB. the args might overlap with the stack slots
-- or regs that we assign to, so better use -- or regs that we assign to, so better use
-- simultaneous assignments here (#3546) -- simultaneous assignments here (#3546)
when (sp /= 0) $ stmtC (CmmAssign spReg (cmmRegOffW spReg (-sp))) when (sp /= 0) $ stmtC (CmmAssign spReg (cmmRegOffW dflags spReg (-sp)))
stmtC $ CmmJump (entryCode dflags (CmmLoad (cmmRegOffW spReg sp) (bWord dflags))) (Just live) stmtC $ CmmJump (entryCode dflags (CmmLoad (cmmRegOffW dflags spReg sp) (bWord dflags))) (Just live)
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
-- If-then-else and boolean expressions -- If-then-else and boolean expressions
...@@ -1053,7 +1054,7 @@ doSwitch mb_range scrut arms deflt ...@@ -1053,7 +1054,7 @@ doSwitch mb_range scrut arms deflt
initEnv :: DynFlags -> Env initEnv :: DynFlags -> Env
initEnv dflags = listToUFM [ initEnv dflags = listToUFM [
( fsLit "SIZEOF_StgHeader", ( fsLit "SIZEOF_StgHeader",
VarN (CmmLit (CmmInt (fromIntegral (fixedHdrSize dflags * wORD_SIZE)) (wordWidth dflags)) )), VarN (CmmLit (CmmInt (fromIntegral (fixedHdrSize dflags * wORD_SIZE dflags)) (wordWidth dflags)) )),
( fsLit "SIZEOF_StgInfoTable", ( fsLit "SIZEOF_StgInfoTable",
VarN (CmmLit (CmmInt (fromIntegral (stdInfoTableSizeB dflags)) (wordWidth dflags)) )) VarN (CmmLit (CmmInt (fromIntegral (stdInfoTableSizeB dflags)) (wordWidth dflags)) ))
] ]
......