1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
%
\section[CgUsages]{Accessing and modifying stacks and heap usage info}
This module provides the functions to access (\tr{get*} functions) and
modify (\tr{set*} functions) the stacks and heap usage information.
\begin{code}
module CgUsages (
initHeapUsage, setVirtHp, getVirtAndRealHp, setRealHp,
setRealAndVirtualSps,
getVirtSps,
getHpRelOffset, getSpARelOffset, getSpBRelOffset,
freeBStkSlot,
-- and to make the interface self-sufficient...
AbstractC, HeapOffset, RegRelative, CgState
) where
import AbsCSyn
import CgMonad
import Util
\end{code}
%************************************************************************
%* *
\subsection[CgUsages-heapery]{Monad things for fiddling with heap usage}
%* *
%************************************************************************
@initHeapUsage@ applies a function to the amount of heap that it uses.
It initialises the heap usage to zeros, and passes on an unchanged
heap usage.
It is usually a prelude to performing a GC check, so everything must
be in a tidy and consistent state.
\begin{code}
initHeapUsage :: (VirtualHeapOffset -> Code) -> Code
initHeapUsage fcode info_down (MkCgState absC binds (a_usage, b_usage, heap_usage))
= state3
where
state1 = MkCgState absC binds (a_usage, b_usage, (zeroOff, zeroOff))
state2 = fcode (heapHWM heap_usage2) info_down state1
(MkCgState absC2 binds2 (a_usage2, b_usage2, heap_usage2)) = state2
state3 = MkCgState absC2
binds2
(a_usage2, b_usage2, heap_usage {- unchanged -})
\end{code}
\begin{code}
setVirtHp :: VirtualHeapOffset -> Code
setVirtHp new_virtHp info_down
state@(MkCgState absC binds (a_stk, b_stk, (virtHp, realHp)))
= MkCgState absC binds (a_stk, b_stk, (new_virtHp, realHp))
\end{code}
\begin{code}
getVirtAndRealHp :: FCode (VirtualHeapOffset, VirtualHeapOffset)
getVirtAndRealHp info_down state@(MkCgState _ _ (au, bu, (virtHp, realHp)))
= ((virtHp, realHp), state)
\end{code}
\begin{code}
setRealHp :: VirtualHeapOffset -> Code
setRealHp realHp info_down (MkCgState absC binds (au, bu, (vHp, _)))
= MkCgState absC binds (au, bu, (vHp, realHp))
\end{code}
\begin{code}
getHpRelOffset :: VirtualHeapOffset -> FCode RegRelative
getHpRelOffset virtual_offset info_down state@(MkCgState _ _ (_,_,(_,realHp)))
= (HpRel realHp virtual_offset, state)
\end{code}
The heap high water mark is the larger of virtHp and hwHp. The latter is
only records the high water marks of forked-off branches, so to find the
heap high water mark you have to take the max of virtHp and hwHp. Remember,
virtHp never retreats!
\begin{code}
heapHWM (virtHp, realHp) = virtHp
\end{code}
%************************************************************************
%* *
\subsection[CgUsages-stackery]{Monad things for fiddling with stack usage}
%* *
%************************************************************************
@setRealAndVirtualSps@ sets into the environment the offsets of the
current position of the real and virtual stack pointers in the current
stack frame. The high-water mark is set too. It generates no code.
It is used to initialise things at the beginning of a closure body.
\begin{code}
setRealAndVirtualSps :: VirtualSpAOffset -- New real SpA
-> VirtualSpBOffset -- Ditto B stack
-> Code
setRealAndVirtualSps spA spB info_down (MkCgState absC binds
((vspA,fA,realSpA,hwspA),
(vspB,fB,realSpB,hwspB),
h_usage))
= MkCgState absC binds new_usage
where
new_usage = ((spA, fA, spA, spA),
(spB, fB, spB, spB),
h_usage)
\end{code}
\begin{code}
getVirtSps :: FCode (VirtualSpAOffset,VirtualSpBOffset)
getVirtSps info_down state@(MkCgState absC binds ((virtSpA,_,_,_), (virtSpB,_,_,_), _))
= ((virtSpA,virtSpB), state)
\end{code}
\begin{code}
getSpARelOffset :: VirtualSpAOffset -> FCode RegRelative
getSpARelOffset virtual_offset info_down state@(MkCgState _ _ ((_,_,realSpA,_),_,_))
= (SpARel realSpA virtual_offset, state)
getSpBRelOffset :: VirtualSpBOffset -> FCode RegRelative
getSpBRelOffset virtual_offset info_down state@(MkCgState _ _ (_,(_,_,realSpB,_),_))
= (SpBRel realSpB virtual_offset, state)
\end{code}
\begin{code}
freeBStkSlot :: VirtualSpBOffset -> Code
freeBStkSlot b_slot info_down
state@(MkCgState absC binds (spa_usage, (virtSpB,free_b,realSpB,hwSpB), heap_usage))
= MkCgState absC binds (spa_usage, (virtSpB,new_free_b,realSpB,hwSpB), heap_usage)
where
new_free_b = addFreeBSlots free_b [b_slot]
\end{code}
|
