2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1994
4 \section[CgHeapery]{Heap management functions}
7 #include "HsVersions.h"
11 allocHeap, allocDynClosure,
14 -- new for GrAnSim HWL
15 heapCheckOnly, fetchAndReschedule,
18 -- and to make the interface self-sufficient...
19 AbstractC, CAddrMode, HeapOffset,
20 CgState, ClosureInfo, Id
26 import CgRetConv ( mkLiveRegsBitMask )
27 import CgUsages ( getVirtAndRealHp, setVirtHp, setRealHp,
30 import ClosureInfo ( closureSize, closureHdrSize, closureGoodStuffSize, slopSize,
32 allocProfilingMsg, closureKind
37 %************************************************************************
39 \subsection[CgHeapery-heap-overflow]{Heap overflow checking}
41 %************************************************************************
43 This is std code we replaced by the bits below for GrAnSim. -- HWL
48 heapCheck :: [MagicId] -- Live registers
49 -> Bool -- Node reqd after GC?
53 heapCheck regs node_reqd code
54 = initHeapUsage (\ hHw -> do_heap_chk hHw `thenC` code)
57 do_heap_chk :: HeapOffset -> Code
58 do_heap_chk words_required
59 = absC (if isZeroOff(words_required) then AbsCNop else checking_code) `thenC`
60 -- The test is *inside* the absC, to avoid black holes!
62 -- Now we have set up the real heap pointer and checked there is
63 -- enough space. It remains only to reflect this in the environment
65 setRealHp words_required
67 -- The "word_required" here is a fudge.
68 -- *** IT DEPENDS ON THE DIRECTION ***, and on
69 -- whether the Hp is moved the whole way all
72 all_regs = if node_reqd then node:regs else regs
73 liveness_mask = mkLiveRegsBitMask all_regs
75 checking_code = CMacroStmt HEAP_CHK [
76 mkIntCLit liveness_mask,
77 COffset words_required,
78 mkIntCLit (if node_reqd then 1 else 0)]
82 The GrAnSim code for heapChecks. The code for doing a heap check and
83 doing a context switch has been separated. Especially, the HEAP_CHK
84 macro only performs a heap check. THREAD_CONTEXT_SWITCH should be used
85 for doing a context switch. GRAN_FETCH_AND_RESCHEDULE must be put at
86 the beginning of every slow entry code in order to simulate the
87 fetching of closures. If fetching is necessary (i.e. current closure
88 is not local) then an automatic context switch is done.
93 heapCheck :: [MagicId] -- Live registers
94 -> Bool -- Node reqd after GC?
98 heapCheck = heapCheck' False
100 heapCheckOnly :: [MagicId] -- Live registers
101 -> Bool -- Node reqd after GC?
105 heapCheckOnly = heapCheck' False
107 -- May be emit context switch and emit heap check macro
109 heapCheck' :: Bool -- context switch here?
110 -> [MagicId] -- Live registers
111 -> Bool -- Node reqd after GC?
115 heapCheck' do_context_switch regs node_reqd code
116 = initHeapUsage (\ hHw -> do_heap_chk hHw `thenC` code)
119 do_heap_chk :: HeapOffset -> Code
120 do_heap_chk words_required
122 -- HWL:: absC (CComment "Forced heap check --- HWL") `thenC`
123 --absC (if do_context_switch
124 -- then context_switch_code
125 -- else AbsCNop) `thenC`
127 absC (if do_context_switch && not (isZeroOff words_required)
128 then context_switch_code
129 else AbsCNop) `thenC`
130 absC (if isZeroOff(words_required)
132 else checking_code) `thenC`
135 -- For GrAnSim we want heap checks even if no heap is allocated in
136 -- the basic block to make context switches possible.
137 -- So, the if construct has been replaced by its else branch.
139 -- The test is *inside* the absC, to avoid black holes!
141 -- Now we have set up the real heap pointer and checked there is
142 -- enough space. It remains only to reflect this in the environment
144 setRealHp words_required
146 -- The "word_required" here is a fudge.
147 -- *** IT DEPENDS ON THE DIRECTION ***, and on
148 -- whether the Hp is moved the whole way all
151 all_regs = if node_reqd then node:regs else regs
152 liveness_mask = mkLiveRegsBitMask all_regs
154 maybe_context_switch = if do_context_switch
155 then context_switch_code
158 context_switch_code = CMacroStmt THREAD_CONTEXT_SWITCH [
159 mkIntCLit liveness_mask,
160 mkIntCLit (if node_reqd then 1 else 0)]
162 -- Good old heap check (excluding context switch)
163 checking_code = CMacroStmt HEAP_CHK [
164 mkIntCLit liveness_mask,
165 COffset words_required,
166 mkIntCLit (if node_reqd then 1 else 0)]
168 -- Emit macro for simulating a fetch and then reschedule
170 fetchAndReschedule :: [MagicId] -- Live registers
174 fetchAndReschedule regs node_reqd =
175 if (node `elem` regs || node_reqd)
176 then fetch_code `thenC` reschedule_code
179 all_regs = if node_reqd then node:regs else regs
180 liveness_mask = mkLiveRegsBitMask all_regs
182 reschedule_code = absC (CMacroStmt GRAN_RESCHEDULE [
183 mkIntCLit liveness_mask,
184 mkIntCLit (if node_reqd then 1 else 0)])
186 --HWL: generate GRAN_FETCH macro for GrAnSim
187 -- currently GRAN_FETCH and GRAN_FETCH_AND_RESCHEDULE are miai
188 fetch_code = absC (CMacroStmt GRAN_FETCH [])
193 %************************************************************************
195 \subsection[initClosure]{Initialise a dynamic closure}
197 %************************************************************************
199 @allocDynClosure@ puts the thing in the heap, and modifies the virtual Hp
205 -> CAddrMode -- Cost Centre to stick in the object
206 -> CAddrMode -- Cost Centre to blame for this alloc
207 -- (usually the same; sometimes "OVERHEAD")
209 -> [(CAddrMode, VirtualHeapOffset)] -- Offsets from start of the object
210 -- ie Info ptr has offset zero.
211 -> FCode VirtualHeapOffset -- Returns virt offset of object
213 allocDynClosure closure_info use_cc blame_cc amodes_with_offsets
214 = getVirtAndRealHp `thenFC` \ (virtHp, realHp) ->
216 -- FIND THE OFFSET OF THE INFO-PTR WORD
217 -- virtHp points to last allocated word, ie 1 *before* the
218 -- info-ptr word of new object.
219 let info_offset = addOff virtHp (intOff 1)
221 -- do_move IS THE ASSIGNMENT FUNCTION
222 do_move (amode, offset_from_start)
223 = CAssign (CVal (HpRel realHp
224 (info_offset `addOff` offset_from_start))
228 -- SAY WHAT WE ARE ABOUT TO DO
229 profCtrC (allocProfilingMsg closure_info)
230 [COffset (closureHdrSize closure_info),
231 mkIntCLit (closureGoodStuffSize closure_info),
233 COffset closure_size] `thenC`
236 absC ( mkAbstractCs (
237 [ CInitHdr closure_info (HpRel realHp info_offset) use_cc False ]
238 ++ (map do_move amodes_with_offsets))) `thenC`
240 -- GENERATE CC PROFILING MESSAGES
241 costCentresC SLIT("CC_ALLOC") [blame_cc,
242 COffset closure_size,
243 CLitLit (_PK_ (closureKind closure_info)) IntRep]
246 -- BUMP THE VIRTUAL HEAP POINTER
247 setVirtHp (virtHp `addOff` closure_size) `thenC`
249 -- RETURN PTR TO START OF OBJECT
252 closure_size = closureSize closure_info
253 slop_size = slopSize closure_info
256 %************************************************************************
258 \subsection{Allocate uninitialized heap space}
260 %************************************************************************
263 allocHeap :: HeapOffset -- Size of the space required
264 -> FCode CAddrMode -- Addr mode for first word of object
267 = getVirtAndRealHp `thenFC` \ (virtHp, realHp) ->
268 let block_start = addOff virtHp (intOff 1)
270 -- We charge the allocation to "PRIM" (which is probably right)
271 profCtrC SLIT("ALLOC_PRIM2") [COffset space] `thenC`
273 -- BUMP THE VIRTUAL HEAP POINTER
274 setVirtHp (virtHp `addOff` space) `thenC`
276 -- RETURN PTR TO START OF OBJECT
277 returnFC (CAddr (HpRel realHp block_start))