-- when (notNull malloced) (addFinalizer ul_bco (mapM_ zonk malloced))
return ul_bco
- where
- zonk ptr = do -- putStrLn ("freeing malloc'd block at " ++ show (A# a#))
- free ptr
+ -- where
+ -- zonk ptr = do -- putStrLn ("freeing malloc'd block at " ++ show (A# a#))
+ -- free ptr
mkBitmapArray :: Int -> [StgWord] -> UArray Int StgWord
mkBitmapArray bsize bitmap
= do { initial_us <- getUs
; let initial_st = mkNatM_State initial_us 0
(new_tops, final_st) = initNat initial_st (cmmTopCodeGen cmm_top)
- final_us = natm_us final_st
final_delta = natm_delta final_st
final_imports = natm_imports final_st
; if final_delta == 0
#ifndef DEBUG
import Data.Maybe ( fromJust )
#endif
-import Data.Maybe ( fromMaybe )
import Data.List ( nub, partition, mapAccumL, groupBy )
import Control.Monad ( when )
import Data.Word
(CyclicSCC blocks : sccs)
= getUs `thenUs` \us ->
let
- ((block_assig', stack', us'), blocks') = mapAccumL processBlock
+ ((block_assig', stack', _), blocks') = mapAccumL processBlock
(block_assig, stack, us)
({-reverse-} blocks)
in
(# s{ra_stack=stack'}, (instr,slot) #)
loadR :: Reg -> Int -> RegM Instr
-loadR reg slot = RegM $ \ s@RA_State{ra_delta=delta, ra_stack=stack} ->
+loadR reg slot = RegM $ \ s@RA_State{ra_delta=delta} ->
(# s, mkLoadInstr reg delta slot #)
getFreeRegsR :: RegM FreeRegs
setAssigR assig = RegM $ \ s ->
(# s{ra_assig=assig}, () #)
-getStackR :: RegM StackMap
-getStackR = RegM $ \ s@RA_State{ra_stack = stack} ->
- (# s, stack #)
-
-setStackR :: StackMap -> RegM ()
-setStackR stack = RegM $ \ s ->
- (# s{ra_stack=stack}, () #)
-
getBlockAssigR :: RegM BlockAssignment
getBlockAssigR = RegM $ \ s@RA_State{ra_blockassig = assig} ->
(# s, assig #)