2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[CgHeapery]{Heap management functions}
7 #include "HsVersions.h"
11 allocHeap, allocDynClosure
13 -- new functions, basically inserting macro calls into Code -- HWL
14 , heapCheckOnly, fetchAndReschedule, yield
22 import AbsCUtils ( mkAbstractCs, getAmodeRep )
23 import CgUsages ( getVirtAndRealHp, setVirtHp, setRealHp,
26 import ClosureInfo ( closureSize, closureHdrSize, closureGoodStuffSize,
27 slopSize, allocProfilingMsg, closureKind
29 import HeapOffs ( isZeroOff, addOff, intOff,
30 SYN_IE(VirtualHeapOffset)
32 import PrimRep ( PrimRep(..) )
35 %************************************************************************
37 \subsection[CgHeapery-heap-overflow]{Heap overflow checking}
39 %************************************************************************
41 The new code for heapChecks. For GrAnSim the code for doing a heap check
42 and doing a context switch has been separated. Especially, the HEAP_CHK
43 macro only performs a heap check. THREAD_CONTEXT_SWITCH should be used for
44 doing a context switch. GRAN_FETCH_AND_RESCHEDULE must be put at the
45 beginning of every slow entry code in order to simulate the fetching of
46 closures. If fetching is necessary (i.e. current closure is not local) then
47 an automatic context switch is done.
50 heapCheck :: [MagicId] -- Live registers
51 -> Bool -- Node reqd after GC?
55 heapCheck = heapCheck' False
57 heapCheckOnly :: [MagicId] -- Live registers
58 -> Bool -- Node reqd after GC?
62 heapCheckOnly = heapCheck' False
64 -- May be emit context switch and emit heap check macro
66 heapCheck' :: Bool -- context switch here?
67 -> [MagicId] -- Live registers
68 -> Bool -- Node reqd after GC?
72 heapCheck' do_context_switch regs node_reqd code
73 = initHeapUsage (\ hHw -> do_heap_chk hHw `thenC` code)
76 do_heap_chk :: HeapOffset -> Code
77 do_heap_chk words_required
79 -- HWL:: absC (CComment "Forced heap check --- HWL") `thenC`
80 --absC (if do_context_switch
81 -- then context_switch_code
82 -- else AbsCNop) `thenC`
84 absC (if do_context_switch && not (isZeroOff words_required)
85 then context_switch_code
87 absC (if isZeroOff(words_required)
89 else checking_code) `thenC`
92 -- For GrAnSim we want heap checks even if no heap is allocated in
93 -- the basic block to make context switches possible.
94 -- So, the if construct has been replaced by its else branch.
96 -- The test is *inside* the absC, to avoid black holes!
98 -- Now we have set up the real heap pointer and checked there is
99 -- enough space. It remains only to reflect this in the environment
101 setRealHp words_required
103 -- The "word_required" here is a fudge.
104 -- *** IT DEPENDS ON THE DIRECTION ***, and on
105 -- whether the Hp is moved the whole way all
108 all_regs = if node_reqd then node:regs else regs
109 liveness_mask = mkLiveRegsMask all_regs
111 maybe_context_switch = if do_context_switch
112 then context_switch_code
115 context_switch_code = CMacroStmt THREAD_CONTEXT_SWITCH [
116 mkIntCLit liveness_mask,
117 mkIntCLit (if node_reqd then 1 else 0)]
119 -- Good old heap check (excluding context switch)
120 checking_code = CMacroStmt HEAP_CHK [
121 mkIntCLit liveness_mask,
122 COffset words_required,
123 mkIntCLit (if node_reqd then 1 else 0)]
125 -- Emit macro for simulating a fetch and then reschedule
127 fetchAndReschedule :: [MagicId] -- Live registers
128 -> Bool -- Node reqd?
131 fetchAndReschedule regs node_reqd =
132 if (node `elem` regs || node_reqd)
133 then fetch_code `thenC` reschedule_code
136 all_regs = if node_reqd then node:regs else regs
137 liveness_mask = mkLiveRegsMask all_regs
139 reschedule_code = absC (CMacroStmt GRAN_RESCHEDULE [
140 mkIntCLit liveness_mask,
141 mkIntCLit (if node_reqd then 1 else 0)])
143 --HWL: generate GRAN_FETCH macro for GrAnSim
144 -- currently GRAN_FETCH and GRAN_FETCH_AND_RESCHEDULE are miai
145 fetch_code = absC (CMacroStmt GRAN_FETCH [])
148 The @GRAN_YIELD@ macro is taken from JSM's code for Concurrent Haskell. It
149 allows to context-switch at places where @node@ is not alive (it uses the
150 @Continue@ rather than the @EnterNodeCode@ function in the RTS). We emit
151 this kind of macro at the beginning of the following kinds of basic bocks:
153 \item Slow entry code where node is not alive (see @CgClosure.lhs@). Normally
154 we use @fetchAndReschedule@ at a slow entry code.
155 \item Fast entry code (see @CgClosure.lhs@).
156 \item Alternatives in case expressions (@CLabelledCode@ structures), provided
157 that they are not inlined (see @CgCases.lhs@). These alternatives will
158 be turned into separate functions.
162 yield :: [MagicId] -- Live registers
163 -> Bool -- Node reqd?
166 yield regs node_reqd =
167 -- NB: node is not alive; that's why we use DO_YIELD rather than
171 all_regs = if node_reqd then node:regs else regs
172 liveness_mask = mkLiveRegsMask all_regs
174 yield_code = absC (CMacroStmt GRAN_YIELD [mkIntCLit liveness_mask])
177 %************************************************************************
179 \subsection[initClosure]{Initialise a dynamic closure}
181 %************************************************************************
183 @allocDynClosure@ puts the thing in the heap, and modifies the virtual Hp
189 -> CAddrMode -- Cost Centre to stick in the object
190 -> CAddrMode -- Cost Centre to blame for this alloc
191 -- (usually the same; sometimes "OVERHEAD")
193 -> [(CAddrMode, VirtualHeapOffset)] -- Offsets from start of the object
194 -- ie Info ptr has offset zero.
195 -> FCode VirtualHeapOffset -- Returns virt offset of object
197 allocDynClosure closure_info use_cc blame_cc amodes_with_offsets
198 = getVirtAndRealHp `thenFC` \ (virtHp, realHp) ->
200 -- FIND THE OFFSET OF THE INFO-PTR WORD
201 -- virtHp points to last allocated word, ie 1 *before* the
202 -- info-ptr word of new object.
203 let info_offset = addOff virtHp (intOff 1)
205 -- do_move IS THE ASSIGNMENT FUNCTION
206 do_move (amode, offset_from_start)
207 = CAssign (CVal (HpRel realHp
208 (info_offset `addOff` offset_from_start))
212 -- SAY WHAT WE ARE ABOUT TO DO
213 profCtrC (allocProfilingMsg closure_info)
214 [COffset (closureHdrSize closure_info),
215 mkIntCLit (closureGoodStuffSize closure_info),
217 COffset closure_size] `thenC`
220 absC ( mkAbstractCs (
221 [ CInitHdr closure_info (HpRel realHp info_offset) use_cc False ]
222 ++ (map do_move amodes_with_offsets))) `thenC`
224 -- GENERATE CC PROFILING MESSAGES
225 costCentresC SLIT("CC_ALLOC") [blame_cc,
226 COffset closure_size,
227 CLitLit (_PK_ (closureKind closure_info)) IntRep]
230 -- BUMP THE VIRTUAL HEAP POINTER
231 setVirtHp (virtHp `addOff` closure_size) `thenC`
233 -- RETURN PTR TO START OF OBJECT
236 closure_size = closureSize closure_info
237 slop_size = slopSize closure_info
240 %************************************************************************
242 \subsection{Allocate uninitialized heap space}
244 %************************************************************************
247 allocHeap :: HeapOffset -- Size of the space required
248 -> FCode CAddrMode -- Addr mode for first word of object
251 = getVirtAndRealHp `thenFC` \ (virtHp, realHp) ->
252 let block_start = addOff virtHp (intOff 1)
254 -- We charge the allocation to "PRIM" (which is probably right)
255 profCtrC SLIT("ALLOC_PRIM2") [COffset space] `thenC`
257 -- BUMP THE VIRTUAL HEAP POINTER
258 setVirtHp (virtHp `addOff` space) `thenC`
260 -- RETURN PTR TO START OF OBJECT
261 returnFC (CAddr (HpRel realHp block_start))