1 |
/* Copyright William Schelter. All rights reserved. |
/* Copyright William Schelter. All rights reserved. |
2 |
|
|
3 |
Stratified Garbage Collection (SGC) |
Stratified Garbage Collection (SGC) |
4 |
|
|
5 |
Write protects pages to tell which ones have been written |
Write protects pages to tell which ones have been written |
6 |
to recently, for more efficient garbage collection. |
to recently, for more efficient garbage collection. |
7 |
|
|
8 |
*/ |
*/ |
9 |
|
|
10 |
|
|
23 |
|
|
24 |
#include <signal.h> |
#include <signal.h> |
25 |
|
|
26 |
void segmentation_catcher(); |
/* void segmentation_catcher(void); */ |
27 |
|
|
28 |
|
|
29 |
#define sgc_mark_pack_list(u) \ |
#define sgc_mark_pack_list(u) \ |
35 |
|
|
36 |
|
|
37 |
#ifdef SDEBUG |
#ifdef SDEBUG |
38 |
object sdebug; |
object sdebug; |
39 |
joe1(){;} |
joe1(){;} |
40 |
joe() {;} |
joe() {;} |
41 |
#endif |
#endif |
42 |
|
|
43 |
sgc_mark_cons(x) |
void |
44 |
object x; |
sgc_mark_cons(object x) { |
45 |
{ |
|
46 |
cs_check(x); |
cs_check(x); |
47 |
|
|
48 |
/* x is already marked. */ |
/* x is already marked. */ |
49 |
|
|
50 |
BEGIN: |
BEGIN: |
51 |
#ifdef SDEBUG |
#ifdef SDEBUG |
52 |
if(x==sdebug) joe1(); |
if(x==sdebug) joe1(); |
53 |
#endif |
#endif |
54 |
sgc_mark_object(x->c.c_car); |
sgc_mark_object(x->c.c_car); |
55 |
#ifdef OLD |
#ifdef OLD |
56 |
IF_WRITABLE(x->c.c_car, goto MARK_CAR;); |
IF_WRITABLE(x->c.c_car, goto MARK_CAR;); |
57 |
goto MARK_CDR; |
goto MARK_CDR; |
58 |
|
|
59 |
MARK_CAR: |
MARK_CAR: |
60 |
if (x->c.c_car->c.m ==0) |
if (x->c.c_car->c.m ==0) { |
61 |
{if (type_of(x->c.c_car) == t_cons) |
if (type_of(x->c.c_car) == t_cons) { |
62 |
{ |
x->c.c_car->c.m = TRUE; |
63 |
x->c.c_car->c.m = TRUE; |
sgc_mark_cons(x->c.c_car); |
64 |
sgc_mark_cons(x->c.c_car); |
} else |
65 |
} |
sgc_mark_object1(x->c.c_car);} |
|
else |
|
|
sgc_mark_object1(x->c.c_car);} |
|
|
#endif |
|
66 |
MARK_CDR: |
MARK_CDR: |
67 |
|
#endif |
68 |
x = x->c.c_cdr; |
x = x->c.c_cdr; |
69 |
IF_WRITABLE(x, goto WRITABLE_CDR;); |
IF_WRITABLE(x, goto WRITABLE_CDR;); |
70 |
return; |
return; |
71 |
WRITABLE_CDR: |
WRITABLE_CDR: |
72 |
if (x->d.m) return; |
if (x->d.m) return; |
73 |
if (type_of(x) == t_cons) { |
if (type_of(x) == t_cons) { |
74 |
x->c.m = TRUE; |
x->c.m = TRUE; |
75 |
goto BEGIN; |
goto BEGIN; |
76 |
} |
} |
77 |
sgc_mark_object1(x); |
sgc_mark_object1(x); |
78 |
} |
} |
79 |
|
|
90 |
header, that way we won't have to keep the headers in memory. |
header, that way we won't have to keep the headers in memory. |
91 |
This takes only 1.47 as opposed to 1.33 microseconds per set. |
This takes only 1.47 as opposed to 1.33 microseconds per set. |
92 |
*/ |
*/ |
93 |
sgc_mark_object1(x) |
void |
94 |
object x; |
sgc_mark_object1(object x) { |
|
{ |
|
|
int i, j; |
|
|
object *p; |
|
|
char *cp; |
|
|
object y; |
|
95 |
|
|
96 |
cs_check(x); |
int i, j; |
97 |
BEGIN: |
object *p; |
98 |
|
char *cp; |
99 |
|
|
100 |
|
cs_check(x); |
101 |
|
BEGIN: |
102 |
#ifdef SDEBUG |
#ifdef SDEBUG |
103 |
if (x == OBJNULL || !ON_WRITABLE_PAGE(x)) |
if (x == OBJNULL || !ON_WRITABLE_PAGE(x)) |
104 |
return; |
return; |
105 |
IF_WRITABLE(x,goto OK); |
IF_WRITABLE(x,goto OK); |
106 |
joe(); |
joe(); |
107 |
|
OK: |
108 |
#endif |
#endif |
109 |
OK: |
if (x->d.m) |
110 |
if (x->d.m) |
return; |
|
return; |
|
111 |
#ifdef SDEBUG |
#ifdef SDEBUG |
112 |
if(x==sdebug) joe1(); |
if(x==sdebug) joe1(); |
113 |
#endif |
#endif |
114 |
if (DBEGIN) { |
if (DBEGIN) |
115 |
if (NULL_OR_ON_C_STACK(x)) |
if (NULL_OR_ON_C_STACK(x)) |
116 |
return; |
return; |
117 |
} /* otherwise if DBEGIN==0 the IF_WRITABLE test will |
/* otherwise if DBEGIN==0 the IF_WRITABLE test will |
118 |
always fail on x that satisfy (NULL_OR_ON_C_STACK(x)) |
always fail on x that satisfy (NULL_OR_ON_C_STACK(x)) |
119 |
*/ |
*/ |
120 |
|
|
121 |
x->d.m = TRUE; |
x->d.m = TRUE; |
122 |
switch (type_of(x)) { |
switch (type_of(x)) { |
123 |
case t_fixnum: |
case t_fixnum: |
124 |
break; |
break; |
125 |
|
|
126 |
case t_ratio: |
case t_ratio: |
127 |
sgc_mark_object(x->rat.rat_num); |
sgc_mark_object(x->rat.rat_num); |
128 |
x = x->rat.rat_den; |
x = x->rat.rat_den; |
129 |
IF_WRITABLE(x,if(x->d.m==0) goto BEGIN); |
IF_WRITABLE(x,if(x->d.m==0) goto BEGIN); |
130 |
|
|
131 |
case t_shortfloat: |
case t_shortfloat: |
132 |
break; |
break; |
133 |
|
|
134 |
case t_longfloat: |
case t_longfloat: |
135 |
break; |
break; |
136 |
|
|
137 |
case t_complex: |
case t_complex: |
138 |
sgc_mark_object(x->cmp.cmp_imag); |
sgc_mark_object(x->cmp.cmp_imag); |
139 |
x = x->cmp.cmp_real; |
x = x->cmp.cmp_real; |
140 |
IF_WRITABLE(x,if(x->d.m==0) goto BEGIN); |
IF_WRITABLE(x,if(x->d.m==0) goto BEGIN); |
141 |
|
|
142 |
case t_character: |
case t_character: |
143 |
break; |
break; |
144 |
|
|
145 |
case t_symbol: |
case t_symbol: |
146 |
IF_WRITABLE(x->s.s_plist,if(x->s.s_plist->d.m==0) |
IF_WRITABLE(x->s.s_plist,if(x->s.s_plist->d.m==0) |
147 |
{x->s.s_plist->d.m=TRUE; |
{x->s.s_plist->d.m=TRUE; |
148 |
sgc_mark_cons(x->s.s_plist);}); |
sgc_mark_cons(x->s.s_plist);}); |
149 |
sgc_mark_object(x->s.s_gfdef); |
sgc_mark_object(x->s.s_gfdef); |
150 |
sgc_mark_object(x->s.s_dbind); |
sgc_mark_object(x->s.s_dbind); |
151 |
if (x->s.s_self == NULL) |
if (x->s.s_self == NULL) |
152 |
break; |
break; |
153 |
/* to do */ |
/* to do */ |
154 |
if ((int)what_to_collect >= (int)t_contiguous) { |
if ((int)what_to_collect >= (int)t_contiguous) { |
155 |
if (inheap(x->s.s_self)) { |
if (inheap(x->s.s_self)) { |
156 |
if (what_to_collect == t_contiguous) |
if (what_to_collect == t_contiguous) |
157 |
mark_contblock(x->s.s_self, |
mark_contblock(x->s.s_self, |
158 |
x->s.s_fillp); |
x->s.s_fillp); |
159 |
} else if(SGC_RELBLOCK_P(x->s.s_self)) |
} else if(SGC_RELBLOCK_P(x->s.s_self)) |
160 |
x->s.s_self = |
x->s.s_self = |
161 |
copy_relblock(x->s.s_self, x->s.s_fillp); |
copy_relblock(x->s.s_self, x->s.s_fillp); |
162 |
} |
} |
163 |
break; |
break; |
164 |
|
|
165 |
case t_package: |
case t_package: |
166 |
sgc_mark_object(x->p.p_name); |
sgc_mark_object(x->p.p_name); |
167 |
sgc_mark_object(x->p.p_nicknames); |
sgc_mark_object(x->p.p_nicknames); |
168 |
sgc_mark_object(x->p.p_shadowings); |
sgc_mark_object(x->p.p_shadowings); |
169 |
sgc_mark_object(x->p.p_uselist); |
sgc_mark_object(x->p.p_uselist); |
170 |
sgc_mark_object(x->p.p_usedbylist); |
sgc_mark_object(x->p.p_usedbylist); |
171 |
if (what_to_collect != t_contiguous) |
if (what_to_collect != t_contiguous) |
172 |
break; |
break; |
173 |
if (x->p.p_internal != NULL) |
if (x->p.p_internal != NULL) |
174 |
mark_contblock((char *)(x->p.p_internal), |
mark_contblock((char *)(x->p.p_internal), |
175 |
x->p.p_internal_size*sizeof(object)); |
x->p.p_internal_size*sizeof(object)); |
176 |
if (x->p.p_external != NULL) |
if (x->p.p_external != NULL) |
177 |
mark_contblock((char *)(x->p.p_external), |
mark_contblock((char *)(x->p.p_external), |
178 |
x->p.p_external_size*sizeof(object)); |
x->p.p_external_size*sizeof(object)); |
179 |
break; |
break; |
180 |
|
|
181 |
case t_cons: |
case t_cons: |
182 |
/* |
/* |
183 |
sgc_mark_object(x->c.c_car); |
sgc_mark_object(x->c.c_car); |
184 |
x = x->c.c_cdr; |
x = x->c.c_cdr; |
185 |
goto BEGIN; |
goto BEGIN; |
186 |
*/ |
*/ |
187 |
sgc_mark_cons(x); |
sgc_mark_cons(x); |
188 |
break; |
break; |
189 |
|
|
190 |
case t_hashtable: |
case t_hashtable: |
191 |
sgc_mark_object(x->ht.ht_rhsize); |
sgc_mark_object(x->ht.ht_rhsize); |
192 |
sgc_mark_object(x->ht.ht_rhthresh); |
sgc_mark_object(x->ht.ht_rhthresh); |
193 |
if (x->ht.ht_self == NULL) |
if (x->ht.ht_self == NULL) |
194 |
break; |
break; |
195 |
for (i = 0, j = x->ht.ht_size; i < j; i++) { |
for (i = 0, j = x->ht.ht_size; i < j; i++) { |
196 |
sgc_mark_object(x->ht.ht_self[i].hte_key); |
sgc_mark_object(x->ht.ht_self[i].hte_key); |
197 |
sgc_mark_object(x->ht.ht_self[i].hte_value); |
sgc_mark_object(x->ht.ht_self[i].hte_value); |
198 |
} |
} |
199 |
if ((short)what_to_collect >= (short)t_contiguous) { |
if ((short)what_to_collect >= (short)t_contiguous) { |
200 |
if (inheap(x->ht.ht_self)) { |
if (inheap(x->ht.ht_self)) { |
201 |
if (what_to_collect == t_contiguous) |
if (what_to_collect == t_contiguous) |
202 |
mark_contblock((char *)(x->ht.ht_self), |
mark_contblock((char *)(x->ht.ht_self), |
203 |
j * sizeof(struct htent)); |
j * sizeof(struct htent)); |
204 |
} else if(SGC_RELBLOCK_P(x->ht.ht_self)) |
} else if(SGC_RELBLOCK_P(x->ht.ht_self)) |
205 |
x->ht.ht_self = (struct htent *) |
x->ht.ht_self = (struct htent *) |
206 |
copy_relblock((char *)(x->ht.ht_self), |
copy_relblock((char *)(x->ht.ht_self), |
207 |
j * sizeof(struct htent)); |
j * sizeof(struct htent)); |
208 |
} |
} |
209 |
break; |
break; |
210 |
|
|
211 |
case t_array: |
case t_array: |
212 |
if ((x->a.a_displaced) != Cnil) |
if ((x->a.a_displaced) != Cnil) |
213 |
sgc_mark_displaced_field(x); |
sgc_mark_displaced_field(x); |
214 |
if ((int)what_to_collect >= (int)t_contiguous && |
if ((int)what_to_collect >= (int)t_contiguous && |
215 |
x->a.a_dims != NULL) { |
x->a.a_dims != NULL) { |
216 |
if (inheap(x->a.a_dims)) { |
if (inheap(x->a.a_dims)) { |
217 |
if (what_to_collect == t_contiguous) |
if (what_to_collect == t_contiguous) |
218 |
mark_contblock((char *)(x->a.a_dims), |
mark_contblock((char *)(x->a.a_dims), |
219 |
sizeof(int)*x->a.a_rank); |
sizeof(int)*x->a.a_rank); |
220 |
} else if(SGC_RELBLOCK_P(x->a.a_dims)) |
} else if(SGC_RELBLOCK_P(x->a.a_dims)) |
221 |
x->a.a_dims = (int *) |
x->a.a_dims = (int *) |
222 |
copy_relblock((char *)(x->a.a_dims), |
copy_relblock((char *)(x->a.a_dims), |
223 |
sizeof(int)*x->a.a_rank); |
sizeof(int)*x->a.a_rank); |
224 |
} |
} |
225 |
if ((enum aelttype)x->a.a_elttype == aet_ch) |
if ((enum aelttype)x->a.a_elttype == aet_ch) |
226 |
goto CASE_STRING; |
goto CASE_STRING; |
227 |
if ((enum aelttype)x->a.a_elttype == aet_bit) |
if ((enum aelttype)x->a.a_elttype == aet_bit) |
228 |
goto CASE_BITVECTOR; |
goto CASE_BITVECTOR; |
229 |
if ((enum aelttype)x->a.a_elttype == aet_object) |
if ((enum aelttype)x->a.a_elttype == aet_object) |
230 |
goto CASE_GENERAL; |
goto CASE_GENERAL; |
231 |
|
|
232 |
CASE_SPECIAL: |
CASE_SPECIAL: |
233 |
cp = (char *)(x->fixa.fixa_self); |
cp = (char *)(x->fixa.fixa_self); |
234 |
if (cp == NULL) |
if (cp == NULL) |
235 |
break; |
break; |
236 |
/* set j to the size in char of the body of the array */ |
/* set j to the size in char of the body of the array */ |
237 |
|
|
238 |
switch((enum aelttype)x->a.a_elttype){ |
switch((enum aelttype)x->a.a_elttype){ |
239 |
case aet_lf: |
case aet_lf: |
240 |
j= sizeof(longfloat)*x->lfa.lfa_dim; |
j= sizeof(longfloat)*x->lfa.lfa_dim; |
241 |
if (((int)what_to_collect >= (int)t_contiguous) && |
if (((int)what_to_collect >= (int)t_contiguous) && |
242 |
!(inheap(cp)) && SGC_RELBLOCK_P(x->a.a_self)) |
!(inheap(cp)) && SGC_RELBLOCK_P(x->a.a_self)) |
243 |
ROUND_RB_POINTERS_DOUBLE; |
ROUND_RB_POINTERS_DOUBLE; |
244 |
break; |
break; |
245 |
case aet_char: |
case aet_char: |
246 |
case aet_uchar: |
case aet_uchar: |
247 |
j=sizeof(char)*x->a.a_dim; |
j=sizeof(char)*x->a.a_dim; |
248 |
break; |
break; |
249 |
case aet_short: |
case aet_short: |
250 |
case aet_ushort: |
case aet_ushort: |
251 |
j=sizeof(short)*x->a.a_dim; |
j=sizeof(short)*x->a.a_dim; |
252 |
break; |
break; |
253 |
default: |
default: |
254 |
j=sizeof(fixnum)*x->fixa.fixa_dim;} |
j=sizeof(fixnum)*x->fixa.fixa_dim;} |
255 |
|
|
256 |
goto COPY; |
goto COPY; |
257 |
|
|
258 |
CASE_GENERAL: |
CASE_GENERAL: |
259 |
p = x->a.a_self; |
p = x->a.a_self; |
260 |
if (p == NULL |
if (p == NULL |
261 |
#ifdef HAVE_ALLOCA |
#ifdef HAVE_ALLOCA |
262 |
|| (char *)p >= core_end |
|| (char *)p >= core_end |
263 |
#endif |
#endif |
264 |
|
|
265 |
) |
) |
266 |
break; |
break; |
267 |
if (x->a.a_displaced->c.c_car == Cnil) |
j=0; |
268 |
for (i = 0, j = x->a.a_dim; i < j; i++) |
if (x->a.a_displaced->c.c_car == Cnil) |
269 |
if (ON_WRITABLE_PAGE(&p[i])) |
for (i = 0, j = x->a.a_dim; i < j; i++) |
270 |
sgc_mark_object(p[i]); |
if (ON_WRITABLE_PAGE(&p[i])) |
271 |
cp = (char *)p; |
sgc_mark_object(p[i]); |
272 |
j *= sizeof(object); |
cp = (char *)p; |
273 |
COPY: |
j *= sizeof(object); |
274 |
if ((int)what_to_collect >= (int)t_contiguous) { |
COPY: |
275 |
if (inheap(cp)) { |
if ((int)what_to_collect >= (int)t_contiguous) { |
276 |
if (what_to_collect == t_contiguous) |
if (inheap(cp)) { |
277 |
mark_contblock(cp, j); |
if (what_to_collect == t_contiguous) |
278 |
} |
mark_contblock(cp, j); |
279 |
else if (!SGC_RELBLOCK_P(cp)) ; |
} else if (!SGC_RELBLOCK_P(cp)) |
280 |
else if (x->a.a_displaced == Cnil){ |
; |
281 |
|
else if (x->a.a_displaced == Cnil) { |
282 |
#ifdef HAVE_ALLOCA |
#ifdef HAVE_ALLOCA |
283 |
if (cp <= core_end) /* only if body of array not on C stack */ |
if (cp <= core_end) /* only if body of array not on C stack */ |
284 |
#endif |
#endif |
285 |
x->a.a_self = (object *)copy_relblock(cp, j);} |
x->a.a_self = (object *)copy_relblock(cp, j); |
286 |
else if (x->a.a_displaced->c.c_car == Cnil) { |
} |
287 |
i = (int)(object *)copy_relblock(cp, j) |
else if (x->a.a_displaced->c.c_car == Cnil) { |
288 |
- (int)(x->a.a_self); |
i = (int)(object *)copy_relblock(cp, j) |
289 |
adjust_displaced(x, i); |
- (int)(x->a.a_self); |
290 |
} |
adjust_displaced(x, i); |
291 |
} |
} |
292 |
break; |
} |
293 |
|
break; |
294 |
case t_vector: |
|
295 |
if ((x->v.v_displaced) != Cnil) |
case t_vector: |
296 |
sgc_mark_displaced_field(x); |
if ((x->v.v_displaced) != Cnil) |
297 |
if ((enum aelttype)x->v.v_elttype == aet_object) |
sgc_mark_displaced_field(x); |
298 |
goto CASE_GENERAL; |
if ((enum aelttype)x->v.v_elttype == aet_object) |
299 |
else |
goto CASE_GENERAL; |
300 |
goto CASE_SPECIAL; |
else |
301 |
|
goto CASE_SPECIAL; |
302 |
case t_bignum: |
|
303 |
|
case t_bignum: |
304 |
#ifdef SDEBUG |
#ifdef SDEBUG |
305 |
if (type_map[page(x->big.big_self)] < t_contiguous) |
if (type_map[page(x->big.big_self)] < t_contiguous) |
306 |
{ |
printf("bad body for %x (%x)\n",x,cp); |
|
printf("bad body for %x (%x)\n",x,cp); |
|
|
|
|
|
} |
|
307 |
#endif |
#endif |
308 |
#ifndef GMP |
#ifndef GMP |
309 |
if ((int)what_to_collect >= (int)t_contiguous) { |
if ((int)what_to_collect >= (int)t_contiguous) { |
310 |
j = x->big.big_length; |
j = x->big.big_length; |
311 |
cp = (char *)x->big.big_self; |
cp = (char *)x->big.big_self; |
312 |
if (cp == NULL) |
if (cp == NULL) |
313 |
break; |
break; |
314 |
if (j != lg(MP(x)) && |
if (j != lg(MP(x)) && |
315 |
/* we don't bother to zero this register, |
/* we don't bother to zero this register, |
316 |
and its contents may get over written */ |
and its contents may get over written */ |
317 |
! (x == big_register_1 && |
! (x == big_register_1 && |
318 |
(int)(cp) <= top && |
(int)(cp) <= top && |
319 |
(int) cp >= bot)) |
(int) cp >= bot)) |
320 |
|
|
321 |
printf("bad length 0x%x ",x); |
printf("bad length 0x%x ",x); |
322 |
j = j * sizeof(int); |
j = j * sizeof(int); |
323 |
|
|
324 |
if (inheap(cp)) { |
if (inheap(cp)) { |
325 |
if (what_to_collect == t_contiguous) |
if (what_to_collect == t_contiguous) |
326 |
mark_contblock(cp, j); |
mark_contblock(cp, j); |
327 |
} else { |
} else { |
328 |
if (SGC_RELBLOCK_P(cp)) |
if (SGC_RELBLOCK_P(cp)) |
329 |
x->big.big_self = (plong *)copy_relblock(cp, j);}} |
x->big.big_self = (plong *)copy_relblock(cp, j);}} |
330 |
#endif /* no gmp */ |
#endif /* no gmp */ |
331 |
#ifndef GMP_USE_MALLOC |
#ifndef GMP_USE_MALLOC |
332 |
if ((int)what_to_collect >= (int)t_contiguous) { |
if ((int)what_to_collect >= (int)t_contiguous) { |
333 |
j = MP_ALLOCATED(x); |
j = MP_ALLOCATED(x); |
334 |
cp = (char *)MP_SELF(x); |
cp = (char *)MP_SELF(x); |
335 |
if (cp == 0) |
if (cp == 0) |
336 |
break; |
break; |
337 |
#ifdef PARI |
#ifdef PARI |
338 |
if (j != lg(MP(x)) && |
if (j != lg(MP(x)) && |
339 |
/* we don't bother to zero this register, |
/* we don't bother to zero this register, |
340 |
and its contents may get over written */ |
and its contents may get over written */ |
341 |
! (x == big_register_1 && |
! (x == big_register_1 && |
342 |
(int)(cp) <= top && |
(int)(cp) <= top && |
343 |
(int) cp >= bot)) |
(int) cp >= bot)) |
344 |
printf("bad length 0x%x ",x); |
printf("bad length 0x%x ",x); |
345 |
#endif |
#endif |
346 |
j = j * MP_LIMB_SIZE; |
j = j * MP_LIMB_SIZE; |
347 |
if (inheap(cp)) { |
if (inheap(cp)) { |
348 |
if (what_to_collect == t_contiguous) |
if (what_to_collect == t_contiguous) |
349 |
mark_contblock(cp, j); |
mark_contblock(cp, j); |
350 |
} else{ |
} else |
351 |
if (SGC_RELBLOCK_P(cp)) |
if (SGC_RELBLOCK_P(cp)) |
352 |
MP_SELF(x) = (void *) copy_relblock(cp, j);}} |
MP_SELF(x) = (void *) copy_relblock(cp, j); |
353 |
|
} |
354 |
#endif /* not GMP_USE_MALLOC */ |
#endif /* not GMP_USE_MALLOC */ |
355 |
break; |
break; |
356 |
|
|
357 |
|
|
358 |
CASE_STRING: |
CASE_STRING: |
359 |
case t_string: |
case t_string: |
360 |
if ((x->st.st_displaced) != Cnil) |
if ((x->st.st_displaced) != Cnil) |
361 |
sgc_mark_displaced_field(x); |
sgc_mark_displaced_field(x); |
362 |
j = x->st.st_dim; |
j = x->st.st_dim; |
363 |
cp = x->st.st_self; |
cp = x->st.st_self; |
364 |
if (cp == NULL) |
if (cp == NULL) |
365 |
break; |
break; |
366 |
|
|
367 |
COPY_STRING: |
COPY_STRING: |
368 |
if ((int)what_to_collect >= (int)t_contiguous) { |
if ((int)what_to_collect >= (int)t_contiguous) { |
369 |
if (inheap(cp)) { |
if (inheap(cp)) { |
370 |
if (what_to_collect == t_contiguous) |
if (what_to_collect == t_contiguous) |
371 |
mark_contblock(cp, j); |
mark_contblock(cp, j); |
372 |
} |
} |
373 |
else if (!SGC_RELBLOCK_P(cp)) ; |
else if (!SGC_RELBLOCK_P(cp)) ; |
374 |
else if (x->st.st_displaced == Cnil) |
else if (x->st.st_displaced == Cnil) |
375 |
x->st.st_self = copy_relblock(cp, j); |
x->st.st_self = copy_relblock(cp, j); |
376 |
else if (x->st.st_displaced->c.c_car == Cnil) { |
else if (x->st.st_displaced->c.c_car == Cnil) { |
377 |
i = copy_relblock(cp, j) - cp; |
i = copy_relblock(cp, j) - cp; |
378 |
adjust_displaced(x, i); |
adjust_displaced(x, i); |
379 |
} |
} |
380 |
} |
} |
381 |
break; |
break; |
382 |
|
|
383 |
CASE_BITVECTOR: |
CASE_BITVECTOR: |
384 |
case t_bitvector: |
case t_bitvector: |
385 |
if ((x->bv.bv_displaced) != Cnil) |
if ((x->bv.bv_displaced) != Cnil) |
386 |
sgc_mark_displaced_field(x); |
sgc_mark_displaced_field(x); |
387 |
/* We make bitvectors multiple of sizeof(int) in size allocated |
/* We make bitvectors multiple of sizeof(int) in size allocated |
388 |
Assume 8 = number of bits in char */ |
Assume 8 = number of bits in char */ |
389 |
|
|
390 |
#define W_SIZE (8*sizeof(int)) |
#define W_SIZE (8*sizeof(int)) |
391 |
j= sizeof(int) * |
j= sizeof(int) * |
392 |
((BV_OFFSET(x) + x->bv.bv_dim + W_SIZE -1)/W_SIZE); |
((BV_OFFSET(x) + x->bv.bv_dim + W_SIZE -1)/W_SIZE); |
393 |
cp = x->bv.bv_self; |
cp = x->bv.bv_self; |
394 |
if (cp == NULL) |
if (cp == NULL) |
395 |
break; |
break; |
396 |
goto COPY_STRING; |
goto COPY_STRING; |
397 |
|
|
398 |
case t_structure: |
case t_structure: |
399 |
sgc_mark_object(x->str.str_def); |
sgc_mark_object(x->str.str_def); |
400 |
p = x->str.str_self; |
p = x->str.str_self; |
401 |
if (p == NULL) |
if (p == NULL) |
402 |
break; |
break; |
403 |
{object def=x->str.str_def; |
{ |
404 |
unsigned char * s_type = &SLOT_TYPE(def,0); |
object def=x->str.str_def; |
405 |
unsigned short *s_pos= & SLOT_POS(def,0); |
unsigned char * s_type = &SLOT_TYPE(def,0); |
406 |
for (i = 0, j = S_DATA(def)->length; i < j; i++) |
unsigned short *s_pos= & SLOT_POS(def,0); |
407 |
if (s_type[i]==0 && |
for (i = 0, j = S_DATA(def)->length; i < j; i++) |
408 |
ON_WRITABLE_PAGE(& STREF(object,x,s_pos[i])) |
if (s_type[i]==0 && |
409 |
) |
ON_WRITABLE_PAGE(& STREF(object,x,s_pos[i])) |
410 |
sgc_mark_object(STREF(object,x,s_pos[i])); |
) |
411 |
if ((int)what_to_collect >= (int)t_contiguous) { |
sgc_mark_object(STREF(object,x,s_pos[i])); |
412 |
if (inheap(x->str.str_self)) { |
if ((int)what_to_collect >= (int)t_contiguous) { |
413 |
if (what_to_collect == t_contiguous) |
if (inheap(x->str.str_self)) { |
414 |
mark_contblock((char *)p, |
if (what_to_collect == t_contiguous) |
415 |
S_DATA(def)->size); |
mark_contblock((char *)p, |
416 |
|
S_DATA(def)->size); |
417 |
} else if(SGC_RELBLOCK_P(p)) |
|
418 |
x->str.str_self = (object *) |
} else if(SGC_RELBLOCK_P(p)) |
419 |
copy_relblock((char *)p, S_DATA(def)->size); |
x->str.str_self = (object *) |
420 |
}} |
copy_relblock((char *)p, S_DATA(def)->size); |
421 |
break; |
} |
422 |
|
} |
423 |
case t_stream: |
break; |
424 |
switch (x->sm.sm_mode) { |
|
425 |
case smm_input: |
case t_stream: |
426 |
case smm_output: |
switch (x->sm.sm_mode) { |
427 |
case smm_io: |
case smm_input: |
428 |
case smm_socket: |
case smm_output: |
429 |
case smm_probe: |
case smm_io: |
430 |
sgc_mark_object(x->sm.sm_object0); |
case smm_socket: |
431 |
sgc_mark_object(x->sm.sm_object1); |
case smm_probe: |
432 |
if (saving_system) |
sgc_mark_object(x->sm.sm_object0); |
433 |
{FILE *fp = x->sm.sm_fp; |
sgc_mark_object(x->sm.sm_object1); |
434 |
if (fp != 0 && fp != stdin && fp !=stdout |
if (saving_system) { |
435 |
) |
FILE *fp = x->sm.sm_fp; |
436 |
{fclose(fp); |
if (fp != 0 && fp != stdin && fp !=stdout) { |
437 |
x->sm.sm_fp=0; |
fclose(fp); |
438 |
}} |
x->sm.sm_fp=0; |
439 |
else |
} |
440 |
if (what_to_collect == t_contiguous && |
} |
441 |
x->sm.sm_fp && |
else |
442 |
x->sm.sm_buffer) |
if (what_to_collect == t_contiguous && |
443 |
mark_contblock(x->sm.sm_buffer, BUFSIZ); |
x->sm.sm_fp && |
444 |
break; |
x->sm.sm_buffer) |
445 |
|
mark_contblock(x->sm.sm_buffer, BUFSIZ); |
446 |
case smm_synonym: |
break; |
447 |
sgc_mark_object(x->sm.sm_object0); |
|
448 |
break; |
case smm_synonym: |
449 |
|
sgc_mark_object(x->sm.sm_object0); |
450 |
case smm_broadcast: |
break; |
451 |
case smm_concatenated: |
|
452 |
sgc_mark_object(x->sm.sm_object0); |
case smm_broadcast: |
453 |
break; |
case smm_concatenated: |
454 |
|
sgc_mark_object(x->sm.sm_object0); |
455 |
case smm_two_way: |
break; |
456 |
case smm_echo: |
|
457 |
sgc_mark_object(x->sm.sm_object0); |
case smm_two_way: |
458 |
sgc_mark_object(x->sm.sm_object1); |
case smm_echo: |
459 |
break; |
sgc_mark_object(x->sm.sm_object0); |
460 |
|
sgc_mark_object(x->sm.sm_object1); |
461 |
case smm_string_input: |
break; |
462 |
case smm_string_output: |
|
463 |
sgc_mark_object(x->sm.sm_object0); |
case smm_string_input: |
464 |
break; |
case smm_string_output: |
465 |
|
sgc_mark_object(x->sm.sm_object0); |
466 |
|
break; |
467 |
#ifdef USER_DEFINED_STREAMS |
#ifdef USER_DEFINED_STREAMS |
468 |
case smm_user_defined: |
case smm_user_defined: |
469 |
sgc_mark_object(x->sm.sm_object0); |
sgc_mark_object(x->sm.sm_object0); |
470 |
sgc_mark_object(x->sm.sm_object1); |
sgc_mark_object(x->sm.sm_object1); |
471 |
break; |
break; |
472 |
#endif |
#endif |
473 |
default: |
default: |
474 |
error("mark stream botch"); |
error("mark stream botch"); |
475 |
} |
} |
476 |
break; |
break; |
477 |
|
|
478 |
case t_random: |
case t_random: |
479 |
break; |
break; |
480 |
|
|
481 |
case t_readtable: |
case t_readtable: |
482 |
if (x->rt.rt_self == NULL) |
if (x->rt.rt_self == NULL) |
483 |
break; |
break; |
484 |
if (what_to_collect == t_contiguous) |
if (what_to_collect == t_contiguous) |
485 |
mark_contblock((char *)(x->rt.rt_self), |
mark_contblock((char *)(x->rt.rt_self), |
486 |
RTABSIZE*sizeof(struct rtent)); |
RTABSIZE*sizeof(struct rtent)); |
487 |
for (i = 0; i < RTABSIZE; i++) { |
for (i = 0; i < RTABSIZE; i++) { |
488 |
sgc_mark_object(x->rt.rt_self[i].rte_macro); |
sgc_mark_object(x->rt.rt_self[i].rte_macro); |
489 |
if (x->rt.rt_self[i].rte_dtab != NULL) { |
if (x->rt.rt_self[i].rte_dtab != NULL) { |
|
/**/ |
|
490 |
if (what_to_collect == t_contiguous) |
if (what_to_collect == t_contiguous) |
491 |
mark_contblock((char *)(x->rt.rt_self[i].rte_dtab), |
mark_contblock((char *)(x->rt.rt_self[i].rte_dtab), |
492 |
RTABSIZE*sizeof(object)); |
RTABSIZE*sizeof(object)); |
493 |
for (j = 0; j < RTABSIZE; j++) |
for (j = 0; j < RTABSIZE; j++) |
494 |
sgc_mark_object(x->rt.rt_self[i].rte_dtab[j]); |
sgc_mark_object(x->rt.rt_self[i].rte_dtab[j]); |
495 |
/**/ |
} |
496 |
} |
} |
497 |
} |
break; |
498 |
break; |
|
499 |
|
case t_pathname: |
500 |
case t_pathname: |
sgc_mark_object(x->pn.pn_host); |
501 |
sgc_mark_object(x->pn.pn_host); |
sgc_mark_object(x->pn.pn_device); |
502 |
sgc_mark_object(x->pn.pn_device); |
sgc_mark_object(x->pn.pn_directory); |
503 |
sgc_mark_object(x->pn.pn_directory); |
sgc_mark_object(x->pn.pn_name); |
504 |
sgc_mark_object(x->pn.pn_name); |
sgc_mark_object(x->pn.pn_type); |
505 |
sgc_mark_object(x->pn.pn_type); |
sgc_mark_object(x->pn.pn_version); |
506 |
sgc_mark_object(x->pn.pn_version); |
break; |
507 |
break; |
|
508 |
|
case t_closure: |
509 |
case t_closure: |
{ |
510 |
{ int i ; |
int i ; |
511 |
if (what_to_collect == t_contiguous) |
if (what_to_collect == t_contiguous) |
512 |
mark_contblock(x->cc.cc_turbo,x->cc.cc_envdim); |
mark_contblock(x->cc.cc_turbo,x->cc.cc_envdim); |
513 |
for (i= 0 ; i < x->cc.cc_envdim ; i++) { |
for (i= 0 ; i < x->cc.cc_envdim ; i++) |
514 |
sgc_mark_object(x->cc.cc_turbo[i]);}} |
sgc_mark_object(x->cc.cc_turbo[i]); |
515 |
|
} |
516 |
|
|
517 |
case t_cfun: |
case t_cfun: |
518 |
case t_sfun: |
case t_sfun: |
519 |
case t_vfun: |
case t_vfun: |
520 |
case t_afun: |
case t_afun: |
521 |
case t_gfun: |
case t_gfun: |
522 |
sgc_mark_object(x->cf.cf_name); |
sgc_mark_object(x->cf.cf_name); |
523 |
sgc_mark_object(x->cf.cf_data); |
sgc_mark_object(x->cf.cf_data); |
524 |
break; |
break; |
525 |
|
|
526 |
case t_cfdata: |
case t_cfdata: |
527 |
|
|
528 |
if (x->cfd.cfd_self != NULL) |
if (x->cfd.cfd_self != NULL) { |
529 |
{int i=x->cfd.cfd_fillp; |
int i=x->cfd.cfd_fillp; |
530 |
while(i-- > 0) |
while(i-- > 0) |
531 |
sgc_mark_object(x->cfd.cfd_self[i]);} |
sgc_mark_object(x->cfd.cfd_self[i]); |
532 |
if (x->cfd.cfd_start == NULL) |
} |
533 |
break; |
if (x->cfd.cfd_start == NULL) |
534 |
if (what_to_collect == t_contiguous) { |
break; |
535 |
if (!MAYBE_DATA_P((x->cfd.cfd_start)) || |
if (what_to_collect == t_contiguous) { |
536 |
get_mark_bit((int *)(x->cfd.cfd_start))) |
if (!MAYBE_DATA_P((x->cfd.cfd_start)) || |
537 |
break; |
get_mark_bit((int *)(x->cfd.cfd_start))) |
538 |
mark_contblock(x->cfd.cfd_start, x->cfd.cfd_size);} |
break; |
539 |
break; |
mark_contblock(x->cfd.cfd_start, x->cfd.cfd_size); |
540 |
case t_cclosure: |
} |
541 |
sgc_mark_object(x->cc.cc_name); |
break; |
542 |
sgc_mark_object(x->cc.cc_env); |
case t_cclosure: |
543 |
sgc_mark_object(x->cc.cc_data); |
sgc_mark_object(x->cc.cc_name); |
544 |
if (what_to_collect == t_contiguous) { |
sgc_mark_object(x->cc.cc_env); |
545 |
if (x->cc.cc_turbo != NULL) |
sgc_mark_object(x->cc.cc_data); |
546 |
mark_contblock((char *)(x->cc.cc_turbo-1), |
if (what_to_collect == t_contiguous) { |
547 |
(1+fix(*(x->cc.cc_turbo-1)))*sizeof(object)); |
if (x->cc.cc_turbo != NULL) |
548 |
} |
mark_contblock((char *)(x->cc.cc_turbo-1), |
549 |
break; |
(1+fix(*(x->cc.cc_turbo-1)))*sizeof(object)); |
550 |
|
} |
551 |
case t_spice: |
break; |
552 |
break; |
|
553 |
|
case t_spice: |
554 |
default: |
break; |
555 |
|
|
556 |
|
default: |
557 |
#ifdef DEBUG |
#ifdef DEBUG |
558 |
if (debug) |
if (debug) |
559 |
printf("\ttype = %d\n", type_of(x)); |
printf("\ttype = %d\n", type_of(x)); |
560 |
#endif |
#endif |
561 |
error("mark botch"); |
error("mark botch"); |
562 |
} |
} |
563 |
|
|
564 |
} |
} |
565 |
|
|
566 |
|
void |
567 |
|
sgc_mark_stack_carefully(void *topv, void *bottomv, int offset) { |
568 |
|
|
569 |
|
int p,m,pageoffset; |
570 |
|
object x; |
571 |
|
struct typemanager *tm; |
572 |
|
register long *j; |
573 |
|
long *top=topv,*bottom=bottomv; |
574 |
|
|
575 |
|
/* if either of these happens we are marking the C stack |
576 |
|
and need to use a local */ |
577 |
|
|
578 |
|
if (top==0) top = c_stack_where; |
579 |
|
if (bottom==0) bottom= c_stack_where; |
580 |
|
|
581 |
|
/* On machines which align local pointers on multiple of 2 rather |
582 |
|
than 4 we need to mark twice |
583 |
|
*/ |
584 |
|
|
585 |
|
if (offset) |
586 |
|
sgc_mark_stack_carefully((((char *) top) +offset),bottom,0); |
587 |
|
for (j=top ; j >= bottom ; j--) { |
588 |
|
if (VALID_DATA_ADDRESS_P(*j) |
589 |
|
&& type_map[(p=page(*j))]< (char)t_end) { |
590 |
|
pageoffset=((char *)*j - pagetochar(p)); |
591 |
|
tm=tm_of((enum type) type_map[p]); |
592 |
|
x= (object) |
593 |
|
((char *)(*j) - |
594 |
|
((pageoffset=((char *)*j - pagetochar(p))) % |
595 |
|
tm->tm_size)); |
596 |
|
if ((pageoffset < (tm->tm_size * tm->tm_nppage)) |
597 |
|
&& (m=x->d.m) != FREE) { |
598 |
|
if (m==TRUE) continue; |
599 |
|
if (m!=0) { |
600 |
|
fprintf(stdout, |
601 |
|
"**bad value %d of d.m in gbc page %d skipping mark**" |
602 |
|
,m,p);fflush(stdout); |
603 |
|
continue; |
604 |
|
} |
605 |
|
sgc_mark_object(x); |
606 |
|
} |
607 |
|
} |
608 |
|
} |
609 |
|
} |
610 |
|
|
611 |
|
void |
612 |
|
sgc_mark_phase(void) { |
613 |
|
|
614 |
sgc_mark_stack_carefully(top,bottom,offset) |
STATIC int i, j; |
615 |
long *bottom,*top; |
STATIC struct package *pp; |
616 |
{int p,m,pageoffset; |
STATIC bds_ptr bdp; |
617 |
object x; |
STATIC frame_ptr frp; |
618 |
struct typemanager *tm; |
STATIC ihs_ptr ihsp; |
619 |
register long *j; |
|
620 |
|
sgc_mark_object(Cnil); |
621 |
/* if either of these happens we are marking the C stack |
sgc_mark_object(Ct); |
622 |
and need to use a local */ |
|
623 |
|
/* mark all non recent data on writable pages */ |
624 |
if (top==0) top = c_stack_where; |
{ |
625 |
if (bottom==0) bottom= c_stack_where; |
int t,i=page(heap_end); |
626 |
|
struct typemanager *tm; |
627 |
/* On machines which align local pointers on multiple of 2 rather |
char *p; |
628 |
than 4 we need to mark twice |
|
629 |
*/ |
while (--i >= 0) { |
630 |
|
if (WRITABLE_PAGE_P(i) |
631 |
if (offset) {sgc_mark_stack_carefully((((char *) top) +offset),bottom,0);} |
&& (t=type_map[i]) < (int) t_end) |
632 |
for (j=top ; j >= bottom ; j--) |
; |
633 |
{if (VALID_DATA_ADDRESS_P(*j) |
else |
634 |
&& type_map[(p=page(*j))]< (char)t_end) |
continue; |
635 |
{pageoffset=((char *)*j - pagetochar(p)); |
tm=tm_of(t); |
636 |
tm=tm_of((enum type) type_map[p]); |
p=pagetochar(i); |
637 |
x= (object) |
if ( t == t_cons) |
638 |
((char *)(*j) - |
for (j = tm->tm_nppage; --j >= 0; p += sizeof(struct cons)) { |
639 |
((pageoffset=((char *)*j - pagetochar(p))) % |
object x = (object) p; |
640 |
tm->tm_size)); |
if (SGC_OR_M(x)) |
641 |
if ((pageoffset < (tm->tm_size * tm->tm_nppage)) |
continue; |
642 |
&& (m=x->d.m) != FREE) |
if (x->d.t==t_cons) { |
643 |
{if (m==TRUE) continue; |
x->d.m = TRUE; |
644 |
if (m!=0) |
sgc_mark_cons(x); |
645 |
{fprintf(stdout, |
} else |
646 |
"**bad value %d of d.m in gbc page %d skipping mark**" |
sgc_mark_object1(x); |
|
,m,p);fflush(stdout); |
|
|
continue; |
|
|
}; |
|
|
sgc_mark_object(x);}}}} |
|
|
|
|
|
|
|
|
sgc_mark_phase() |
|
|
{ |
|
|
STATIC object *p; |
|
|
STATIC int i, j, k, n; |
|
|
STATIC struct package *pp; |
|
|
STATIC object s, l, *lp; |
|
|
STATIC bds_ptr bdp; |
|
|
STATIC frame_ptr frp; |
|
|
STATIC ihs_ptr ihsp; |
|
|
STATIC char *cp; |
|
|
|
|
|
sgc_mark_object(Cnil); |
|
|
sgc_mark_object(Ct); |
|
|
|
|
|
|
|
|
|
|
|
/* mark all non recent data on writable pages */ |
|
|
{int t,i=page(heap_end); |
|
|
struct typemanager *tm; |
|
|
char *p; |
|
|
|
|
|
while (--i >= 0) |
|
|
{if (WRITABLE_PAGE_P(i) |
|
|
&& (t=type_map[i]) < (int) t_end); |
|
|
else continue; |
|
|
tm=tm_of(t); |
|
|
p=pagetochar(i); |
|
|
if ( t == t_cons) |
|
|
for (j = tm->tm_nppage; --j >= 0; p += sizeof(struct cons)) |
|
|
{object x = (object) p; |
|
|
if (SGC_OR_M(x)) continue; |
|
|
if (x->d.t==t_cons) {x->d.m = TRUE; sgc_mark_cons(x);} |
|
|
else |
|
|
sgc_mark_object1(x); |
|
|
} |
|
|
else |
|
|
{int size=tm->tm_size; |
|
|
for (j = tm->tm_nppage; --j >= 0; p += size) |
|
|
{object x = (object) p; |
|
|
if (SGC_OR_M(x)) continue; |
|
|
sgc_mark_object1(x); |
|
|
}}}} |
|
|
|
|
|
|
|
|
sgc_mark_stack_carefully(vs_top-1,vs_org,0); |
|
|
clear_stack(vs_top,vs_limit); |
|
|
sgc_mark_stack_carefully(MVloc+(sizeof(MVloc)/sizeof(object)),MVloc,0); |
|
|
/* |
|
|
for (p = vs_org; p < vs_top; p++) { |
|
|
if (p && (inheap(*p))) |
|
|
sgc_mark_object(*p); |
|
647 |
} |
} |
648 |
*/ |
else { |
649 |
#ifdef DEBUG |
int size=tm->tm_size; |
650 |
if (debug) { |
for (j = tm->tm_nppage; --j >= 0; p += size) { |
651 |
printf("value stack marked\n"); |
object x = (object) p; |
652 |
fflush(stdout); |
if (SGC_OR_M(x)) continue; |
653 |
|
sgc_mark_object1(x); |
654 |
} |
} |
655 |
|
} |
656 |
|
} |
657 |
|
} |
658 |
|
|
659 |
|
sgc_mark_stack_carefully(vs_top-1,vs_org,0); |
660 |
|
clear_stack(vs_top,vs_limit); |
661 |
|
sgc_mark_stack_carefully(MVloc+(sizeof(MVloc)/sizeof(object)),MVloc,0); |
662 |
|
/* |
663 |
|
for (p = vs_org; p < vs_top; p++) { |
664 |
|
if (p && (inheap(*p))) |
665 |
|
sgc_mark_object(*p); |
666 |
|
} |
667 |
|
*/ |
668 |
|
#ifdef DEBUG |
669 |
|
if (debug) { |
670 |
|
printf("value stack marked\n"); |
671 |
|
fflush(stdout); |
672 |
|
} |
673 |
#endif |
#endif |
674 |
|
|
675 |
for (bdp = bds_org; bdp<=bds_top; bdp++) { |
for (bdp = bds_org; bdp<=bds_top; bdp++) { |
676 |
sgc_mark_object(bdp->bds_sym); |
sgc_mark_object(bdp->bds_sym); |
677 |
sgc_mark_object(bdp->bds_val); |
sgc_mark_object(bdp->bds_val); |
678 |
} |
} |
679 |
|
|
680 |
for (frp = frs_org; frp <= frs_top; frp++) |
for (frp = frs_org; frp <= frs_top; frp++) |
681 |
sgc_mark_object(frp->frs_val); |
sgc_mark_object(frp->frs_val); |
682 |
|
|
683 |
for (ihsp = ihs_org; ihsp <= ihs_top; ihsp++) |
for (ihsp = ihs_org; ihsp <= ihs_top; ihsp++) |
684 |
sgc_mark_object(ihsp->ihs_function); |
sgc_mark_object(ihsp->ihs_function); |
685 |
|
|
686 |
for (i = 0; i < mark_origin_max; i++) |
for (i = 0; i < mark_origin_max; i++) |
687 |
sgc_mark_object(*mark_origin[i]); |
sgc_mark_object(*mark_origin[i]); |
688 |
for (i = 0; i < mark_origin_block_max; i++) |
for (i = 0; i < mark_origin_block_max; i++) |
689 |
for (j = 0; j < mark_origin_block[i].mob_size; j++) |
for (j = 0; j < mark_origin_block[i].mob_size; j++) |
690 |
sgc_mark_object(mark_origin_block[i].mob_addr[j]); |
sgc_mark_object(mark_origin_block[i].mob_addr[j]); |
691 |
|
|
692 |
for (pp = pack_pointer; pp != NULL; pp = pp->p_link) |
for (pp = pack_pointer; pp != NULL; pp = pp->p_link) |
693 |
sgc_mark_object((object)pp); |
sgc_mark_object((object)pp); |
694 |
#ifdef KCLOVM |
#ifdef KCLOVM |
695 |
if (ovm_process_created) |
if (ovm_process_created) |
696 |
sgc_mark_all_stacks(); |
sgc_mark_all_stacks(); |
697 |
#endif |
#endif |
698 |
|
|
699 |
#ifdef DEBUG |
#ifdef DEBUG |
700 |
if (debug) { |
if (debug) { |
701 |
printf("symbol navigation\n"); |
printf("symbol navigation\n"); |
702 |
fflush(stdout); |
fflush(stdout); |
703 |
} |
} |
704 |
#endif |
#endif |
705 |
{int size; |
{ |
706 |
|
int size; |
707 |
for (pp = pack_pointer; pp != NULL; pp = pp->p_link) { |
|
708 |
size = pp->p_internal_size; |
for (pp = pack_pointer; pp != NULL; pp = pp->p_link) { |
709 |
if (pp->p_internal != NULL) |
size = pp->p_internal_size; |
710 |
for (i = 0; i < size; i++) |
if (pp->p_internal != NULL) |
711 |
sgc_mark_pack_list(pp->p_internal[i]); |
for (i = 0; i < size; i++) |
712 |
size = pp->p_external_size; |
sgc_mark_pack_list(pp->p_internal[i]); |
713 |
if (pp->p_external != NULL) |
size = pp->p_external_size; |
714 |
for (i = 0; i < size; i++) |
if (pp->p_external != NULL) |
715 |
sgc_mark_pack_list(pp->p_external[i]); |
for (i = 0; i < size; i++) |
716 |
}} |
sgc_mark_pack_list(pp->p_external[i]); |
717 |
|
} |
718 |
|
} |
719 |
mark_c_stack(0,N_RECURSION_REQD,sgc_mark_stack_carefully); |
|
720 |
|
mark_c_stack(0,N_RECURSION_REQD,sgc_mark_stack_carefully); |
721 |
|
|
722 |
} |
} |
723 |
|
|
724 |
sgc_sweep_phase() |
void |
725 |
{ |
sgc_sweep_phase(void) { |
726 |
STATIC int i, j, k; |
STATIC int i, j, k; |
727 |
STATIC object x; |
STATIC object x; |
728 |
STATIC char *p; |
STATIC char *p; |
729 |
STATIC int *ip; |
STATIC struct typemanager *tm; |
730 |
STATIC struct typemanager *tm; |
STATIC object f; |
731 |
STATIC object f; |
int size; |
732 |
int size; |
|
733 |
|
Cnil->s.m = FALSE; |
734 |
Cnil->s.m = FALSE; |
Ct->s.m = FALSE; |
735 |
Ct->s.m = FALSE; |
|
|
|
|
736 |
#ifdef DEBUG |
#ifdef DEBUG |
737 |
if (debug) |
if (debug) |
738 |
printf("type map\n"); |
printf("type map\n"); |
739 |
#endif |
#endif |
740 |
for (i = 0; i < maxpage; i++) { |
for (i = 0; i < maxpage; i++) { |
741 |
if (type_map[i] == (int)t_contiguous) { |
if (type_map[i] == (int)t_contiguous) { |
742 |
if (debug) { |
if (debug) { |
743 |
printf("-"); |
printf("-"); |
|
/* |
|
|
fflush(stdout); |
|
|
*/ |
|
|
continue; |
|
|
} |
|
|
} |
|
|
if (type_map[i] >= (int)t_end) |
|
|
continue; |
|
|
|
|
|
tm = tm_of((enum type)type_map[i]); |
|
|
|
|
744 |
/* |
/* |
745 |
general sweeper |
fflush(stdout); |
746 |
*/ |
*/ |
747 |
|
continue; |
748 |
|
} |
749 |
|
} |
750 |
|
if (type_map[i] >= (int)t_end) |
751 |
|
continue; |
752 |
|
|
753 |
|
tm = tm_of((enum type)type_map[i]); |
754 |
|
|
755 |
|
/* |
756 |
|
general sweeper |
757 |
|
*/ |
758 |
|
|
759 |
#ifdef DEBUG |
#ifdef DEBUG |
760 |
if (debug) { |
if (debug) { |
761 |
printf("%c", tm->tm_name[0]); |
printf("%c", tm->tm_name[0]); |
762 |
/* |
/* |
763 |
fflush(stdout); |
fflush(stdout); |
764 |
*/ |
*/ |
765 |
} |
} |
766 |
#endif |
#endif |
767 |
if (!WRITABLE_PAGE_P(i)) continue; |
if (!WRITABLE_PAGE_P(i)) |
768 |
p = pagetochar(i); |
continue; |
769 |
f = tm->tm_free; |
p = pagetochar(i); |
770 |
k = 0; |
f = tm->tm_free; |
771 |
size=tm->tm_size; |
k = 0; |
772 |
if (SGC_PAGE_P(i)) { |
size=tm->tm_size; |
773 |
for (j = tm->tm_nppage; --j >= 0; p += size) { |
if (SGC_PAGE_P(i)) { |
774 |
x = (object)p; |
for (j = tm->tm_nppage; --j >= 0; p += size) { |
775 |
|
x = (object)p; |
776 |
if (x->d.m == FREE) |
|
777 |
continue; |
if (x->d.m == FREE) |
778 |
else if (x->d.m) { |
continue; |
779 |
x->d.m = FALSE; |
else if (x->d.m) { |
780 |
continue; |
x->d.m = FALSE; |
781 |
} |
continue; |
782 |
if(x->d.s == SGC_NORMAL) |
} |
783 |
continue; |
if(x->d.s == SGC_NORMAL) |
784 |
|
continue; |
785 |
/* it is ok to free x */ |
|
786 |
|
/* it is ok to free x */ |
787 |
|
|
788 |
#ifdef OLD_DISPLACE |
#ifdef OLD_DISPLACE |
789 |
/* old_displace: from might be free, to not */ |
/* old_displace: from might be free, to not */ |
790 |
if(x->d.t >=t_array && x->d.t <= t_bitvector) |
if(x->d.t >=t_array && x->d.t <= t_bitvector) { |
791 |
{ |
/* case t_array: |
792 |
/* case t_array: |
case t_vector: |
793 |
case t_vector: |
case t_string: |
794 |
case t_string: |
case t_bitvector: |
795 |
case t_bitvector: |
*/ |
796 |
*/ |
if (x->a.a_displaced->c.c_car != Cnil) { |
797 |
if (x->a.a_displaced->c.c_car != Cnil) |
undisplace(x); |
798 |
{undisplace(x); |
/* The cons x->a.a_displaced cons has been saved, |
799 |
/* The cons x->a.a_displaced cons has been saved, |
so as to save the pointer to x->a.a_displaced->c.c_car; |
800 |
so as to save the pointer to x->a.a_displaced->c.c_car; |
However any arrays in its cdr, must have been |
801 |
However any arrays in its cdr, must have been |
freed, or we would not be freeing x. To avoid |
802 |
freed, or we would not be freeing x. To avoid |
having a cons with trash in the cdr we set the |
803 |
having a cons with trash in the cdr we set the |
cdr to nil |
804 |
cdr to nil |
*/ |
805 |
*/ |
x->a.a_displaced->c.c_cdr = Cnil; |
806 |
x->a.a_displaced->c.c_cdr = Cnil;} |
} |
807 |
} |
} |
808 |
#endif OLD_DISPLACE |
#endif OLD_DISPLACE |
809 |
#ifdef GMP_USE_MALLOC |
#ifdef GMP_USE_MALLOC |
810 |
if (x->d.t == t_bignum) { |
if (x->d.t == t_bignum) |
811 |
mpz_clear(MP(x)); |
mpz_clear(MP(x)); |
812 |
} |
#endif |
813 |
#endif |
|
814 |
|
SET_LINK(x,f); |
815 |
SET_LINK(x,f); |
x->d.m = FREE; |
816 |
x->d.m = FREE; |
x->d.s = (int)SGC_RECENT; |
817 |
x->d.s = (int)SGC_RECENT; |
f = x; |
818 |
f = x; |
k++; |
819 |
k++; |
} |
820 |
} |
tm->tm_free = f; |
821 |
tm->tm_free = f; |
tm->tm_nfree += k; |
822 |
tm->tm_nfree += k; |
} |
823 |
} |
else /*non sgc_page */ |
824 |
else /*non sgc_page */ |
for (j = tm->tm_nppage; --j >= 0; p += size) { |
825 |
for (j = tm->tm_nppage; --j >= 0; p += size) { |
x = (object)p; |
826 |
x = (object)p; |
if (x->d.m == TRUE) x->d.m=FALSE; |
827 |
|
} |
828 |
if (x->d.m == TRUE) x->d.m=FALSE; |
|
829 |
} |
} |
|
|
|
|
|
|
|
NEXT_PAGE: |
|
|
; |
|
|
} |
|
830 |
#ifdef DEBUG |
#ifdef DEBUG |
831 |
if (debug) { |
if (debug) { |
832 |
putchar('\n'); |
putchar('\n'); |
833 |
fflush(stdout); |
fflush(stdout); |
834 |
} |
} |
835 |
#endif |
#endif |
836 |
} |
} |
837 |
|
|
838 |
|
|
839 |
sgc_contblock_sweep_phase() |
void |
840 |
{ |
sgc_contblock_sweep_phase(void) { |
841 |
STATIC int i, j; |
|
842 |
STATIC char *s, *e, *p, *q; |
STATIC int i, j; |
843 |
STATIC struct contblock *cbp; |
STATIC char *s, *e, *p, *q; |
844 |
|
STATIC struct contblock *cbp; |
845 |
cb_pointer = NULL; |
|
846 |
ncb = 0; |
cb_pointer = NULL; |
847 |
for (i = 0; i < maxpage;) { |
ncb = 0; |
848 |
if (type_map[i] != (int)t_contiguous |
for (i = 0; i < maxpage;) { |
849 |
|| !SGC_PAGE_P(i)) |
if (type_map[i] != (int)t_contiguous |
850 |
{ |
|| !SGC_PAGE_P(i)) { |
851 |
i++; |
i++; |
852 |
continue; |
continue; |
853 |
} |
} |
854 |
for (j = i+1; |
for (j = i+1; |
855 |
j < maxpage && type_map[j] == (int)t_contiguous |
j < maxpage && type_map[j] == (int)t_contiguous |
856 |
&& SGC_PAGE_P(j) |
&& SGC_PAGE_P(j); |
857 |
; |
j++); |
858 |
j++) |
s = pagetochar(i); |
859 |
; |
e = pagetochar(j); |
860 |
s = pagetochar(i); |
for (p = s; p < e;) { |
861 |
e = pagetochar(j); |
if (get_mark_bit((int *)p)) { |
862 |
for (p = s; p < e;) { |
p += PTR_ALIGN; |
863 |
if (get_mark_bit((int *)p)) { |
continue; |
864 |
p += PTR_ALIGN; |
} |
865 |
continue; |
q = p + PTR_ALIGN; |
866 |
} |
while (q < e) { |
867 |
q = p + PTR_ALIGN; |
if (!get_mark_bit((int *)q)) { |
868 |
while (q < e) { |
q += PTR_ALIGN; |
869 |
if (!get_mark_bit((int *)q)) { |
continue; |
|
q += PTR_ALIGN; |
|
|
continue; |
|
|
} |
|
|
break; |
|
|
} |
|
|
insert_contblock(p, q - p); |
|
|
p = q + PTR_ALIGN; |
|
|
} |
|
|
i = j + 1; |
|
870 |
} |
} |
871 |
|
break; |
872 |
|
} |
873 |
|
insert_contblock(p, q - p); |
874 |
|
p = q + PTR_ALIGN; |
875 |
|
} |
876 |
|
i = j + 1; |
877 |
|
} |
878 |
#ifdef DEBUG |
#ifdef DEBUG |
879 |
if (debug) { |
if (debug) { |
880 |
for (cbp = cb_pointer; cbp != NULL; cbp = cbp->cb_link) |
for (cbp = cb_pointer; cbp != NULL; cbp = cbp->cb_link) |
881 |
printf("%d-byte contblock\n", cbp->cb_size); |
printf("%d-byte contblock\n", cbp->cb_size); |
882 |
fflush(stdout); |
fflush(stdout); |
883 |
} |
} |
884 |
#endif |
#endif |
885 |
} |
} |
886 |
|
|
893 |
|
|
894 |
#undef tm |
#undef tm |
895 |
|
|
|
|
|
|
|
|
896 |
#ifdef SDEBUG |
#ifdef SDEBUG |
897 |
sgc_count(yy) |
sgc_count(object yy) { |
898 |
object yy; |
int count=0; |
899 |
{int count=0; |
object y=yy; |
900 |
object y=yy; |
while(y) |
901 |
while(y) |
{count++; |
|
{count++; |
|
902 |
y=OBJ_LINK(y);} |
y=OBJ_LINK(y);} |
903 |
printf("[length %x = %d]",yy,count); |
printf("[length %x = %d]",yy,count); |
904 |
fflush(stdout); |
fflush(stdout); |
905 |
} |
} |
906 |
|
|
907 |
#endif |
#endif |
908 |
/* count writable pages excluding the hole */ |
/* count writable pages excluding the hole */ |
909 |
sgc_count_writable(end) |
int |
910 |
int end; |
sgc_count_writable(int end) { |
911 |
{ int j = first_protectable_page -1; |
|
912 |
|
int j = first_protectable_page -1; |
913 |
int count = 0; |
int count = 0; |
914 |
int hp_end= page(heap_end); |
int hp_end= page(heap_end); |
915 |
while(j++ < hp_end) |
while(j++ < hp_end) |
917 |
j= page(rb_start); |
j= page(rb_start); |
918 |
while(j++ < end) |
while(j++ < end) |
919 |
if (WRITABLE_PAGE_P(j)) count++; |
if (WRITABLE_PAGE_P(j)) count++; |
920 |
return count;} |
return count; |
921 |
|
} |
922 |
|
|
923 |
|
|
924 |
|
int |
925 |
|
sgc_count_type(int t) { |
926 |
|
|
927 |
sgc_count_type(t) |
int j = first_protectable_page -1; |
|
int t; |
|
|
{int j = first_protectable_page -1; |
|
928 |
int end = page(core_end); |
int end = page(core_end); |
929 |
int count=0; |
int count=0; |
930 |
while(j++ < end) |
while(j++ < end) |
931 |
if (type_map[j]==t && SGC_PAGE_P(j)) |
if (type_map[j]==t && SGC_PAGE_P(j)) |
932 |
count++; |
count++; |
933 |
return count;} |
return count; |
934 |
|
} |
|
|
|
|
|
|
935 |
|
|
936 |
|
int |
937 |
|
sgc_start(void) { |
938 |
|
|
939 |
sgc_start() |
int i; |
940 |
{int i; |
int np; |
941 |
int np; |
short free_map[MAXPAGE]; |
942 |
int bug; |
object f; |
943 |
short free_map[MAXPAGE]; |
struct typemanager *tm; |
944 |
object f, fr[(int)t_end]; |
int npages; |
945 |
struct typemanager *tm; |
if (sgc_type_map[page((&sgc_type_map[0]))] != SGC_PERM_WRITABLE) |
946 |
int npages; |
perm_writable(&sgc_type_map[0],sizeof(sgc_type_map)); |
947 |
if (sgc_type_map[page((&sgc_type_map[0]))] != SGC_PERM_WRITABLE ) |
if (sgc_enabled) |
948 |
{perm_writable(&sgc_type_map[0],sizeof(sgc_type_map)); |
return 1; |
949 |
} |
sgc_type_map[0]=0; |
950 |
if (sgc_enabled) |
i=npages=page(core_end); |
951 |
return 1; |
while (i--> 0) |
952 |
sgc_type_map[0]=0; |
sgc_type_map[i] = sgc_type_map[i] & SGC_PERM_WRITABLE ; |
953 |
AGAIN: |
|
954 |
i=npages=page(core_end); |
for (i= t_start; i < t_contiguous ; i++) |
955 |
while (i--> 0) |
if (TM_BASE_TYPE_P(i) && (np=(tm=tm_of(i))->tm_sgc)) |
956 |
sgc_type_map[i] = sgc_type_map[i] & SGC_PERM_WRITABLE ; |
FIND_FREE_PAGES: |
957 |
|
{ |
958 |
for (i= t_start; i < t_contiguous ; i++) |
int maxp=0; |
959 |
if (TM_BASE_TYPE_P(i) && (np=(tm=tm_of(i))->tm_sgc)) |
int j; |
960 |
FIND_FREE_PAGES: |
int minfree = tm->tm_sgc_minfree; |
961 |
{ |
int count; |
962 |
int maxp=0; |
bzero(free_map,npages*sizeof(short)); |
963 |
int j; |
f = tm->tm_free; |
964 |
int minfree = tm->tm_sgc_minfree; |
count=0; |
965 |
int count,tm_sgc; |
while (f!=0) { |
966 |
bzero(free_map,npages*sizeof(short)); |
free_map[j=page(f)]++; |
967 |
f = tm->tm_free; |
if (j>=maxp) maxp=j; |
|
count=0; |
|
|
while (f!=0) |
|
|
{free_map[j=page(f)]++; |
|
|
if (j>=maxp) maxp=j; |
|
968 |
#ifdef DEBUG |
#ifdef DEBUG |
969 |
count++; |
count++; |
970 |
#endif |
#endif |
971 |
f= OBJ_LINK(f); |
f= OBJ_LINK(f); |
972 |
} |
} |
973 |
#ifdef DEBUG |
#ifdef DEBUG |
974 |
if (count!=tm->tm_nfree) |
if (count!=tm->tm_nfree) |
975 |
{printf("[Count differed type(%d)nfree= %d in freelist %d]\n" |
printf("[Count differed type(%d)nfree= %d in freelist %d]\n" |
976 |
,tm->tm_type,tm->tm_nfree, |
,tm->tm_type,tm->tm_nfree, |
977 |
count);fflush(stdout);} |
count);fflush(stdout); |
978 |
#endif |
#endif |
979 |
for(j=0,count=0; j <= maxp ;j++) |
for(j=0,count=0; j <= maxp ;j++) { |
980 |
{if (free_map[j] >= minfree) |
if (free_map[j] >= minfree) { |
981 |
{sgc_type_map[j] |= (SGC_PAGE_FLAG | SGC_TEMP_WRITABLE); |
sgc_type_map[j] |= (SGC_PAGE_FLAG | SGC_TEMP_WRITABLE); |
982 |
++count; |
++count; |
983 |
if (count >= tm->tm_sgc_max) |
if (count >= tm->tm_sgc_max) |
984 |
break; |
break; |
985 |
}} |
} |
986 |
|
} |
987 |
/* don't do any more allocations for this type if saving system */ |
|
988 |
if (saving_system) continue; |
/* don't do any more allocations for this type if saving system */ |
989 |
|
if (saving_system) |
990 |
if (count < tm->tm_sgc) |
continue; |
991 |
/* try to get some more free pages of type i */ |
|
992 |
{ int n = tm->tm_sgc - count; |
if (count < tm->tm_sgc) { |
993 |
int again=0,nfree = tm->tm_nfree; |
/* try to get some more free pages of type i */ |
994 |
char *p=alloc_page(n); |
int n = tm->tm_sgc - count; |
995 |
if (tm->tm_nfree > nfree) again=1; /* gc freed some objects */ |
int again=0,nfree = tm->tm_nfree; |
996 |
while (n-- > 0) |
char *p=alloc_page(n); |
997 |
{(sgc_enabled=1,add_page_to_freelist(p,tm),sgc_enabled=0); |
if (tm->tm_nfree > nfree) again=1; /* gc freed some objects */ |
998 |
p += PAGESIZE;} |
while (n-- > 0) { |
999 |
if (again) goto FIND_FREE_PAGES; }} |
(sgc_enabled=1,add_page_to_freelist(p,tm),sgc_enabled=0); |
1000 |
|
p += PAGESIZE; |
1001 |
|
} |
1002 |
|
if (again) |
1003 |
|
goto FIND_FREE_PAGES; |
1004 |
|
} |
1005 |
|
} |
1006 |
/* Now allocate the sgc relblock. We do this as the tail |
/* Now allocate the sgc relblock. We do this as the tail |
1007 |
end of the ordinary rb. */ |
end of the ordinary rb. */ |
1008 |
{int want; |
{ |
1009 |
char *new; |
int want; |
1010 |
tm=tm_of(t_relocatable); |
char *new; |
1011 |
want =((int) (rb_end - rb_pointer) >> PAGEWIDTH); |
tm=tm_of(t_relocatable); |
1012 |
if (want < tm->tm_sgc) want = tm->tm_sgc; |
want =((int) (rb_end - rb_pointer) >> PAGEWIDTH); |
1013 |
else { want = (want < 4 ? want : want -2);} |
if (want < tm->tm_sgc) want = tm->tm_sgc; |
1014 |
|
else |
1015 |
FINALE: |
want = (want < 4 ? want : want -2); |
1016 |
{old_rb_start=rb_start; |
|
1017 |
if(!saving_system) |
{ |
1018 |
{ new=alloc_relblock(want*PAGESIZE); |
old_rb_start=rb_start; |
1019 |
/* the above may cause a gc, shifting the relblock */ |
if(!saving_system) { |
1020 |
old_rb_start=rb_start; |
new=alloc_relblock(want*PAGESIZE); |
1021 |
new= PAGE_ROUND_UP(new); |
/* the above may cause a gc, shifting the relblock */ |
1022 |
rb_start=rb_pointer=new; |
old_rb_start=rb_start; |
1023 |
}}} |
new= PAGE_ROUND_UP(new); |
1024 |
/* the relblock has been allocated */ |
rb_start=rb_pointer=new; |
1025 |
|
} |
1026 |
|
} |
1027 |
|
} |
1028 |
|
/* the relblock has been allocated */ |
1029 |
|
|
1030 |
/* now move the sgc free lists into place. alt_free should |
/* now move the sgc free lists into place. alt_free should |
1031 |
contain the others */ |
contain the others */ |
1032 |
|
|
1033 |
for (i= t_start; i < t_contiguous ; i++) |
for (i= t_start; i < t_contiguous ; i++) |
1034 |
if (TM_BASE_TYPE_P(i) |
if (TM_BASE_TYPE_P(i) |
1035 |
&& (np=(tm=tm_of(i))->tm_sgc)) |
&& (np=(tm=tm_of(i))->tm_sgc)) { |
1036 |
{object f=tm->tm_free ,x,y,next; |
object f=tm->tm_free ,x,y,next; |
1037 |
int count=0; |
int count=0; |
1038 |
x=y=0; |
x=y=0; |
1039 |
|
|
1040 |
while (f!=0) |
while (f!=0) { |
1041 |
{next=OBJ_LINK(f); |
next=OBJ_LINK(f); |
1042 |
#ifdef SDEBUG |
#ifdef SDEBUG |
1043 |
if (f->d.m!=FREE) |
if (f->d.m!=FREE) |
1044 |
printf("Not FREE in freelist f=%d",f); |
printf("Not FREE in freelist f=%d",f); |
1045 |
#endif |
#endif |
1046 |
if (ON_SGC_PAGE(f)) |
if (ON_SGC_PAGE(f)) { |
1047 |
{ SET_LINK(f,x); |
SET_LINK(f,x); |
1048 |
f->d.s = SGC_RECENT; |
f->d.s = SGC_RECENT; |
1049 |
x=f; |
x=f; |
1050 |
count++; |
count++; |
1051 |
} |
} else { |
1052 |
else |
SET_LINK(f,y); |
1053 |
{SET_LINK(f,y); |
f->d.s = SGC_NORMAL; |
1054 |
f->d.s = SGC_NORMAL; |
y=f; |
1055 |
y=f;} |
} |
1056 |
f=next; |
f=next; |
1057 |
} |
} |
1058 |
tm->tm_free = x; |
tm->tm_free = x; |
1059 |
tm->tm_alt_free = y; |
tm->tm_alt_free = y; |
1060 |
tm->tm_alt_nfree = tm->tm_nfree - count; |
tm->tm_alt_nfree = tm->tm_nfree - count; |
1061 |
tm->tm_nfree=count; |
tm->tm_nfree=count; |
1062 |
} |
} |
1063 |
|
|
1064 |
/* Whew. We have now allocated the sgc space |
/* Whew. We have now allocated the sgc space |
1065 |
and modified the tm_table; |
and modified the tm_table; |
1066 |
Turn memory protection on for the pages which are writable. |
Turn memory protection on for the pages which are writable. |
1067 |
*/ |
*/ |
1068 |
memory_protect(1); |
memory_protect(1); |
1069 |
sgc_enabled=1; |
sgc_enabled=1; |
1070 |
if(sSAnotify_gbcA->s.s_dbind != Cnil) |
if (sSAnotify_gbcA->s.s_dbind != Cnil) { |
1071 |
{printf("[SGC on]"); fflush(stdout);} |
printf("[SGC on]"); |
1072 |
|
fflush(stdout); |
1073 |
|
} |
1074 |
|
|
1075 |
|
return 1; |
1076 |
|
|
1077 |
} |
} |
1078 |
|
|
1079 |
sgc_quit() |
int |
1080 |
{ struct typemanager *tm; |
sgc_quit(void) { |
1081 |
|
|
1082 |
|
struct typemanager *tm; |
1083 |
int i,np; |
int i,np; |
1084 |
|
|
1085 |
memory_protect(0); |
memory_protect(0); |
1086 |
if(sSAnotify_gbcA->s.s_dbind != Cnil) |
if(sSAnotify_gbcA->s.s_dbind != Cnil) |
1087 |
{printf("[SGC off]"); fflush(stdout);} |
printf("[SGC off]"); fflush(stdout); |
1088 |
if (sgc_enabled==0) return 0; |
if (sgc_enabled==0) |
1089 |
|
return 0; |
1090 |
sgc_enabled=0; |
sgc_enabled=0; |
1091 |
rb_start = old_rb_start; |
rb_start = old_rb_start; |
1092 |
for (i= t_start; i < t_contiguous ; i++) |
for (i= t_start; i < t_contiguous ; i++) |
1093 |
if (TM_BASE_TYPE_P(i)) |
if (TM_BASE_TYPE_P(i)) { |
1094 |
{tm=tm_of(i); |
tm=tm_of(i); |
1095 |
if (np=tm->tm_sgc) |
if ((np=tm->tm_sgc)) { |
1096 |
{object f,y; |
object f,y; |
1097 |
f=tm->tm_free; |
f=tm->tm_free; |
1098 |
if (f==0) tm->tm_free=tm->tm_alt_free; |
if (f==0) |
1099 |
else |
tm->tm_free=tm->tm_alt_free; |
1100 |
|
else { |
1101 |
/* tack the alt_free onto the end of free */ |
/* tack the alt_free onto the end of free */ |
|
{ |
|
1102 |
#ifdef SDEBUG |
#ifdef SDEBUG |
1103 |
int count=0; |
int count=0; |
1104 |
f=tm->tm_free; |
f=tm->tm_free; |
1105 |
while(y= (object) F_LINK(f)) |
while(y= (object) F_LINK(f)) { |
1106 |
{if(y->d.s != SGC_RECENT) |
if(y->d.s != SGC_RECENT) |
1107 |
printf("[bad %d]",y); |
printf("[bad %d]",y); |
1108 |
count++; f=y;} |
count++; f=y; |
1109 |
|
} |
1110 |
count=0; |
|
1111 |
if (f=tm->tm_alt_free) |
count=0; |
1112 |
while(y= F_LINK(f)) |
if (f=tm->tm_alt_free) |
1113 |
{ |
while(y= F_LINK(f)) { |
1114 |
if(y->d.s != SGC_NORMAL) |
if(y->d.s != SGC_NORMAL) |
1115 |
printf("[alt_bad %d]",y); |
printf("[alt_bad %d]",y); |
1116 |
count++; f=y;} |
count++; f=y; |
1117 |
|
} |
1118 |
#endif |
|
1119 |
f=tm->tm_free; |
#endif |
1120 |
while(y= (object) F_LINK(f)) |
f=tm->tm_free; |
1121 |
f=y; |
while((y= (object) F_LINK(f))) |
1122 |
F_LINK(f)= (long)(tm->tm_alt_free); |
f=y; |
1123 |
} |
F_LINK(f)= (long)(tm->tm_alt_free); |
1124 |
|
} |
1125 |
/* tm->tm_free has all of the free objects */ |
/* tm->tm_free has all of the free objects */ |
1126 |
tm->tm_nfree += tm->tm_alt_nfree; |
tm->tm_nfree += tm->tm_alt_nfree; |
1127 |
tm->tm_alt_nfree = 0; |
tm->tm_alt_nfree = 0; |
1128 |
tm->tm_alt_free = 0; |
tm->tm_alt_free = 0; |
1129 |
|
|
1130 |
/* remove the recent flag from any objects on sgc pages */ |
/* remove the recent flag from any objects on sgc pages */ |
1131 |
{int hp=page(heap_end); |
{ |
1132 |
int i,j; |
int hp=page(heap_end); |
1133 |
char t = (char) tm->tm_type; |
int i,j; |
1134 |
char *p; |
char t = (char) tm->tm_type; |
1135 |
for (i=0 ; i < hp; i++) |
char *p; |
1136 |
if (type_map[i]==t && (sgc_type_map[i] & SGC_PAGE_FLAG)) |
for (i=0 ; i < hp; i++) |
1137 |
for (p= pagetochar(i),j = tm->tm_nppage; |
if (type_map[i]==t && (sgc_type_map[i] & SGC_PAGE_FLAG)) |
1138 |
j > 0; --j, p += tm->tm_size) |
for (p= pagetochar(i),j = tm->tm_nppage; |
1139 |
{((object) p)->d.s = SGC_NORMAL;}} |
j > 0; --j, p += tm->tm_size) |
1140 |
|
((object) p)->d.s = SGC_NORMAL; |
1141 |
|
} |
1142 |
|
} |
1143 |
|
} |
1144 |
|
|
1145 |
|
return 0; |
1146 |
|
|
|
}} |
|
1147 |
} |
} |
1148 |
|
|
1149 |
void |
void |
1150 |
make_writable(beg,i) |
make_writable(int beg, int i) { |
1151 |
int beg,i; |
|
1152 |
{if (i > beg) |
if (i > beg) { |
1153 |
{beg=ROUND_DOWN_PAGE_NO(beg); |
beg=ROUND_DOWN_PAGE_NO(beg); |
1154 |
i=ROUND_UP_PAGE_NO(i); |
i=ROUND_UP_PAGE_NO(i); |
1155 |
{int k=beg; |
{ |
1156 |
while(k <i ) |
int k=beg; |
1157 |
sgc_type_map[k++] |= SGC_TEMP_WRITABLE; |
while(k <i ) |
1158 |
} |
sgc_type_map[k++] |= SGC_TEMP_WRITABLE; |
1159 |
|
} |
1160 |
sgc_mprotect(beg, i-beg, SGC_WRITABLE); |
sgc_mprotect(beg, i-beg, SGC_WRITABLE); |
1161 |
;} |
} |
1162 |
} |
} |
1163 |
|
|
1164 |
int debug_fault =0; |
int debug_fault =0; |
1165 |
int fault_count =0; |
int fault_count =0; |
1166 |
extern char etext; |
extern char etext; |
1167 |
void memprotect_handler(); |
/* void memprotect_handler(int sig, int code, struct sigcontext *scp, char *addr); */ |
1168 |
void |
void |
1169 |
memprotect_handler(sig, code, scp, addr) |
memprotect_handler(int sig, int code, struct sigcontext *scp, char *addr) { |
1170 |
int sig, code; |
|
1171 |
struct sigcontext *scp; |
int p; |
1172 |
char *addr; |
int j=page_multiple; |
1173 |
{int p; |
char *faddr; /* Needed because we must not modify signal handler |
1174 |
int j=page_multiple; |
arguments on the stack! */ |
|
char *faddr; /* Needed because we must not modify signal handler |
|
|
arguments on the stack! */ |
|
1175 |
#ifdef GET_FAULT_ADDR |
#ifdef GET_FAULT_ADDR |
1176 |
faddr=GET_FAULT_ADDR(sig,code,scp,addr); |
faddr=GET_FAULT_ADDR(sig,code,scp,addr); |
1177 |
debug_fault = (int) faddr; |
debug_fault = (int) faddr; |
1178 |
#ifdef DEBUG_MPROTECT |
#ifdef DEBUG_MPROTECT |
1179 |
printf("fault:0x%x [%d] (%d) ",faddr,page(faddr),faddr >= core_end); |
printf("fault:0x%x [%d] (%d) ",faddr,page(faddr),faddr >= core_end); |
1180 |
#endif |
#endif |
1181 |
if (faddr >= core_end || (unsigned int)faddr < DBEGIN) |
if (faddr >= core_end || (unsigned int)faddr < DBEGIN) { |
1182 |
{if (fault_count > 300) error("fault count too high"); |
if (fault_count > 300) error("fault count too high"); |
1183 |
fault_count ++; |
fault_count ++; |
1184 |
INSTALL_MPROTECT_HANDLER; |
INSTALL_MPROTECT_HANDLER; |
1185 |
return;} |
return; |
1186 |
|
} |
1187 |
#else |
#else |
1188 |
faddr = addr; |
faddr = addr; |
1189 |
#endif |
#endif |
1190 |
p = page(faddr); |
p = page(faddr); |
1191 |
p = ROUND_DOWN_PAGE_NO(p); |
p = ROUND_DOWN_PAGE_NO(p); |
1192 |
if (p >= first_protectable_page |
if (p >= first_protectable_page |
1193 |
&& faddr < core_end |
&& faddr < core_end |
1194 |
&& !(WRITABLE_PAGE_P(p))) |
&& !(WRITABLE_PAGE_P(p))) { |
1195 |
{/* CHECK_RANGE(p,1); */ |
/* CHECK_RANGE(p,1); */ |
1196 |
#ifdef DEBUG_MPROTECT |
#ifdef DEBUG_MPROTECT |
1197 |
printf("mprotect(0x%x,0x%x,0x%x)\n", |
printf("mprotect(0x%x,0x%x,0x%x)\n", |
1198 |
pagetochar(p),page_multiple * PAGESIZE, sbrk(0)); |
pagetochar(p),page_multiple * PAGESIZE, sbrk(0)); |
1199 |
fflush(stdout); |
fflush(stdout); |
1200 |
#endif |
#endif |
1201 |
mprotect(pagetochar(p),page_multiple * PAGESIZE, PROT_READ_WRITE); |
mprotect(pagetochar(p),page_multiple * PAGESIZE, PROT_READ_WRITE); |
1202 |
while (--j >= 0) |
while (--j >= 0) |
1203 |
sgc_type_map[p+j] = sgc_type_map[p+j] | SGC_TEMP_WRITABLE; |
sgc_type_map[p+j] = sgc_type_map[p+j] | SGC_TEMP_WRITABLE; |
1204 |
|
|
1205 |
#ifndef BSD |
#ifndef BSD |
1206 |
INSTALL_MPROTECT_HANDLER; |
INSTALL_MPROTECT_HANDLER; |
1207 |
#endif |
#endif |
1208 |
|
|
1209 |
return; |
return; |
1210 |
} |
} |
1211 |
|
|
1212 |
#ifndef BSD |
#ifndef BSD |
1213 |
INSTALL_MPROTECT_HANDLER; |
INSTALL_MPROTECT_HANDLER; |
1214 |
#endif |
#endif |
1215 |
/* if (SIGSEGV == SIGPROTV) */ |
/* if (SIGSEGV == SIGPROTV) */ |
1216 |
END: |
segmentation_catcher(SIGSEGV); |
1217 |
segmentation_catcher(); |
|
|
return; |
|
1218 |
} |
} |
1219 |
|
|
1220 |
sgc_mprotect(pbeg,n,writable) |
void |
1221 |
{ /* CHECK_RANGE(pbeg,n); */ |
sgc_mprotect(int pbeg, int n, int writable) { |
1222 |
|
/* CHECK_RANGE(pbeg,n); */ |
1223 |
#ifdef DEBUG_MPROTECT |
#ifdef DEBUG_MPROTECT |
1224 |
printf("prot[%d,%d,(%d),%s]\n",pbeg,pbeg+n,writable & SGC_WRITABLE, |
printf("prot[%d,%d,(%d),%s]\n",pbeg,pbeg+n,writable & SGC_WRITABLE, |
1225 |
(writable & SGC_WRITABLE ? "writable" : "not writable")); |
(writable & SGC_WRITABLE ? "writable" : "not writable")); |
1228 |
fflush(stdout); |
fflush(stdout); |
1229 |
#endif |
#endif |
1230 |
if(mprotect(pagetochar(pbeg),n*PAGESIZE, |
if(mprotect(pagetochar(pbeg),n*PAGESIZE, |
1231 |
(writable & SGC_WRITABLE ? PROT_READ_WRITE : PROT_READ))) |
(writable & SGC_WRITABLE ? PROT_READ_WRITE : PROT_READ))) |
1232 |
FEerror("Couldn't protect",0);} |
FEerror("Couldn't protect",0); |
1233 |
|
} |
1234 |
|
|
1235 |
|
|
1236 |
/* for page numbers from beg below end, |
/* for page numbers from beg below end, |
1237 |
if one page in a a page_multiple grouping is writable,the |
if one page in a a page_multiple grouping is writable,the |
1238 |
rest must be */ |
rest must be */ |
1239 |
|
|
1240 |
fix_for_page_multiple(beg,end) |
void |
1241 |
{int i,j; |
fix_for_page_multiple(int beg, int end) { |
1242 |
char *p; |
|
1243 |
int writable; |
int i,j; |
1244 |
beg = ROUND_DOWN_PAGE_NO(beg); |
char *p; |
1245 |
for (i = beg ; i < end; i = i+ page_multiple){ |
int writable; |
1246 |
p = sgc_type_map + i; |
|
1247 |
j = page_multiple; |
beg = ROUND_DOWN_PAGE_NO(beg); |
1248 |
writable = ((*p++) & SGC_WRITABLE); |
for (i = beg ; i < end; i = i+ page_multiple){ |
1249 |
if (writable) |
p = sgc_type_map + i; |
1250 |
/* all pages must be */ |
j = page_multiple; |
1251 |
{ while (--j) |
writable = ((*p++) & SGC_WRITABLE); |
1252 |
if (((*p++) & SGC_WRITABLE) == 0) |
if (writable) { |
1253 |
goto FIXIT;} |
/* all pages must be */ |
1254 |
else |
while (--j) |
1255 |
{ while (--j) |
if (((*p++) & SGC_WRITABLE) == 0) |
1256 |
if ((*p++) & SGC_WRITABLE ) |
goto FIXIT;} |
1257 |
goto FIXIT;} |
else |
1258 |
continue; |
while (--j) |
1259 |
FIXIT: |
if ((*p++) & SGC_WRITABLE ) |
1260 |
j = page_multiple; |
goto FIXIT; |
1261 |
p = sgc_type_map + i; |
continue; |
1262 |
while (--j >= 0 ) |
FIXIT: |
1263 |
{ (*p++) |= SGC_WRITABLE;}}} |
j = page_multiple; |
1264 |
|
p = sgc_type_map + i; |
1265 |
|
while (--j >= 0 ) |
1266 |
memory_protect(on) |
(*p++) |= SGC_WRITABLE; |
1267 |
int on; |
} |
1268 |
{ int i,beg,end= page(core_end); |
} |
1269 |
|
|
1270 |
|
|
1271 |
|
void |
1272 |
|
memory_protect(int on) { |
1273 |
|
|
1274 |
|
int i,beg,end= page(core_end); |
1275 |
int writable=1; |
int writable=1; |
1276 |
extern void install_segmentation_catcher(); |
extern void install_segmentation_catcher(void); |
1277 |
if (first_protectable_page==0) |
|
1278 |
{ |
if (first_protectable_page==0) { |
1279 |
for (i=page_multiple; i< maxpage ; i++) |
for (i=page_multiple; i< maxpage ; i++) |
1280 |
if (type_map[i]!=t_other) |
if (type_map[i]!=t_other) |
1281 |
break; |
break; |
1282 |
else { |
else { |
1283 |
/* We want page(0) to be non writable since that |
/* We want page(0) to be non writable since that |
1284 |
is the only check for 0 pointer in sgc */ |
is the only check for 0 pointer in sgc */ |
1285 |
sgc_type_map[i] = SGC_PERM_WRITABLE;} |
sgc_type_map[i] = SGC_PERM_WRITABLE; |
1286 |
first_protectable_page= ROUND_DOWN_PAGE_NO(i);} |
} |
1287 |
|
first_protectable_page= ROUND_DOWN_PAGE_NO(i); |
1288 |
|
} |
1289 |
if(page_multiple > 1) |
if(page_multiple > 1) |
1290 |
fix_for_page_multiple(first_protectable_page,end); |
fix_for_page_multiple(first_protectable_page,end); |
1291 |
/* turning it off */ |
/* turning it off */ |
1292 |
if (on==0) {sgc_mprotect((first_protectable_page), |
if (on==0) {sgc_mprotect((first_protectable_page), |
1293 |
(end - first_protectable_page), SGC_WRITABLE); |
(end - first_protectable_page), SGC_WRITABLE); |
1294 |
install_segmentation_catcher(); |
install_segmentation_catcher(); |
1295 |
return;} |
return; |
1296 |
|
} |
1297 |
/* write protect some pages by first write protecting them |
/* write protect some pages by first write protecting them |
1298 |
all and then selectively disabling */ |
all and then selectively disabling */ |
1299 |
/* sgc_mprotect((first_protectable_page), |
/* sgc_mprotect((first_protectable_page), |
1300 |
(end - first_protectable_page), 0); |
(end - first_protectable_page), 0); |
1301 |
*/ |
*/ |
1302 |
INSTALL_MPROTECT_HANDLER; |
INSTALL_MPROTECT_HANDLER; |
1303 |
beg=first_protectable_page; |
beg=first_protectable_page; |
1304 |
writable = WRITABLE_PAGE_P(beg); |
writable = WRITABLE_PAGE_P(beg); |
1305 |
for (i=beg ; ++i<= end; ) |
for (i=beg ; ++i<= end; ) { |
1306 |
{int wri = WRITABLE_PAGE_P(i); |
int wri = WRITABLE_PAGE_P(i); |
1307 |
if ((wri==0 && writable) |
if ((wri==0 && writable) |
1308 |
|| (writable ==0 && wri) |
|| (writable ==0 && wri) |
1309 |
|| i == end) |
|| i == end) { |
1310 |
/* it is changing */ |
/* it is changing */ |
1311 |
{if (writable) |
if (writable) |
1312 |
make_writable(beg,i); |
make_writable(beg,i); |
1313 |
else |
else |
1314 |
sgc_mprotect(beg,i-beg,writable); |
sgc_mprotect(beg,i-beg,writable); |
1315 |
writable = wri; |
writable = wri; |
1316 |
beg = i;} |
beg = i; |
1317 |
} |
} |
1318 |
|
} |
1319 |
} |
} |
1320 |
|
|
1321 |
void |
void |
1322 |
siLsgc_on() |
siLsgc_on(void) { |
|
{if (vs_base==vs_top) |
|
|
{vs_base[0]=(sgc_enabled ? Ct :Cnil); |
|
|
vs_top=vs_base+1; return;} |
|
|
check_arg(1); |
|
|
if(vs_base[0]==Cnil) |
|
|
{sgc_quit();} |
|
|
else {sgc_start();}} |
|
1323 |
|
|
1324 |
|
if (vs_base==vs_top) { |
1325 |
|
vs_base[0]=(sgc_enabled ? Ct :Cnil); |
1326 |
|
vs_top=vs_base+1; return; |
1327 |
|
} |
1328 |
|
check_arg(1); |
1329 |
|
if(vs_base[0]==Cnil) |
1330 |
|
sgc_quit(); |
1331 |
|
else sgc_start(); |
1332 |
|
} |
1333 |
|
|
1334 |
/* make permanently writable pages containing pointers p thru p+n-1 */ |
/* make permanently writable pages containing pointers p thru p+n-1 */ |
1335 |
|
|
|
|
|
1336 |
void |
void |
1337 |
perm_writable(p,n) |
perm_writable(char *p, int n) { |
1338 |
char *p; |
|
1339 |
int n; |
int beg=page(p); |
1340 |
{int beg=page(p); |
int end=page(PAGE_ROUND_UP(p+n)); |
1341 |
int end=page(PAGE_ROUND_UP(p+n)); |
int i,must_protect=0; |
1342 |
int i,must_protect=0; |
|
1343 |
beg = ROUND_DOWN_PAGE_NO(beg); |
beg = ROUND_DOWN_PAGE_NO(beg); |
1344 |
end = ROUND_UP_PAGE_NO(end); |
end = ROUND_UP_PAGE_NO(end); |
1345 |
for (i=beg ; i < end ; i++) |
for (i=beg ; i < end ; i++) { |
1346 |
{if (sgc_enabled & !(WRITABLE_PAGE_P(i))) must_protect = 1; |
if (sgc_enabled & !(WRITABLE_PAGE_P(i))) |
1347 |
sgc_type_map [i] |= SGC_PERM_WRITABLE;} |
must_protect = 1; |
1348 |
if(must_protect) make_writable(beg,end);} |
sgc_type_map [i] |= SGC_PERM_WRITABLE; |
1349 |
|
} |
1350 |
|
if(must_protect) |
1351 |
|
make_writable(beg,end); |
1352 |
|
} |
1353 |
|
|
1354 |
|
void |
1355 |
|
system_error(void) { |
1356 |
|
FEerror("System error",0); |
1357 |
|
} |
1358 |
|
|
1359 |
|
|
1360 |
|
|
1361 |
|
|
1362 |
|
|
1363 |
|
|
1364 |
|
|
1365 |
|
|
1366 |
|
|
1367 |
|
|
1368 |
|
|
1369 |
|
|
1370 |
|
|
1371 |
|
|
1372 |
|
|
1373 |
|
|
1374 |
|
|
1375 |
|
|
1376 |
|
|
1377 |
|
|
1378 |
|
|
1379 |
|
|
1380 |
|
|
1381 |
|
|
1382 |
|
|
1383 |
|
|
1384 |
|
|
1385 |
|
|
1386 |
|
|
1387 |
|
|
1388 |
|
|
1389 |
|
|
1390 |
|
|
1391 |
|
|
1392 |
|
|
1393 |
|
|
1394 |
|
|
1395 |
|
|
1396 |
|
|
1397 |
|
|
1398 |
|
|
1399 |
|
|
1400 |
|
|
1401 |
|
|
1402 |
|
|
1403 |
|
|
1404 |
|
|
1405 |
|
|
1406 |
|
|
1407 |
|
|
1408 |
|
|
1409 |
|
|
1410 |
|
|
1411 |
|
|
1412 |
|
|
1413 |
|
|
1414 |
|
|
1415 |
|
|
1416 |
|
|
1417 |
|
|
1418 |
|
|
1419 |
|
|
1420 |
|
|
1421 |
|
|
1422 |
|
|
1423 |
|
|
1424 |
|
|
1425 |
|
|
1426 |
|
|
1427 |
|
|
1428 |
|
|
1429 |
|
|
1430 |
|
|
1431 |
|
|
1432 |
|
|
1433 |
|
|
1434 |
|
|
1435 |
|
|
1436 |
|
|
1437 |
|
|
1438 |
|
|
1439 |
|
|
1440 |
|
|
1441 |
|
|
1442 |
|
|
1443 |
|
|
1444 |
|
|
|
system_error() |
|
|
{FEerror("System error",0);} |
|
1445 |
|
|
1446 |
|
|
1447 |
|
|