2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[CgHeapery]{Heap management functions}
9 allocHeap, allocDynClosure
11 -- new functions, basically inserting macro calls into Code -- HWL
12 , heapCheckOnly, fetchAndReschedule, yield
15 #include "HsVersions.h"
20 import AbsCUtils ( mkAbstractCs, getAmodeRep )
21 import CgUsages ( getVirtAndRealHp, setVirtHp, setRealHp,
24 import ClosureInfo ( closureSize, closureHdrSize, closureGoodStuffSize,
25 slopSize, allocProfilingMsg, closureKind, ClosureInfo
27 import HeapOffs ( isZeroOff, addOff, intOff,
28 VirtualHeapOffset, HeapOffset
30 import PrimRep ( PrimRep(..) )
33 %************************************************************************
35 \subsection[CgHeapery-heap-overflow]{Heap overflow checking}
37 %************************************************************************
39 The new code for heapChecks. For GrAnSim the code for doing a heap check
40 and doing a context switch has been separated. Especially, the HEAP_CHK
41 macro only performs a heap check. THREAD_CONTEXT_SWITCH should be used for
42 doing a context switch. GRAN_FETCH_AND_RESCHEDULE must be put at the
43 beginning of every slow entry code in order to simulate the fetching of
44 closures. If fetching is necessary (i.e. current closure is not local) then
45 an automatic context switch is done.
48 heapCheck :: [MagicId] -- Live registers
49 -> Bool -- Node reqd after GC?
53 heapCheck = heapCheck' False
55 heapCheckOnly :: [MagicId] -- Live registers
56 -> Bool -- Node reqd after GC?
60 heapCheckOnly = heapCheck' False
62 -- May be emit context switch and emit heap check macro
64 heapCheck' :: Bool -- context switch here?
65 -> [MagicId] -- Live registers
66 -> Bool -- Node reqd after GC?
70 heapCheck' do_context_switch regs node_reqd code
71 = initHeapUsage (\ hHw -> do_heap_chk hHw `thenC` code)
74 do_heap_chk :: HeapOffset -> Code
75 do_heap_chk words_required
77 -- HWL:: absC (CComment "Forced heap check --- HWL") `thenC`
78 --absC (if do_context_switch
79 -- then context_switch_code
80 -- else AbsCNop) `thenC`
82 absC (if do_context_switch && not (isZeroOff words_required)
83 then context_switch_code
85 absC (if isZeroOff(words_required)
87 else checking_code) `thenC`
90 -- For GrAnSim we want heap checks even if no heap is allocated in
91 -- the basic block to make context switches possible.
92 -- So, the if construct has been replaced by its else branch.
94 -- The test is *inside* the absC, to avoid black holes!
96 -- Now we have set up the real heap pointer and checked there is
97 -- enough space. It remains only to reflect this in the environment
99 setRealHp words_required
101 -- The "word_required" here is a fudge.
102 -- *** IT DEPENDS ON THE DIRECTION ***, and on
103 -- whether the Hp is moved the whole way all
106 all_regs = if node_reqd then node:regs else regs
107 liveness_mask = mkLiveRegsMask all_regs
109 maybe_context_switch = if do_context_switch
110 then context_switch_code
113 context_switch_code = CMacroStmt THREAD_CONTEXT_SWITCH [
114 mkIntCLit liveness_mask,
115 mkIntCLit (if node_reqd then 1 else 0)]
117 -- Good old heap check (excluding context switch)
118 checking_code = CMacroStmt HEAP_CHK [
119 mkIntCLit liveness_mask,
120 COffset words_required,
121 mkIntCLit (if node_reqd then 1 else 0)]
123 -- Emit macro for simulating a fetch and then reschedule
125 fetchAndReschedule :: [MagicId] -- Live registers
126 -> Bool -- Node reqd?
129 fetchAndReschedule regs node_reqd =
130 if (node `elem` regs || node_reqd)
131 then fetch_code `thenC` reschedule_code
134 all_regs = if node_reqd then node:regs else regs
135 liveness_mask = mkLiveRegsMask all_regs
137 reschedule_code = absC (CMacroStmt GRAN_RESCHEDULE [
138 mkIntCLit liveness_mask,
139 mkIntCLit (if node_reqd then 1 else 0)])
141 --HWL: generate GRAN_FETCH macro for GrAnSim
142 -- currently GRAN_FETCH and GRAN_FETCH_AND_RESCHEDULE are miai
143 fetch_code = absC (CMacroStmt GRAN_FETCH [])
146 The @GRAN_YIELD@ macro is taken from JSM's code for Concurrent Haskell. It
147 allows to context-switch at places where @node@ is not alive (it uses the
148 @Continue@ rather than the @EnterNodeCode@ function in the RTS). We emit
149 this kind of macro at the beginning of the following kinds of basic bocks:
151 \item Slow entry code where node is not alive (see @CgClosure.lhs@). Normally
152 we use @fetchAndReschedule@ at a slow entry code.
153 \item Fast entry code (see @CgClosure.lhs@).
154 \item Alternatives in case expressions (@CLabelledCode@ structures), provided
155 that they are not inlined (see @CgCases.lhs@). These alternatives will
156 be turned into separate functions.
160 yield :: [MagicId] -- Live registers
161 -> Bool -- Node reqd?
164 yield regs node_reqd =
165 -- NB: node is not alive; that's why we use DO_YIELD rather than
169 all_regs = if node_reqd then node:regs else regs
170 liveness_mask = mkLiveRegsMask all_regs
172 yield_code = absC (CMacroStmt GRAN_YIELD [mkIntCLit liveness_mask])
175 %************************************************************************
177 \subsection[initClosure]{Initialise a dynamic closure}
179 %************************************************************************
181 @allocDynClosure@ puts the thing in the heap, and modifies the virtual Hp
187 -> CAddrMode -- Cost Centre to stick in the object
188 -> CAddrMode -- Cost Centre to blame for this alloc
189 -- (usually the same; sometimes "OVERHEAD")
191 -> [(CAddrMode, VirtualHeapOffset)] -- Offsets from start of the object
192 -- ie Info ptr has offset zero.
193 -> FCode VirtualHeapOffset -- Returns virt offset of object
195 allocDynClosure closure_info use_cc blame_cc amodes_with_offsets
196 = getVirtAndRealHp `thenFC` \ (virtHp, realHp) ->
198 -- FIND THE OFFSET OF THE INFO-PTR WORD
199 -- virtHp points to last allocated word, ie 1 *before* the
200 -- info-ptr word of new object.
201 let info_offset = addOff virtHp (intOff 1)
203 -- do_move IS THE ASSIGNMENT FUNCTION
204 do_move (amode, offset_from_start)
205 = CAssign (CVal (HpRel realHp
206 (info_offset `addOff` offset_from_start))
210 -- SAY WHAT WE ARE ABOUT TO DO
211 profCtrC (allocProfilingMsg closure_info)
212 [COffset (closureHdrSize closure_info),
213 mkIntCLit (closureGoodStuffSize closure_info),
215 COffset closure_size] `thenC`
218 absC ( mkAbstractCs (
219 [ CInitHdr closure_info (HpRel realHp info_offset) use_cc False ]
220 ++ (map do_move amodes_with_offsets))) `thenC`
222 -- GENERATE CC PROFILING MESSAGES
223 costCentresC SLIT("CC_ALLOC") [blame_cc,
224 COffset closure_size,
225 CLitLit (_PK_ (closureKind closure_info)) IntRep]
228 -- BUMP THE VIRTUAL HEAP POINTER
229 setVirtHp (virtHp `addOff` closure_size) `thenC`
231 -- RETURN PTR TO START OF OBJECT
234 closure_size = closureSize closure_info
235 slop_size = slopSize closure_info
238 %************************************************************************
240 \subsection{Allocate uninitialized heap space}
242 %************************************************************************
245 allocHeap :: HeapOffset -- Size of the space required
246 -> FCode CAddrMode -- Addr mode for first word of object
249 = getVirtAndRealHp `thenFC` \ (virtHp, realHp) ->
250 let block_start = addOff virtHp (intOff 1)
252 -- We charge the allocation to "PRIM" (which is probably right)
253 profCtrC SLIT("ALLOC_PRIM2") [COffset space] `thenC`
255 -- BUMP THE VIRTUAL HEAP POINTER
256 setVirtHp (virtHp `addOff` space) `thenC`
258 -- RETURN PTR TO START OF OBJECT
259 returnFC (CAddr (HpRel realHp block_start))