Commit c3f4c6fa authored by ian@well-typed.com's avatar ian@well-typed.com

Move wORD_SIZE_IN_BITS to DynFlags

This frees wORD_SIZE up to be moved out of HaskellConstants
parent 6dd23e65
......@@ -25,6 +25,7 @@ module Bitmap (
import SMRep
import Constants
import DynFlags
import Util
import Data.Bits
......@@ -37,10 +38,10 @@ generated code which need to be emitted as sequences of StgWords.
type Bitmap = [StgWord]
-- | Make a bitmap from a sequence of bits
mkBitmap :: [Bool] -> Bitmap
mkBitmap [] = []
mkBitmap stuff = chunkToBitmap chunk : mkBitmap rest
where (chunk, rest) = splitAt wORD_SIZE_IN_BITS stuff
mkBitmap :: DynFlags -> [Bool] -> Bitmap
mkBitmap _ [] = []
mkBitmap dflags stuff = chunkToBitmap chunk : mkBitmap dflags rest
where (chunk, rest) = splitAt (wORD_SIZE_IN_BITS dflags) stuff
chunkToBitmap :: [Bool] -> StgWord
chunkToBitmap chunk =
......@@ -50,31 +51,31 @@ chunkToBitmap chunk =
-- eg. @[0,1,3], size 4 ==> 0xb@.
--
-- The list of @Int@s /must/ be already sorted.
intsToBitmap :: Int -> [Int] -> Bitmap
intsToBitmap size slots{- must be sorted -}
intsToBitmap :: DynFlags -> Int -> [Int] -> Bitmap
intsToBitmap dflags size slots{- must be sorted -}
| size <= 0 = []
| otherwise =
(foldr (.|.) 0 (map (1 `shiftL`) these)) :
intsToBitmap (size - wORD_SIZE_IN_BITS)
(map (\x -> x - wORD_SIZE_IN_BITS) rest)
where (these,rest) = span (<wORD_SIZE_IN_BITS) slots
intsToBitmap dflags (size - wORD_SIZE_IN_BITS dflags)
(map (\x -> x - wORD_SIZE_IN_BITS dflags) rest)
where (these,rest) = span (< wORD_SIZE_IN_BITS dflags) slots
-- | Make a bitmap where the slots specified are the /zeros/ in the bitmap.
-- eg. @[0,1,3], size 4 ==> 0x4@ (we leave any bits outside the size as zero,
-- just to make the bitmap easier to read).
--
-- The list of @Int@s /must/ be already sorted and duplicate-free.
intsToReverseBitmap :: Int -> [Int] -> Bitmap
intsToReverseBitmap size slots{- must be sorted -}
intsToReverseBitmap :: DynFlags -> Int -> [Int] -> Bitmap
intsToReverseBitmap dflags size slots{- must be sorted -}
| size <= 0 = []
| otherwise =
(foldr xor init (map (1 `shiftL`) these)) :
intsToReverseBitmap (size - wORD_SIZE_IN_BITS)
(map (\x -> x - wORD_SIZE_IN_BITS) rest)
where (these,rest) = span (<wORD_SIZE_IN_BITS) slots
init
| size >= wORD_SIZE_IN_BITS = complement 0
| otherwise = (1 `shiftL` size) - 1
(foldr xor init (map (1 `shiftL`) these)) :
intsToReverseBitmap dflags (size - wORD_SIZE_IN_BITS dflags)
(map (\x -> x - wORD_SIZE_IN_BITS dflags) rest)
where (these,rest) = span (< wORD_SIZE_IN_BITS dflags) slots
init
| size >= wORD_SIZE_IN_BITS dflags = complement 0
| otherwise = (1 `shiftL` size) - 1
{- |
Magic number, must agree with @BITMAP_BITS_SHIFT@ in InfoTables.h.
......
......@@ -220,7 +220,7 @@ procpointSRT dflags top_srt top_table entries =
offset = head sorted_ints
bitmap_entries = map (subtract offset) sorted_ints
len = P.last bitmap_entries + 1
bitmap = intsToBitmap len bitmap_entries
bitmap = intsToBitmap dflags len bitmap_entries
maxBmpSize :: DynFlags -> Int
maxBmpSize dflags = widthInBits (wordWidth dflags) `div` 2
......
......@@ -315,7 +315,7 @@ mkLivenessBits dflags liveness
n_bits = length liveness
bitmap :: Bitmap
bitmap = mkBitmap liveness
bitmap = mkBitmap dflags liveness
small_bitmap = case bitmap of
[] -> 0
......
......@@ -91,7 +91,7 @@ emitPrimOp dflags [res_r,res_c] IntAddCOp [aa,bb] _
CmmMachOp (mo_wordNot dflags) [CmmMachOp (mo_wordXor dflags) [aa,bb]],
CmmMachOp (mo_wordXor dflags) [aa, CmmReg (CmmLocal res_r)]
],
mkIntExpr dflags (wORD_SIZE_IN_BITS - 1)
mkIntExpr dflags (wORD_SIZE_IN_BITS dflags - 1)
]
]
......@@ -114,7 +114,7 @@ emitPrimOp dflags [res_r,res_c] IntSubCOp [aa,bb] _
CmmMachOp (mo_wordXor dflags) [aa,bb],
CmmMachOp (mo_wordXor dflags) [aa, CmmReg (CmmLocal res_r)]
],
mkIntExpr dflags (wORD_SIZE_IN_BITS - 1)
mkIntExpr dflags (wORD_SIZE_IN_BITS dflags - 1)
]
]
......
......@@ -187,7 +187,7 @@ emitPrimOp dflags [res_r,res_c] IntAddCOp [aa,bb]
CmmMachOp (mo_wordNot dflags) [CmmMachOp (mo_wordXor dflags) [aa,bb]],
CmmMachOp (mo_wordXor dflags) [aa, CmmReg (CmmLocal res_r)]
],
mkIntExpr dflags (wORD_SIZE_IN_BITS - 1)
mkIntExpr dflags (wORD_SIZE_IN_BITS dflags - 1)
]
]
......@@ -210,7 +210,7 @@ emitPrimOp dflags [res_r,res_c] IntSubCOp [aa,bb]
CmmMachOp (mo_wordXor dflags) [aa,bb],
CmmMachOp (mo_wordXor dflags) [aa, CmmReg (CmmLocal res_r)]
],
mkIntExpr dflags (wORD_SIZE_IN_BITS - 1)
mkIntExpr dflags (wORD_SIZE_IN_BITS dflags - 1)
]
]
......
......@@ -133,7 +133,7 @@ assembleBCO dflags (ProtoBCO nm instrs bitmap bsize arity _origin _malloced) = d
-- Remember that the first insn starts at offset
-- sizeOf Word / sizeOf Word16
-- since offset 0 (eventually) will hold the total # of insns.
initial_offset = largeArg16s
initial_offset = largeArg16s dflags
-- Jump instructions are variable-sized, there are long and short variants
-- depending on the magnitude of the offset. However, we can't tell what
......@@ -143,9 +143,9 @@ assembleBCO dflags (ProtoBCO nm instrs bitmap bsize arity _origin _malloced) = d
-- and if the final size is indeed small enough for short jumps, we are
-- done. Otherwise, we repeat the calculation, and we force all jumps in
-- this BCO to be long.
(n_insns0, lbl_map0) = inspectAsm False initial_offset asm
(n_insns0, lbl_map0) = inspectAsm dflags False initial_offset asm
((n_insns, lbl_map), long_jumps)
| isLarge n_insns0 = (inspectAsm True initial_offset asm, True)
| isLarge n_insns0 = (inspectAsm dflags True initial_offset asm, True)
| otherwise = ((n_insns0, lbl_map0), False)
env :: Word16 -> Word
......@@ -154,9 +154,9 @@ assembleBCO dflags (ProtoBCO nm instrs bitmap bsize arity _origin _malloced) = d
(Map.lookup lbl lbl_map)
-- pass 2: run assembler and generate instructions, literals and pointers
let initial_insns = addListToSS emptySS $ largeArg n_insns
let initial_insns = addListToSS emptySS $ largeArg dflags n_insns
let initial_state = (initial_insns, emptySS, emptySS)
(final_insns, final_lits, final_ptrs) <- execState initial_state $ runAsm long_jumps env asm
(final_insns, final_lits, final_ptrs) <- execState initial_state $ runAsm dflags long_jumps env asm
-- precomputed size should be equal to final size
ASSERT (n_insns == sizeSS final_insns) return ()
......@@ -250,8 +250,8 @@ largeOp long_jumps op = case op of
Op w -> isLarge w
LabelOp _ -> long_jumps
runAsm :: Bool -> LabelEnv -> Assembler a -> State AsmState IO a
runAsm long_jumps e = go
runAsm :: DynFlags -> Bool -> LabelEnv -> Assembler a -> State AsmState IO a
runAsm dflags long_jumps e = go
where
go (NullAsm x) = return x
go (AllocPtr p_io k) = do
......@@ -273,9 +273,9 @@ runAsm long_jumps e = go
| otherwise = w
words = concatMap expand ops
expand (SmallOp w) = [w]
expand (LargeOp w) = largeArg w
expand (LargeOp w) = largeArg dflags w
expand (LabelOp w) = expand (Op (e w))
expand (Op w) = if largeOps then largeArg w else [fromIntegral w]
expand (Op w) = if largeOps then largeArg dflags w else [fromIntegral w]
State $ \(st_i0,st_l0,st_p0) -> do
let st_i1 = addListToSS st_i0 (opcode : words)
return ((st_i1,st_l0,st_p0), ())
......@@ -290,8 +290,8 @@ data InspectState = InspectState
, lblEnv :: LabelEnvMap
}
inspectAsm :: Bool -> Word -> Assembler a -> (Word, LabelEnvMap)
inspectAsm long_jumps initial_offset
inspectAsm :: DynFlags -> Bool -> Word -> Assembler a -> (Word, LabelEnvMap)
inspectAsm dflags long_jumps initial_offset
= go (InspectState initial_offset 0 0 Map.empty)
where
go s (NullAsm _) = (instrCount s, lblEnv s)
......@@ -307,9 +307,9 @@ inspectAsm long_jumps initial_offset
size = sum (map count ops) + 1
largeOps = any (largeOp long_jumps) ops
count (SmallOp _) = 1
count (LargeOp _) = largeArg16s
count (LargeOp _) = largeArg16s dflags
count (LabelOp _) = count (Op 0)
count (Op _) = if largeOps then largeArg16s else 1
count (Op _) = if largeOps then largeArg16s dflags else 1
-- Bring in all the bci_ bytecode constants.
#include "rts/Bytecodes.h"
......@@ -317,21 +317,21 @@ inspectAsm long_jumps initial_offset
largeArgInstr :: Word16 -> Word16
largeArgInstr bci = bci_FLAG_LARGE_ARGS .|. bci
largeArg :: Word -> [Word16]
largeArg w
| wORD_SIZE_IN_BITS == 64
largeArg :: DynFlags -> Word -> [Word16]
largeArg dflags w
| wORD_SIZE_IN_BITS dflags == 64
= [fromIntegral (w `shiftR` 48),
fromIntegral (w `shiftR` 32),
fromIntegral (w `shiftR` 16),
fromIntegral w]
| wORD_SIZE_IN_BITS == 32
| wORD_SIZE_IN_BITS dflags == 32
= [fromIntegral (w `shiftR` 16),
fromIntegral w]
| otherwise = error "wORD_SIZE_IN_BITS not 32 or 64?"
largeArg16s :: Word
largeArg16s | wORD_SIZE_IN_BITS == 64 = 4
| otherwise = 2
largeArg16s :: DynFlags -> Word
largeArg16s dflags | wORD_SIZE_IN_BITS dflags == 64 = 4
| otherwise = 2
assembleI :: DynFlags
-> BCInstr
......
......@@ -49,7 +49,6 @@ import SMRep
import ClosureInfo
import Bitmap
import OrdList
import Constants
import Data.List
import Foreign
......@@ -152,7 +151,8 @@ ppBCEnv p
-- Create a BCO and do a spot of peephole optimisation on the insns
-- at the same time.
mkProtoBCO
:: name
:: DynFlags
-> name
-> BCInstrList
-> Either [AnnAlt Id VarSet] (AnnExpr Id VarSet)
-> Int
......@@ -161,10 +161,10 @@ mkProtoBCO
-> Bool -- True <=> is a return point, rather than a function
-> [BcPtr]
-> ProtoBCO name
mkProtoBCO nm instrs_ordlist origin arity bitmap_size bitmap is_ret mallocd_blocks
mkProtoBCO dflags nm instrs_ordlist origin arity bitmap_size bitmap is_ret mallocd_blocks
= ProtoBCO {
protoBCOName = nm,
protoBCOInstrs = maybe_with_stack_check,
protoBCOInstrs = maybe_with_stack_check dflags,
protoBCOBitmap = bitmap,
protoBCOBitmapSize = bitmap_size,
protoBCOArity = arity,
......@@ -179,8 +179,8 @@ mkProtoBCO nm instrs_ordlist origin arity bitmap_size bitmap is_ret mallocd_bloc
-- BCO anyway, so we only need to add an explicit one in the
-- (hopefully rare) cases when the (overestimated) stack use
-- exceeds iNTERP_STACK_CHECK_THRESH.
maybe_with_stack_check
| is_ret && stack_usage < fromIntegral aP_STACK_SPLIM = peep_d
maybe_with_stack_check dflags
| is_ret && stack_usage < fromIntegral (aP_STACK_SPLIM dflags) = peep_d
-- don't do stack checks at return points,
-- everything is aggregated up to the top BCO
-- (which must be a function).
......@@ -223,6 +223,7 @@ schemeTopBind :: (Id, AnnExpr Id VarSet) -> BcM (ProtoBCO Name)
schemeTopBind (id, rhs)
| Just data_con <- isDataConWorkId_maybe id,
isNullaryRepDataCon data_con = do
dflags <- getDynFlags
-- Special case for the worker of a nullary data con.
-- It'll look like this: Nil = /\a -> Nil a
-- If we feed it into schemeR, we'll get
......@@ -231,7 +232,7 @@ schemeTopBind (id, rhs)
-- by just re-using the single top-level definition. So
-- for the worker itself, we must allocate it directly.
-- ioToBc (putStrLn $ "top level BCO")
emitBc (mkProtoBCO (getName id) (toOL [PACK data_con 0, ENTER])
emitBc (mkProtoBCO dflags (getName id) (toOL [PACK data_con 0, ENTER])
(Right rhs) 0 0 [{-no bitmap-}] False{-not alts-})
| otherwise
......@@ -281,7 +282,9 @@ collect (_, e) = go [] e
schemeR_wrk :: [Id] -> Id -> AnnExpr Id VarSet -> ([Var], AnnExpr' Var VarSet) -> BcM (ProtoBCO Name)
schemeR_wrk fvs nm original_body (args, body)
= let
= do
dflags <- getDynFlags
let
all_args = reverse args ++ fvs
arity = length all_args
-- all_args are the args in reverse order. We're compiling a function
......@@ -295,11 +298,10 @@ schemeR_wrk fvs nm original_body (args, body)
-- make the arg bitmap
bits = argBits (reverse (map idCgRep all_args))
bitmap_size = genericLength bits
bitmap = mkBitmap bits
in do
bitmap = mkBitmap dflags bits
body_code <- schemeER_wrk szw_args p_init body
emitBc (mkProtoBCO (getName nm) body_code (Right original_body)
emitBc (mkProtoBCO dflags (getName nm) body_code (Right original_body)
arity bitmap_size bitmap False{-not alts-})
-- introduce break instructions for ticked expressions
......@@ -772,7 +774,9 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple
| UbxTupleRep _ <- repType (idType bndr)
= unboxedTupleException
| otherwise
= let
= do
dflags <- getDynFlags
let
-- Top of stack is the return itbl, as usual.
-- underneath it is the pointer to the alt_code BCO.
-- When an alt is entered, it assumes the returned value is
......@@ -875,7 +879,7 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple
bitmap_size = trunc16 $ d-s
bitmap_size' :: Int
bitmap_size' = fromIntegral bitmap_size
bitmap = intsToReverseBitmap bitmap_size'{-size-}
bitmap = intsToReverseBitmap dflags bitmap_size'{-size-}
(sort (filter (< bitmap_size') rel_slots))
where
binds = Map.toList p
......@@ -886,13 +890,12 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple
| otherwise = []
where rel_offset = trunc16 $ d - fromIntegral offset - 1
in do
alt_stuff <- mapM codeAlt alts
alt_final <- mkMultiBranch maybe_ncons alt_stuff
let
alt_bco_name = getName bndr
alt_bco = mkProtoBCO alt_bco_name alt_final (Left alts)
alt_bco = mkProtoBCO dflags alt_bco_name alt_final (Left alts)
0{-no arity-} bitmap_size bitmap True{-is alts-}
-- trace ("case: bndr = " ++ showSDocDebug (ppr bndr) ++ "\ndepth = " ++ show d ++ "\nenv = \n" ++ showSDocDebug (ppBCEnv p) ++
-- "\n bitmap = " ++ show bitmap) $ do
......
......@@ -119,6 +119,7 @@ module DynFlags (
#include "../includes/dist-derivedconstants/header/GHCConstantsHaskellExports.hs"
bLOCK_SIZE_W,
wORD_SIZE_IN_BITS,
) where
#include "HsVersions.h"
......@@ -3149,3 +3150,6 @@ compilerInfo dflags
bLOCK_SIZE_W :: DynFlags -> Int
bLOCK_SIZE_W dflags = bLOCK_SIZE dflags `quot` wORD_SIZE
wORD_SIZE_IN_BITS :: DynFlags -> Int
wORD_SIZE_IN_BITS _ = wORD_SIZE * 8
......@@ -18,34 +18,35 @@ import VarEnv
import Maybes ( orElse, expectJust )
import Bitmap
import DynFlags
import Outputable
import Data.List
\end{code}
\begin{code}
computeSRTs :: [StgBinding] -> [(StgBinding,[(Id,[Id])])]
computeSRTs :: DynFlags -> [StgBinding] -> [(StgBinding,[(Id,[Id])])]
-- The incoming bindingd are filled with SRTEntries in their SRT slots
-- the outgoing ones have NoSRT/SRT values instead
computeSRTs binds = srtTopBinds emptyVarEnv binds
computeSRTs dflags binds = srtTopBinds dflags emptyVarEnv binds
-- --------------------------------------------------------------------------
-- Top-level Bindings
srtTopBinds :: IdEnv Id -> [StgBinding] -> [(StgBinding, [(Id,[Id])])]
srtTopBinds :: DynFlags -> IdEnv Id -> [StgBinding] -> [(StgBinding, [(Id,[Id])])]
srtTopBinds _ [] = []
srtTopBinds env (StgNonRec b rhs : binds) =
(StgNonRec b rhs', [(b,srt')]) : srtTopBinds env' binds
srtTopBinds _ _ [] = []
srtTopBinds dflags env (StgNonRec b rhs : binds) =
(StgNonRec b rhs', [(b,srt')]) : srtTopBinds dflags env' binds
where
(rhs', srt) = srtTopRhs b rhs
(rhs', srt) = srtTopRhs dflags b rhs
env' = maybeExtendEnv env b rhs
srt' = applyEnvList env srt
srtTopBinds env (StgRec bs : binds) =
(StgRec (zip bndrs rhss), zip bndrs srts') : srtTopBinds env binds
srtTopBinds dflags env (StgRec bs : binds) =
(StgRec (zip bndrs rhss), zip bndrs srts') : srtTopBinds dflags env binds
where
(rhss, srts) = unzip [ srtTopRhs b r | (b,r) <- bs ]
(rhss, srts) = unzip [ srtTopRhs dflags b r | (b,r) <- bs ]
bndrs = map fst bs
srts' = map (applyEnvList env) srts
......@@ -74,75 +75,75 @@ applyEnv env id = lookupVarEnv env id `orElse` id
-- ---- Top-level right hand sides:
srtTopRhs :: Id -> StgRhs -> (StgRhs, [Id])
srtTopRhs :: DynFlags -> Id -> StgRhs -> (StgRhs, [Id])
srtTopRhs _ rhs@(StgRhsCon _ _ _) = (rhs, [])
srtTopRhs _ rhs@(StgRhsClosure _ _ _ _ (SRTEntries cafs) _ _)
= (srtRhs table rhs, elems)
srtTopRhs _ _ rhs@(StgRhsCon _ _ _) = (rhs, [])
srtTopRhs dflags _ rhs@(StgRhsClosure _ _ _ _ (SRTEntries cafs) _ _)
= (srtRhs dflags table rhs, elems)
where
elems = varSetElems cafs
table = mkVarEnv (zip elems [0..])
srtTopRhs _ (StgRhsClosure _ _ _ _ NoSRT _ _) = panic "srtTopRhs NoSRT"
srtTopRhs _ (StgRhsClosure _ _ _ _ (SRT _ _ _) _ _) = panic "srtTopRhs SRT"
srtTopRhs _ _ (StgRhsClosure _ _ _ _ NoSRT _ _) = panic "srtTopRhs NoSRT"
srtTopRhs _ _ (StgRhsClosure _ _ _ _ (SRT _ _ _) _ _) = panic "srtTopRhs SRT"
-- ---- Binds:
srtBind :: IdEnv Int -> StgBinding -> StgBinding
srtBind :: DynFlags -> IdEnv Int -> StgBinding -> StgBinding
srtBind table (StgNonRec binder rhs) = StgNonRec binder (srtRhs table rhs)
srtBind table (StgRec pairs) = StgRec [ (b, srtRhs table r) | (b,r) <- pairs ]
srtBind dflags table (StgNonRec binder rhs) = StgNonRec binder (srtRhs dflags table rhs)
srtBind dflags table (StgRec pairs) = StgRec [ (b, srtRhs dflags table r) | (b,r) <- pairs ]
-- ---- Right Hand Sides:
srtRhs :: IdEnv Int -> StgRhs -> StgRhs
srtRhs :: DynFlags -> IdEnv Int -> StgRhs -> StgRhs
srtRhs _ e@(StgRhsCon _ _ _) = e
srtRhs table (StgRhsClosure cc bi free_vars u srt args body)
= StgRhsClosure cc bi free_vars u (constructSRT table srt) args
$! (srtExpr table body)
srtRhs _ _ e@(StgRhsCon _ _ _) = e
srtRhs dflags table (StgRhsClosure cc bi free_vars u srt args body)
= StgRhsClosure cc bi free_vars u (constructSRT dflags table srt) args
$! (srtExpr dflags table body)
-- ---------------------------------------------------------------------------
-- Expressions
srtExpr :: IdEnv Int -> StgExpr -> StgExpr
srtExpr :: DynFlags -> IdEnv Int -> StgExpr -> StgExpr
srtExpr _ e@(StgApp _ _) = e
srtExpr _ e@(StgLit _) = e
srtExpr _ e@(StgConApp _ _) = e
srtExpr _ e@(StgOpApp _ _ _) = e
srtExpr _ _ e@(StgApp _ _) = e
srtExpr _ _ e@(StgLit _) = e
srtExpr _ _ e@(StgConApp _ _) = e
srtExpr _ _ e@(StgOpApp _ _ _) = e
srtExpr table (StgSCC cc tick push expr) = StgSCC cc tick push $! srtExpr table expr
srtExpr dflags table (StgSCC cc tick push expr) = StgSCC cc tick push $! srtExpr dflags table expr
srtExpr table (StgTick m n expr) = StgTick m n $! srtExpr table expr
srtExpr dflags table (StgTick m n expr) = StgTick m n $! srtExpr dflags table expr
srtExpr table (StgCase scrut live1 live2 uniq srt alt_type alts)
srtExpr dflags table (StgCase scrut live1 live2 uniq srt alt_type alts)
= StgCase expr' live1 live2 uniq srt' alt_type alts'
where
expr' = srtExpr table scrut
srt' = constructSRT table srt
alts' = map (srtAlt table) alts
expr' = srtExpr dflags table scrut
srt' = constructSRT dflags table srt
alts' = map (srtAlt dflags table) alts
srtExpr table (StgLet bind body)
= srtBind table bind =: \ bind' ->
srtExpr table body =: \ body' ->
srtExpr dflags table (StgLet bind body)
= srtBind dflags table bind =: \ bind' ->
srtExpr dflags table body =: \ body' ->
StgLet bind' body'
srtExpr table (StgLetNoEscape live1 live2 bind body)
= srtBind table bind =: \ bind' ->
srtExpr table body =: \ body' ->
srtExpr dflags table (StgLetNoEscape live1 live2 bind body)
= srtBind dflags table bind =: \ bind' ->
srtExpr dflags table body =: \ body' ->
StgLetNoEscape live1 live2 bind' body'
srtExpr _table expr = pprPanic "srtExpr" (ppr expr)
srtExpr _ _table expr = pprPanic "srtExpr" (ppr expr)
srtAlt :: IdEnv Int -> StgAlt -> StgAlt
srtAlt table (con,args,used,rhs)
= (,,,) con args used $! srtExpr table rhs
srtAlt :: DynFlags -> IdEnv Int -> StgAlt -> StgAlt
srtAlt dflags table (con,args,used,rhs)
= (,,,) con args used $! srtExpr dflags table rhs
-----------------------------------------------------------------------------
-- Construct an SRT bitmap.
constructSRT :: IdEnv Int -> SRT -> SRT
constructSRT table (SRTEntries entries)
constructSRT :: DynFlags -> IdEnv Int -> SRT -> SRT
constructSRT dflags table (SRTEntries entries)
| isEmptyVarSet entries = NoSRT
| otherwise = seqBitmap bitmap $ SRT offset len bitmap
where
......@@ -152,9 +153,9 @@ constructSRT table (SRTEntries entries)
offset = head sorted_ints
bitmap_entries = map (subtract offset) sorted_ints
len = last bitmap_entries + 1
bitmap = intsToBitmap len bitmap_entries
constructSRT _ NoSRT = panic "constructSRT NoSRT"
constructSRT _ (SRT {}) = panic "constructSRT SRT"
bitmap = intsToBitmap dflags len bitmap_entries
constructSRT _ _ NoSRT = panic "constructSRT NoSRT"
constructSRT _ _ (SRT {}) = panic "constructSRT SRT"
-- ---------------------------------------------------------------------------
-- Misc stuff
......
......@@ -58,7 +58,7 @@ stg2stg dflags module_name binds
; let un_binds = unarise us1 processed_binds
; let srt_binds
| dopt Opt_TryNewCodeGen dflags = zip un_binds (repeat [])
| otherwise = computeSRTs un_binds
| otherwise = computeSRTs dflags un_binds
; dumpIfSet_dyn dflags Opt_D_dump_stg "STG syntax:"
(pprStgBindingsWithSRTs srt_binds)
......
......@@ -47,9 +47,6 @@ wORD64_SIZE = 8
wORD_SIZE :: Int
wORD_SIZE = SIZEOF_HSWORD
wORD_SIZE_IN_BITS :: Int
wORD_SIZE_IN_BITS = wORD_SIZE * 8
-- Define a fixed-range integral type equivalent to the target Int/Word
#if SIZEOF_HSWORD == 4
......
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