- mkIntCLit (if node_reqd then 1 else 0)]
-#endif {- GRAN -}
-\end{code}
-
-The GrAnSim code for heapChecks. The code for doing a heap check and
-doing a context switch has been separated. Especially, the HEAP_CHK
-macro only performs a heap check. THREAD_CONTEXT_SWITCH should be used
-for doing a context switch. GRAN_FETCH_AND_RESCHEDULE must be put at
-the beginning of every slow entry code in order to simulate the
-fetching of closures. If fetching is necessary (i.e. current closure
-is not local) then an automatic context switch is done.
-
-\begin{code}
-#ifdef GRAN
-
-heapCheck :: [MagicId] -- Live registers
- -> Bool -- Node reqd after GC?
- -> Code
- -> Code
-
-heapCheck = heapCheck' False
-
-heapCheckOnly :: [MagicId] -- Live registers
- -> Bool -- Node reqd after GC?
- -> Code
- -> Code
-
-heapCheckOnly = heapCheck' False
-
--- May be emit context switch and emit heap check macro
-
-heapCheck' :: Bool -- context switch here?
- -> [MagicId] -- Live registers
- -> Bool -- Node reqd after GC?
- -> Code
- -> Code
-
-heapCheck' do_context_switch regs node_reqd code
- = initHeapUsage (\ hHw -> do_heap_chk hHw `thenC` code)
- where
-
- do_heap_chk :: HeapOffset -> Code
- do_heap_chk words_required
- =
- -- HWL:: absC (CComment "Forced heap check --- HWL") `thenC`
- --absC (if do_context_switch
- -- then context_switch_code
- -- else AbsCNop) `thenC`
-
- absC (if do_context_switch && not (isZeroOff words_required)
- then context_switch_code
- else AbsCNop) `thenC`
- absC (if isZeroOff(words_required)
- then AbsCNop
- else checking_code) `thenC`
-
- -- HWL was here:
- -- For GrAnSim we want heap checks even if no heap is allocated in
- -- the basic block to make context switches possible.
- -- So, the if construct has been replaced by its else branch.
-
- -- The test is *inside* the absC, to avoid black holes!
-
- -- Now we have set up the real heap pointer and checked there is
- -- enough space. It remains only to reflect this in the environment
-
- setRealHp words_required
-
- -- The "word_required" here is a fudge.
- -- *** IT DEPENDS ON THE DIRECTION ***, and on
- -- whether the Hp is moved the whole way all
- -- at once or not.
- where
- all_regs = if node_reqd then node:regs else regs
- liveness_mask = mkLiveRegsBitMask all_regs
-
- maybe_context_switch = if do_context_switch
- then context_switch_code
- else AbsCNop
-
- context_switch_code = CMacroStmt THREAD_CONTEXT_SWITCH [
- mkIntCLit liveness_mask,
- mkIntCLit (if node_reqd then 1 else 0)]
-
- -- Good old heap check (excluding context switch)
- checking_code = CMacroStmt HEAP_CHK [
- mkIntCLit liveness_mask,
- COffset words_required,
- mkIntCLit (if node_reqd then 1 else 0)]