[project @ 1996-01-11 14:06:51 by partain]
[ghc-hetmet.git] / ghc / runtime / storage / SM2s.lc
1 ***************************************************************************
2
3                            TWO SPACE COLLECTION
4
5 ***************************************************************************
6
7 \begin{code}
8 #if defined(GC2s)
9
10 #define SCAV_REG_MAP
11 #include "SMinternal.h"
12 #include "SMcopying.h"
13 #include "SMextn.h"
14
15 REGDUMP(ScavRegDump);
16
17 I_ semispace = 0;              /* 0 or 1 */
18 semispaceData semispaceInfo[2]
19     = {{0,0}, {0,0}};
20
21 P_ heap_space = 0;              /* Address of first word of slab 
22                                    of memory allocated for heap */
23
24 P_ hp_start;            /* Value of Hp when reduction was resumed */
25
26
27 rtsBool
28 initHeap(smInfo * sm)
29 {
30     if (heap_space == 0) { /* allocates if it doesn't already exist */
31
32         I_ semispaceSize = RTSflags.GcFlags.heapSize / 2;
33
34         /* Allocate the roots space */
35         sm->roots = (P_ *) stgMallocWords(SM_MAXROOTS, "initHeap (roots)");
36
37         /* Allocate the heap */
38         heap_space = (P_) stgMallocWords(RTSflags.GcFlags.heapSize + EXTRA_HEAP_WORDS,
39                                          "initHeap (heap)");
40     
41         /* Define the semi-spaces */
42         semispaceInfo[0].base = HEAP_FRAME_BASE(heap_space, semispaceSize);
43         semispaceInfo[1].base = HEAP_FRAME_BASE(heap_space + semispaceSize, semispaceSize);
44         semispaceInfo[0].lim = HEAP_FRAME_LIMIT(heap_space, semispaceSize);
45         semispaceInfo[1].lim = HEAP_FRAME_LIMIT(heap_space + semispaceSize, semispaceSize);
46
47         stat_init("TWOSPACE",
48                   " No of Roots  Caf   Caf    Astk   Bstk",
49                   "Astk Bstk Reg  No  bytes  bytes  bytes");
50     }
51
52     /* Initialise heap pointer and limit */
53     sm->hp = hp_start = semispaceInfo[semispace].base - 1;
54     sm->hardHpOverflowSize = 0;
55
56     if (! RTSflags.GcFlags.allocAreaSizeGiven) {
57         sm->hplim = semispaceInfo[semispace].lim;
58     } else {
59         sm->hplim = sm->hp + RTSflags.GcFlags.allocAreaSize;
60
61         RTSflags.GcFlags.minAllocAreaSize = 0; /* specified size takes precedence */
62
63         if (sm->hplim > semispaceInfo[semispace].lim) {
64             fprintf(stderr, "Not enough heap for requested alloc size\n");
65             return rtsFalse;
66         }
67     }
68
69     if (RTSflags.GcFlags.forceGC) {
70        if (sm->hplim > sm->hp + RTSflags.GcFlags.forcingInterval) {
71           sm->hplim = sm->hp + RTSflags.GcFlags.forcingInterval; 
72        } else {
73           RTSflags.GcFlags.forceGC = rtsFalse;
74           /* forcing GC has no effect, as semi-space is smaller than forcingInterval */ 
75        }
76     }
77
78     sm->CAFlist = NULL;
79
80 #ifndef PAR
81     initExtensions( sm );
82 #endif /* !PAR */
83
84     if (RTSflags.GcFlags.trace) {
85         fprintf(stderr, "TWO SPACE Heap: 0base, 0lim, 1base, 1lim\n                0x%lx, 0x%lx, 0x%lx, 0x%lx\n",
86                 (W_) semispaceInfo[0].base, (W_) semispaceInfo[0].lim,
87                 (W_) semispaceInfo[1].base, (W_) semispaceInfo[1].lim);
88         fprintf(stderr, "TWO SPACE Initial: space %ld, base 0x%lx, lim 0x%lx\n                         hp 0x%lx, hplim 0x%lx, free %lu\n",
89                 semispace,
90                 (W_) semispaceInfo[semispace].base,
91                 (W_) semispaceInfo[semispace].lim,
92                 (W_) sm->hp, (W_) sm->hplim, (W_) (sm->hplim - sm->hp) * sizeof(W_));
93     }
94
95     return rtsTrue; /* OK */
96 }
97
98 I_
99 collectHeap(reqsize, sm, do_full_collection)
100     W_ reqsize;
101     smInfo *sm;
102     rtsBool do_full_collection; /* ignored */
103 {
104     I_ free_space,      /* No of words of free space following GC */
105         alloc,          /* Number of words allocated since last GC */
106         resident,       /* Number of words remaining after GC */
107         extra_caf_words,/* Extra words referenced from CAFs */
108         caf_roots,      /* Number of CAFs */
109         bstk_roots;     /* Number of update frames on B stack */
110
111     fflush(stdout);     /* Flush stdout at start of GC */
112     SAVE_REGS(&ScavRegDump); /* Save registers */
113
114 #if defined(PROFILING)
115     if (interval_expired) { heap_profile_setup(); }
116 #endif  /* PROFILING */
117   
118     if (RTSflags.GcFlags.trace)
119         fprintf(stderr, "TWO SPACE Start: space %ld, base 0x%lx, lim 0x%lx\n                         hp 0x%lx, hplim 0x%lx, req %lu\n",
120                 semispace, (W_) semispaceInfo[semispace].base,
121                 (W_) semispaceInfo[semispace].lim,
122                 (W_) sm->hp, (W_) sm->hplim, reqsize * sizeof(W_));
123
124     alloc = sm->hp - hp_start;
125     stat_startGC(alloc);
126
127     /* Set Up For Collecting:
128          - Flip Spaces
129          - Set ToHp to point one below bottom of to-space (last allocated)
130          - Set CAFs to Evac & Upd
131      */
132
133     semispace = NEXT_SEMI_SPACE(semispace);
134     ToHp = semispaceInfo[semispace].base - 1;
135     Scav = semispaceInfo[semispace].base;
136     
137     SetCAFInfoTables( sm->CAFlist );
138 #ifdef PAR
139     EvacuateLocalGAs(rtsTrue);
140 #else
141     evacSPTable( sm );
142 #endif /* PAR */
143     EvacuateRoots( sm->roots, sm->rootno );
144 #ifdef CONCURRENT
145     EvacuateSparks();
146 #endif
147 #ifndef PAR
148     EvacuateAStack( MAIN_SpA, stackInfo.botA );
149     EvacuateBStack( MAIN_SuB, stackInfo.botB, &bstk_roots );
150 #endif /* !PAR */
151
152     Scavenge();
153
154     EvacAndScavengeCAFs( sm->CAFlist, &extra_caf_words, &caf_roots );
155
156 #ifdef PAR
157     RebuildGAtables(rtsTrue);
158 #else
159     reportDeadMallocPtrs(sm->MallocPtrList, NULL, &(sm->MallocPtrList) );
160 #endif /* PAR */
161
162     /* TIDY UP AND RETURN */
163
164     sm->hp = hp_start = ToHp;  /* Last allocated word */
165
166     resident = sm->hp - (semispaceInfo[semispace].base - 1);
167     DO_MAX_RESIDENCY(resident); /* stats only */
168
169     if (! RTSflags.GcFlags.allocAreaSizeGiven) {
170         sm->hplim = semispaceInfo[semispace].lim;
171         free_space = sm->hplim - sm->hp;
172     } else {
173         sm->hplim = sm->hp + RTSflags.GcFlags.allocAreaSize;
174         if (sm->hplim > semispaceInfo[semispace].lim) {
175             free_space = 0;
176         } else {
177             free_space = RTSflags.GcFlags.allocAreaSize;
178         }
179     }
180
181     if (RTSflags.GcFlags.giveStats) {
182         char comment_str[BIG_STRING_LEN];
183 #ifndef PAR
184         sprintf(comment_str, "%4u %4ld %3ld %3ld %6lu %6lu %6lu",
185                 (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1),
186                 bstk_roots, sm->rootno,
187                 caf_roots, extra_caf_words*sizeof(W_),
188                 (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1)*sizeof(W_),
189                 (SUBTRACT_B_STK(MAIN_SpB, stackInfo.botB) + 1)*sizeof(W_));
190 #else
191         /* ToDo: come up with some interesting statistics for the parallel world */
192         sprintf(comment_str, "%4u %4ld %3ld %3ld %6lu %6lu %6lu",
193                 0, 0, sm->rootno, caf_roots, extra_caf_words*sizeof(W_), 0, 0);
194 #endif
195
196 #if defined(PROFILING)
197         if (interval_expired) { strcat(comment_str, " prof"); }
198 #endif
199
200         stat_endGC(alloc, RTSflags.GcFlags.heapSize, resident, comment_str);
201     } else {
202         stat_endGC(alloc, RTSflags.GcFlags.heapSize, resident, "");
203     }
204
205 #if defined(PROFILING) || defined(PAR)
206       if (interval_expired) {
207 #if defined(PROFILING)
208           heap_profile_done();
209 #endif
210           report_cc_profiling(0 /*partial*/);
211       }
212 #endif /* PROFILING */
213
214     if (RTSflags.GcFlags.trace)
215         fprintf(stderr, "TWO SPACE Done: space %ld, base 0x%lx, lim 0x%lx\n                         hp 0x%lx, hplim 0x%lx, free %lu\n",
216                 semispace, (W_) semispaceInfo[semispace].base,
217                 (W_) semispaceInfo[semispace].lim,
218                 (W_) sm->hp, (W_) sm->hplim, (W_) (free_space * sizeof(W_)));
219
220 #ifdef DEBUG
221     /* To help flush out bugs, we trash the part of the heap from
222        which we're about to start allocating and all of the other semispace. */
223     TrashMem(sm->hp+1, sm->hplim);
224     TrashMem(semispaceInfo[NEXT_SEMI_SPACE(semispace)].base, 
225              semispaceInfo[NEXT_SEMI_SPACE(semispace)].lim);
226 #endif /* DEBUG */
227
228     RESTORE_REGS(&ScavRegDump);     /* Restore Registers */
229
230     if (free_space < RTSflags.GcFlags.minAllocAreaSize || free_sapce < reqsize)
231       return( GC_HARD_LIMIT_EXCEEDED ); /* Heap absolutely exhausted */
232
233     else {
234         if (RTSflags.GcFlags.forceGC
235          && sm->hplim > sm->hp + RTSflags.GcFlags.forcingInterval) {
236               sm->hplim = sm->hp + RTSflags.GcFlags.forcingInterval;
237         }
238
239         if (reqsize + sm->hardHpOverflowSize > free_space) {
240             return( GC_SOFT_LIMIT_EXCEEDED );   /* Heap nearly exhausted */
241         } else {
242             return( GC_SUCCESS );                   /* Heap OK */
243         }
244     }
245 }
246
247 #endif /* GC2s */
248 \end{code}