2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[CgHeapery]{Heap management functions}
7 #include "HsVersions.h"
11 allocHeap, allocDynClosure
14 -- new for GrAnSim HWL
15 , heapCheckOnly, fetchAndReschedule
24 import AbsCUtils ( mkAbstractCs, getAmodeRep )
25 import CgRetConv ( mkLiveRegsMask )
26 import CgUsages ( getVirtAndRealHp, setVirtHp, setRealHp,
29 import ClosureInfo ( closureSize, closureHdrSize, closureGoodStuffSize,
30 slopSize, allocProfilingMsg, closureKind
32 import HeapOffs ( isZeroOff, addOff, intOff,
35 import PrimRep ( PrimRep(..) )
38 %************************************************************************
40 \subsection[CgHeapery-heap-overflow]{Heap overflow checking}
42 %************************************************************************
44 This is std code we replaced by the bits below for GrAnSim. -- HWL
49 heapCheck :: [MagicId] -- Live registers
50 -> Bool -- Node reqd after GC?
54 heapCheck regs node_reqd code
55 = initHeapUsage (\ hHw -> do_heap_chk hHw `thenC` code)
58 do_heap_chk :: HeapOffset -> Code
59 do_heap_chk words_required
60 = absC (if isZeroOff(words_required) then AbsCNop else checking_code) `thenC`
61 -- The test is *inside* the absC, to avoid black holes!
63 -- Now we have set up the real heap pointer and checked there is
64 -- enough space. It remains only to reflect this in the environment
66 setRealHp words_required
68 -- The "word_required" here is a fudge.
69 -- *** IT DEPENDS ON THE DIRECTION ***, and on
70 -- whether the Hp is moved the whole way all
73 all_regs = if node_reqd then node:regs else regs
74 liveness_mask = mkLiveRegsMask all_regs
76 checking_code = CMacroStmt HEAP_CHK [
77 mkIntCLit liveness_mask,
78 COffset words_required,
79 mkIntCLit (if node_reqd then 1 else 0)]
83 The GrAnSim code for heapChecks. The code for doing a heap check and
84 doing a context switch has been separated. Especially, the HEAP_CHK
85 macro only performs a heap check. THREAD_CONTEXT_SWITCH should be used
86 for doing a context switch. GRAN_FETCH_AND_RESCHEDULE must be put at
87 the beginning of every slow entry code in order to simulate the
88 fetching of closures. If fetching is necessary (i.e. current closure
89 is not local) then an automatic context switch is done.
94 heapCheck :: [MagicId] -- Live registers
95 -> Bool -- Node reqd after GC?
99 heapCheck = heapCheck' False
101 heapCheckOnly :: [MagicId] -- Live registers
102 -> Bool -- Node reqd after GC?
106 heapCheckOnly = heapCheck' False
108 -- May be emit context switch and emit heap check macro
110 heapCheck' :: Bool -- context switch here?
111 -> [MagicId] -- Live registers
112 -> Bool -- Node reqd after GC?
116 heapCheck' do_context_switch regs node_reqd code
117 = initHeapUsage (\ hHw -> do_heap_chk hHw `thenC` code)
120 do_heap_chk :: HeapOffset -> Code
121 do_heap_chk words_required
123 -- HWL:: absC (CComment "Forced heap check --- HWL") `thenC`
124 --absC (if do_context_switch
125 -- then context_switch_code
126 -- else AbsCNop) `thenC`
128 absC (if do_context_switch && not (isZeroOff words_required)
129 then context_switch_code
130 else AbsCNop) `thenC`
131 absC (if isZeroOff(words_required)
133 else checking_code) `thenC`
136 -- For GrAnSim we want heap checks even if no heap is allocated in
137 -- the basic block to make context switches possible.
138 -- So, the if construct has been replaced by its else branch.
140 -- The test is *inside* the absC, to avoid black holes!
142 -- Now we have set up the real heap pointer and checked there is
143 -- enough space. It remains only to reflect this in the environment
145 setRealHp words_required
147 -- The "word_required" here is a fudge.
148 -- *** IT DEPENDS ON THE DIRECTION ***, and on
149 -- whether the Hp is moved the whole way all
152 all_regs = if node_reqd then node:regs else regs
153 liveness_mask = mkLiveRegsMask all_regs
155 maybe_context_switch = if do_context_switch
156 then context_switch_code
159 context_switch_code = CMacroStmt THREAD_CONTEXT_SWITCH [
160 mkIntCLit liveness_mask,
161 mkIntCLit (if node_reqd then 1 else 0)]
163 -- Good old heap check (excluding context switch)
164 checking_code = CMacroStmt HEAP_CHK [
165 mkIntCLit liveness_mask,
166 COffset words_required,
167 mkIntCLit (if node_reqd then 1 else 0)]
169 -- Emit macro for simulating a fetch and then reschedule
171 fetchAndReschedule :: [MagicId] -- Live registers
175 fetchAndReschedule regs node_reqd =
176 if (node `elem` regs || node_reqd)
177 then fetch_code `thenC` reschedule_code
180 all_regs = if node_reqd then node:regs else regs
181 liveness_mask = mkLiveRegsMask all_regs
183 reschedule_code = absC (CMacroStmt GRAN_RESCHEDULE [
184 mkIntCLit liveness_mask,
185 mkIntCLit (if node_reqd then 1 else 0)])
187 --HWL: generate GRAN_FETCH macro for GrAnSim
188 -- currently GRAN_FETCH and GRAN_FETCH_AND_RESCHEDULE are miai
189 fetch_code = absC (CMacroStmt GRAN_FETCH [])
194 %************************************************************************
196 \subsection[initClosure]{Initialise a dynamic closure}
198 %************************************************************************
200 @allocDynClosure@ puts the thing in the heap, and modifies the virtual Hp
206 -> CAddrMode -- Cost Centre to stick in the object
207 -> CAddrMode -- Cost Centre to blame for this alloc
208 -- (usually the same; sometimes "OVERHEAD")
210 -> [(CAddrMode, VirtualHeapOffset)] -- Offsets from start of the object
211 -- ie Info ptr has offset zero.
212 -> FCode VirtualHeapOffset -- Returns virt offset of object
214 allocDynClosure closure_info use_cc blame_cc amodes_with_offsets
215 = getVirtAndRealHp `thenFC` \ (virtHp, realHp) ->
217 -- FIND THE OFFSET OF THE INFO-PTR WORD
218 -- virtHp points to last allocated word, ie 1 *before* the
219 -- info-ptr word of new object.
220 let info_offset = addOff virtHp (intOff 1)
222 -- do_move IS THE ASSIGNMENT FUNCTION
223 do_move (amode, offset_from_start)
224 = CAssign (CVal (HpRel realHp
225 (info_offset `addOff` offset_from_start))
229 -- SAY WHAT WE ARE ABOUT TO DO
230 profCtrC (allocProfilingMsg closure_info)
231 [COffset (closureHdrSize closure_info),
232 mkIntCLit (closureGoodStuffSize closure_info),
234 COffset closure_size] `thenC`
237 absC ( mkAbstractCs (
238 [ CInitHdr closure_info (HpRel realHp info_offset) use_cc False ]
239 ++ (map do_move amodes_with_offsets))) `thenC`
241 -- GENERATE CC PROFILING MESSAGES
242 costCentresC SLIT("CC_ALLOC") [blame_cc,
243 COffset closure_size,
244 CLitLit (_PK_ (closureKind closure_info)) IntRep]
247 -- BUMP THE VIRTUAL HEAP POINTER
248 setVirtHp (virtHp `addOff` closure_size) `thenC`
250 -- RETURN PTR TO START OF OBJECT
253 closure_size = closureSize closure_info
254 slop_size = slopSize closure_info
257 %************************************************************************
259 \subsection{Allocate uninitialized heap space}
261 %************************************************************************
264 allocHeap :: HeapOffset -- Size of the space required
265 -> FCode CAddrMode -- Addr mode for first word of object
268 = getVirtAndRealHp `thenFC` \ (virtHp, realHp) ->
269 let block_start = addOff virtHp (intOff 1)
271 -- We charge the allocation to "PRIM" (which is probably right)
272 profCtrC SLIT("ALLOC_PRIM2") [COffset space] `thenC`
274 -- BUMP THE VIRTUAL HEAP POINTER
275 setVirtHp (virtHp `addOff` space) `thenC`
277 -- RETURN PTR TO START OF OBJECT
278 returnFC (CAddr (HpRel realHp block_start))