~ubuntu-branches/ubuntu/utopic/gcl/utopic
» Revision
59
: .pc/define-SPECIAL_RSYM-in-mingw.h-for-now/o/sgbc.c
« back to all changes in this revision
Viewing changes to .pc/define-SPECIAL_RSYM-in-mingw.h-for-now/o/sgbc.c
- browse files at revision 59
- compare with another revision
- download diff
- download tarball
- view history from revision 59
- Committer: Package Import Robot
- Author(s): Camm Maguire
- Date: 2014-04-21 14:09:37 UTC
- mfrom: (13.1.109 sid)
- Revision ID: package-import@ubuntu.com-20140421140937-dlz68m10fzssuhbv
Tags: 2.6.10-8
2.6.11pre test 7
- files added:
- .pc/-use-writable_malloc-to-protect-gprof
- .pc/-use-writable_malloc-to-protect-gprof/o
- .pc/NO_SETBUF;hppa;normalized-float-scale;mpz_set_str;parse_number;read-base;parse-float-fix
- .pc/NO_SETBUF;hppa;normalized-float-scale;mpz_set_str;parse_number;read-base;parse-float-fix/cmpnew
- .pc/NO_SETBUF;hppa;normalized-float-scale;mpz_set_str;parse_number;read-base;parse-float-fix/h
- .pc/NO_SETBUF;hppa;normalized-float-scale;mpz_set_str;parse_number;read-base;parse-float-fix/o
- .pc/cleanup-dlopen-linker-option
- .pc/cleanup-dlopen-linker-option/h
- .pc/cleanup-dlopen-linker-option/o
- .pc/cygwin;emacsen-compat
- .pc/cygwin;emacsen-compat/h
- .pc/cygwin;emacsen-compat/o
- .pc/define-SPECIAL_RSYM-in-mingw.h-for-now
- .pc/define-SPECIAL_RSYM-in-mingw.h-for-now/gcl-tk
- .pc/define-SPECIAL_RSYM-in-mingw.h-for-now/h
- .pc/define-SPECIAL_RSYM-in-mingw.h-for-now/o
- .pc/dummy-writable_malloc-in-tkMain.c
- .pc/dummy-writable_malloc-in-tkMain.c/gcl-tk
- .pc/dummy-writable_malloc-in-tkMain.c/h
- .pc/dummy-writable_malloc-in-tkMain.c/o
- .pc/gprof-raw_image-saving_system-fix
- .pc/gprof-raw_image-saving_system-fix/o
- .pc/remove-Scdr-in-free
- .pc/remove-Scdr-in-free/o
- .pc/signal.h-move-in-alloc.c
- .pc/signal.h-move-in-alloc.c/o
- files modified:
- .pc/applied-patches
added
removed
.pc/define-SPECIAL_RSYM-in-mingw.h-for-now/o/sgbc.c
1
/* Copyright William Schelter. All rights reserved.
2
3
Stratified Garbage Collection (SGC)
4
5
Write protects pages to tell which ones have been written
6
to recently, for more efficient garbage collection.
7
8
*/
9
10
static void
11
sgc_mark_object1(object);
12
13
static void
14
sgc_mprotect(long, long, int);
15
16
17
#ifdef BSD
18
/* ulong may have been defined in mp.h but the define is no longer needed */
19
#undef ulong
20
#include <sys/mman.h>
21
#define PROT_READ_WRITE_EXEC (PROT_READ | PROT_WRITE |PROT_EXEC)
22
#define PROT_READ_EXEC (PROT_READ|PROT_EXEC)
23
#endif
24
#ifdef AIX3
25
#include <sys/vmuser.h>
26
#define PROT_READ_EXEC RDONLY /*FIXME*/
27
#define PROT_READ_WRITE_EXEC UDATAKEY
28
int mprotect();
29
#endif
30
31
#ifdef __MINGW32__
32
#include <windows.h>
33
#define PROT_READ_WRITE_EXEC PAGE_EXECUTE_READWRITE
34
#define PROT_READ_EXEC PAGE_READONLY /*FIXME*/
35
36
int gclmprotect ( void *addr, size_t len, int prot ) {
37
int old, rv;
38
rv = VirtualProtect ( (LPVOID) addr, len, prot, &old );
39
if ( 0 == rv ) {
40
fprintf ( stderr, "mprotect: VirtualProtect %x %d %d failed\n", addr, len, prot );
41
rv = -1;
42
} else {
43
rv =0;
44
}
45
return (rv);
46
}
47
/* Avoid clash with libgcc's mprotect */
48
#define mprotect gclmprotect
49
50
#endif
51
52
#if defined(DARWIN)
53
#include <sys/ucontext.h>
54
#endif
55
56
#include <signal.h>
57
58
/* void segmentation_catcher(void); */
59
60
61
#define sgc_mark_pack_list(u) \
62
do {register object xtmp = u; \
63
while (xtmp != Cnil) \
64
{if (ON_WRITABLE_PAGE(xtmp)) {mark(xtmp);} \
65
sgc_mark_object(xtmp->c.c_car); \
66
xtmp=Scdr(xtmp);}}while(0)
67
68
69
#ifdef SDEBUG
70
object sdebug;
71
joe1(){;}
72
joe() {;}
73
#endif
74
75
/* static void */
76
/* sgc_mark_cons(object x) { */
77
78
/* cs_check(x); */
79
80
/* /\* x is already marked. *\/ */
81
82
/* BEGIN: */
83
/* #ifdef SDEBUG */
84
/* if(x==sdebug) joe1(); */
85
/* #endif */
86
/* sgc_mark_object(x->c.c_car); */
87
/* #ifdef OLD */
88
/* IF_WRITABLE(x->c.c_car, goto MARK_CAR;); */
89
/* goto MARK_CDR; */
90
91
/* MARK_CAR: */
92
/* if (!is_marked_or_free(x->c.c_car)) { */
93
/* if (consp(x->c.c_car)) { */
94
/* mark(x->c.c_car); */
95
/* sgc_mark_cons(x->c.c_car); */
96
/* } else */
97
/* sgc_mark_object1(x->c.c_car);} */
98
/* MARK_CDR: */
99
/* #endif */
100
/* /\* if (is_imm_fixnum(x->c.c_cdr)) return; *\/ */
101
/* x = Scdr(x); */
102
/* IF_WRITABLE(x, goto WRITABLE_CDR;); */
103
/* return; */
104
/* WRITABLE_CDR: */
105
/* if (is_marked_or_free(x)) return; */
106
/* if (consp(x)) { */
107
/* mark(x); */
108
/* goto BEGIN; */
109
/* } */
110
/* sgc_mark_object1(x); */
111
/* } */
112
113
inline void
114
sgc_mark_cons(object x) {
115
116
do {
117
object d=x->c.c_cdr;
118
mark(x);
119
sgc_mark_object(x->c.c_car);
120
x=d;
121
if (!IS_WRITABLE(page(x)) || is_marked_or_free(x))/*catches Cnil*/
122
return;
123
} while (cdr_listp(x));
124
sgc_mark_object(x);
125
126
}
127
128
/* Whenever two arrays are linked together by displacement,
129
if one is live, the other will be made live */
130
#define sgc_mark_displaced_field(ar) sgc_mark_object(ar->a.a_displaced)
131
132
133
/* structures and arrays of type t, need to be marked if their
134
bodies are not write protected even if the headers are.
135
So we should keep these on pages particular to them.
136
Actually we will change structure sets to touch the structure
137
header, that way we won't have to keep the headers in memory.
138
This takes only 1.47 as opposed to 1.33 microseconds per set.
139
*/
140
static void
141
sgc_mark_object1(object x) {
142
143
fixnum i,j;
144
object *p;
145
char *cp;
146
enum type tp;
147
148
cs_check(x);
149
BEGIN:
150
#ifdef SDEBUG
151
if (x == OBJNULL || !ON_WRITABLE_PAGE(x))
152
return;
153
IF_WRITABLE(x,goto OK);
154
joe();
155
OK:
156
#endif
157
if (is_marked_or_free(x))
158
return;
159
#ifdef SDEBUG
160
if(x==sdebug) joe1();
161
#endif
162
163
tp=type_of(x);
164
165
if (tp==t_cons) {
166
sgc_mark_cons(x);
167
return;
168
}
169
170
mark(x);
171
172
switch (tp) {
173
174
case t_fixnum:
175
break;
176
177
case t_ratio:
178
sgc_mark_object(x->rat.rat_num);
179
x = x->rat.rat_den;
180
IF_WRITABLE(x,if(!is_marked_or_free(x)) goto BEGIN);
181
182
case t_shortfloat:
183
break;
184
185
case t_longfloat:
186
break;
187
188
case t_complex:
189
sgc_mark_object(x->cmp.cmp_imag);
190
x = x->cmp.cmp_real;
191
IF_WRITABLE(x,if(!is_marked_or_free(x)) goto BEGIN);
192
193
case t_character:
194
break;
195
196
case t_symbol:
197
IF_WRITABLE(x->s.s_plist,if(!is_marked_or_free(x->s.s_plist))
198
{/* mark(x->s.s_plist); */
199
sgc_mark_cons(x->s.s_plist);});
200
sgc_mark_object(x->s.s_gfdef);
201
sgc_mark_object(x->s.s_dbind);
202
if (x->s.s_self == NULL)
203
break;
204
/* to do */
205
if (inheap(x->s.s_self)) {
206
if (what_to_collect == t_contiguous)
207
mark_contblock(x->s.s_self,x->s.s_fillp);
208
} else if (SGC_RELBLOCK_P(x->s.s_self) && COLLECT_RELBLOCK_P)
209
x->s.s_self = copy_relblock(x->s.s_self, x->s.s_fillp);
210
break;
211
212
case t_package:
213
sgc_mark_object(x->p.p_name);
214
sgc_mark_object(x->p.p_nicknames);
215
sgc_mark_object(x->p.p_shadowings);
216
sgc_mark_object(x->p.p_uselist);
217
sgc_mark_object(x->p.p_usedbylist);
218
if (what_to_collect == t_contiguous) {
219
if (x->p.p_internal != NULL)
220
mark_contblock((char *)(x->p.p_internal),
221
x->p.p_internal_size*sizeof(object));
222
if (x->p.p_external != NULL)
223
mark_contblock((char *)(x->p.p_external),
224
x->p.p_external_size*sizeof(object));
225
}
226
break;
227
228
case t_hashtable:
229
sgc_mark_object(x->ht.ht_rhsize);
230
sgc_mark_object(x->ht.ht_rhthresh);
231
if (x->ht.ht_self == NULL)
232
break;
233
for (i = 0, j = x->ht.ht_size; i < j; i++) {
234
if (ON_WRITABLE_PAGE(&x->ht.ht_self[i])) {
235
sgc_mark_object(x->ht.ht_self[i].hte_key);
236
sgc_mark_object(x->ht.ht_self[i].hte_value);
237
}
238
}
239
if (inheap(x->ht.ht_self)) {
240
if (what_to_collect == t_contiguous)
241
mark_contblock((char *)(x->ht.ht_self),j * sizeof(struct htent));
242
} else if (SGC_RELBLOCK_P(x->ht.ht_self) && COLLECT_RELBLOCK_P)
243
x->ht.ht_self=(void *)copy_relblock((char *)x->ht.ht_self,j*sizeof(struct htent));;
244
break;
245
246
case t_array:
247
if ((x->a.a_displaced) != Cnil)
248
sgc_mark_displaced_field(x);
249
if (x->a.a_dims != NULL) {
250
if (inheap(x->a.a_dims)) {
251
if (what_to_collect == t_contiguous)
252
mark_contblock((char *)(x->a.a_dims),sizeof(int)*x->a.a_rank);
253
} else if (SGC_RELBLOCK_P(x->a.a_dims) && COLLECT_RELBLOCK_P)
254
x->a.a_dims = (int *) copy_relblock((char *)(x->a.a_dims),sizeof(int)*x->a.a_rank);
255
}
256
if ((enum aelttype)x->a.a_elttype == aet_ch)
257
goto CASE_STRING;
258
if ((enum aelttype)x->a.a_elttype == aet_bit)
259
goto CASE_BITVECTOR;
260
if ((enum aelttype)x->a.a_elttype == aet_object)
261
goto CASE_GENERAL;
262
263
CASE_SPECIAL:
264
cp = (char *)(x->fixa.fixa_self);
265
if (cp == NULL)
266
break;
267
/* set j to the size in char of the body of the array */
268
269
switch((enum aelttype)x->a.a_elttype){
270
case aet_lf:
271
j= sizeof(longfloat)*x->lfa.lfa_dim;
272
if ((COLLECT_RELBLOCK_P) && !(inheap(cp)) && SGC_RELBLOCK_P(x->a.a_self))
273
ROUND_RB_POINTERS_DOUBLE;/*FIXME gc space violation*/
274
break;
275
case aet_char:
276
case aet_uchar:
277
j=sizeof(char)*x->a.a_dim;
278
break;
279
case aet_short:
280
case aet_ushort:
281
j=sizeof(short)*x->a.a_dim;
282
break;
283
default:
284
j=sizeof(fixnum)*x->fixa.fixa_dim;}
285
286
goto COPY;
287
288
CASE_GENERAL:
289
p = x->a.a_self;
290
if (p == NULL
291
#ifdef HAVE_ALLOCA
292
|| (char *)p >= core_end
293
#endif
294
295
)
296
break;
297
j=0;
298
if (x->a.a_displaced->c.c_car == Cnil)
299
for (i = 0, j = x->a.a_dim; i < j; i++)
300
if (ON_WRITABLE_PAGE(&p[i]))
301
sgc_mark_object(p[i]);
302
cp = (char *)p;
303
j *= sizeof(object);
304
COPY:
305
if (inheap(cp)) {
306
if (what_to_collect == t_contiguous)
307
mark_contblock(cp, j);
308
} else if (SGC_RELBLOCK_P(cp) && COLLECT_RELBLOCK_P) {
309
if (x->a.a_displaced == Cnil) {
310
#ifdef HAVE_ALLOCA
311
if (!NULL_OR_ON_C_STACK(cp)) /* only if body of array not on C stack */
312
#endif
313
x->a.a_self = (object *)copy_relblock(cp, j);
314
} else if (x->a.a_displaced->c.c_car == Cnil) {
315
i = (long)(object *)copy_relblock(cp, j) - (long)(x->a.a_self);
316
adjust_displaced(x, i);
317
}
318
}
319
break;
320
321
case t_vector:
322
if ((x->v.v_displaced) != Cnil)
323
sgc_mark_displaced_field(x);
324
if ((enum aelttype)x->v.v_elttype == aet_object)
325
goto CASE_GENERAL;
326
else
327
goto CASE_SPECIAL;
328
329
case t_bignum:
330
#ifdef SDEBUG
331
if (TYPE_MAP(page(x->big.big_self)) < t_contiguous)
332
printf("bad body for %x (%x)\n",x,cp);
333
#endif
334
#ifndef GMP_USE_MALLOC
335
j = MP_ALLOCATED(x);
336
cp = (char *)MP_SELF(x);
337
if (cp == 0)
338
break;
339
j = j * MP_LIMB_SIZE;
340
if (inheap(cp)) {
341
if (what_to_collect == t_contiguous)
342
mark_contblock(cp, j);
343
} else if (SGC_RELBLOCK_P(cp) && COLLECT_RELBLOCK_P)
344
MP_SELF(x) = (void *) copy_relblock(cp, j);
345
#endif /* not GMP_USE_MALLOC */
346
break;
347
348
349
CASE_STRING:
350
case t_string:
351
if ((x->st.st_displaced) != Cnil)
352
sgc_mark_displaced_field(x);
353
j = x->st.st_dim;
354
cp = x->st.st_self;
355
if (cp == NULL)
356
break;
357
358
COPY_STRING:
359
if (inheap(cp)) {
360
if (what_to_collect == t_contiguous)
361
mark_contblock(cp, j);
362
} else if (SGC_RELBLOCK_P(cp) && COLLECT_RELBLOCK_P) {
363
if (x->st.st_displaced == Cnil)
364
x->st.st_self = copy_relblock(cp, j);
365
else if (x->st.st_displaced->c.c_car == Cnil) {
366
i = copy_relblock(cp, j) - cp;
367
adjust_displaced(x, i);
368
}
369
}
370
break;
371
372
CASE_BITVECTOR:
373
case t_bitvector:
374
if ((x->bv.bv_displaced) != Cnil)
375
sgc_mark_displaced_field(x);
376
/* We make bitvectors multiple of sizeof(int) in size allocated
377
Assume 8 = number of bits in char */
378
379
#define W_SIZE (8*sizeof(fixnum))
380
j= sizeof(fixnum) *
381
((BV_OFFSET(x) + x->bv.bv_dim + W_SIZE -1)/W_SIZE);
382
cp = x->bv.bv_self;
383
if (cp == NULL)
384
break;
385
goto COPY_STRING;
386
387
case t_structure:
388
sgc_mark_object(x->str.str_def);
389
p = x->str.str_self;
390
if (p == NULL)
391
break;
392
{
393
object def=x->str.str_def;
394
unsigned char *s_type = &SLOT_TYPE(def,0);
395
unsigned short *s_pos = &SLOT_POS (def,0);
396
for (i = 0, j = S_DATA(def)->length; i < j; i++)
397
if (s_type[i]==0 && ON_WRITABLE_PAGE(&STREF(object,x,s_pos[i])))
398
sgc_mark_object(STREF(object,x,s_pos[i]));
399
if (inheap(x->str.str_self)) {
400
if (what_to_collect == t_contiguous)
401
mark_contblock((char *)p,S_DATA(def)->size);
402
} else if (SGC_RELBLOCK_P(p) && (COLLECT_RELBLOCK_P))
403
x->str.str_self = (object *) copy_relblock((char *)p, S_DATA(def)->size);
404
}
405
break;
406
407
case t_stream:
408
switch (x->sm.sm_mode) {
409
case smm_input:
410
case smm_output:
411
case smm_io:
412
case smm_socket:
413
case smm_probe:
414
sgc_mark_object(x->sm.sm_object0);
415
sgc_mark_object(x->sm.sm_object1);
416
if (saving_system) {
417
FILE *fp = x->sm.sm_fp;
418
if (fp != 0 && fp != stdin && fp !=stdout) {
419
fclose(fp);
420
x->sm.sm_fp=0;
421
}
422
}
423
else
424
if (what_to_collect == t_contiguous &&
425
x->sm.sm_fp &&
426
x->sm.sm_buffer)
427
mark_contblock(x->sm.sm_buffer, BUFSIZ);
428
break;
429
430
case smm_synonym:
431
sgc_mark_object(x->sm.sm_object0);
432
break;
433
434
case smm_broadcast:
435
case smm_concatenated:
436
sgc_mark_object(x->sm.sm_object0);
437
break;
438
439
case smm_two_way:
440
case smm_echo:
441
sgc_mark_object(x->sm.sm_object0);
442
sgc_mark_object(x->sm.sm_object1);
443
break;
444
445
case smm_string_input:
446
case smm_string_output:
447
sgc_mark_object(x->sm.sm_object0);
448
break;
449
#ifdef USER_DEFINED_STREAMS
450
case smm_user_defined:
451
sgc_mark_object(x->sm.sm_object0);
452
sgc_mark_object(x->sm.sm_object1);
453
break;
454
#endif
455
default:
456
error("mark stream botch");
457
}
458
break;
459
460
#define SGC_MARK_CP(a_,b_) {fixnum _t=(b_);if (inheap((a_))) {\
461
if (what_to_collect == t_contiguous) mark_contblock((void *)(a_),_t); \
462
} else if (SGC_RELBLOCK_P((a_)) && COLLECT_RELBLOCK_P) (a_)=(void *)copy_relblock((void *)(a_),_t);}
463
464
#define SGC_MARK_MP(a_) {if ((a_)->_mp_d) SGC_MARK_CP((a_)->_mp_d,(a_)->_mp_alloc*MP_LIMB_SIZE);}
465
466
case t_random:
467
SGC_MARK_MP(x->rnd.rnd_state._mp_seed);
468
#if __GNU_MP_VERSION < 4 || (__GNU_MP_VERSION == 4 && __GNU_MP_VERSION_MINOR < 2)
469
if (x->rnd.rnd_state._mp_algdata._mp_lc) {
470
SGC_MARK_MP(x->rnd.rnd_state._mp_algdata._mp_lc->_mp_a);
471
if (!x->rnd.rnd_state._mp_algdata._mp_lc->_mp_m2exp) SGC_MARK_MP(x->rnd.rnd_state._mp_algdata._mp_lc->_mp_m);
472
SGC_MARK_CP(x->rnd.rnd_state._mp_algdata._mp_lc,sizeof(*x->rnd.rnd_state._mp_algdata._mp_lc));
473
}
474
#endif
475
break;
476
477
case t_readtable:
478
if (x->rt.rt_self == NULL)
479
break;
480
if (what_to_collect == t_contiguous)
481
mark_contblock((char *)(x->rt.rt_self),RTABSIZE*sizeof(struct rtent));
482
for (i = 0; i < RTABSIZE; i++) {
483
sgc_mark_object(x->rt.rt_self[i].rte_macro);
484
if (x->rt.rt_self[i].rte_dtab != NULL) {
485
if (what_to_collect == t_contiguous)
486
mark_contblock((char *)(x->rt.rt_self[i].rte_dtab),RTABSIZE*sizeof(object));
487
for (j = 0; j < RTABSIZE; j++)
488
sgc_mark_object(x->rt.rt_self[i].rte_dtab[j]);
489
}
490
}
491
break;
492
493
case t_pathname:
494
sgc_mark_object(x->pn.pn_host);
495
sgc_mark_object(x->pn.pn_device);
496
sgc_mark_object(x->pn.pn_directory);
497
sgc_mark_object(x->pn.pn_name);
498
sgc_mark_object(x->pn.pn_type);
499
sgc_mark_object(x->pn.pn_version);
500
break;
501
502
case t_closure:
503
{
504
int i ;
505
if (what_to_collect == t_contiguous)
506
mark_contblock(x->cc.cc_turbo,x->cc.cc_envdim);
507
for (i= 0 ; i < x->cc.cc_envdim ; i++)
508
sgc_mark_object(x->cc.cc_turbo[i]);
509
}
510
511
case t_cfun:
512
case t_sfun:
513
case t_vfun:
514
case t_afun:
515
case t_gfun:
516
sgc_mark_object(x->cf.cf_name);
517
sgc_mark_object(x->cf.cf_data);
518
break;
519
520
case t_cfdata:
521
522
if (x->cfd.cfd_self != NULL) {
523
int i=x->cfd.cfd_fillp;
524
while(i-- > 0)
525
sgc_mark_object(x->cfd.cfd_self[i]);
526
}
527
if (what_to_collect == t_contiguous) {
528
mark_contblock(x->cfd.cfd_start, x->cfd.cfd_size);
529
mark_link_array(x->cfd.cfd_start,x->cfd.cfd_start+x->cfd.cfd_size);
530
}
531
break;
532
case t_cclosure:
533
sgc_mark_object(x->cc.cc_name);
534
sgc_mark_object(x->cc.cc_env);
535
sgc_mark_object(x->cc.cc_data);
536
if (x->cc.cc_turbo!=NULL) sgc_mark_object(*(x->cc.cc_turbo-1));
537
if (what_to_collect == t_contiguous) {
538
if (x->cc.cc_turbo != NULL)
539
mark_contblock((char *)(x->cc.cc_turbo-1),(1+fix(*(x->cc.cc_turbo-1)))*sizeof(object));
540
}
541
break;
542
543
case t_spice:
544
break;
545
546
default:
547
#ifdef DEBUG
548
if (debug)
549
printf("\ttype = %d\n", type_of(x));
550
#endif
551
error("mark botch");
552
}
553
554
}
555
556
static void
557
sgc_mark_phase(void) {
558
559
STATIC fixnum i, j;
560
STATIC struct package *pp;
561
STATIC bds_ptr bdp;
562
STATIC frame_ptr frp;
563
STATIC ihs_ptr ihsp;
564
STATIC struct pageinfo *v;
565
566
sgc_mark_object(Cnil->s.s_plist);
567
sgc_mark_object(Ct->s.s_plist);
568
569
/* mark all non recent data on writable pages */
570
{
571
long t,i=page(heap_end);
572
struct typemanager *tm;
573
char *p;
574
575
for (v=cell_list_head;v;v=v->next) {
576
i=page(v);
577
if (!WRITABLE_PAGE_P(i)) continue;
578
579
t=v->type;
580
tm=tm_of(t);
581
p=pagetochar(i);
582
for (j = tm->tm_nppage; --j >= 0; p += tm->tm_size) {
583
object x = (object) p;
584
if (SGC_OR_M(x)) continue;
585
sgc_mark_object1(x);
586
}
587
}
588
}
589
590
/* mark all non recent data on writable contiguous pages */
591
if (what_to_collect == t_contiguous)
592
for (v=contblock_list_head;v;v=v->next)
593
if (v->sgc_flags&SGC_PAGE_FLAG) {
594
void *s=CB_DATA_START(v),*e=CB_DATA_END(v),*p,*q;
595
bool z=get_sgc_bit(v,s);
596
for (p=s;p<e;) {
597
q=get_sgc_bits(v,p);
598
if (!z)
599
set_mark_bits(v,p,q);
600
z=1-z;
601
p=q;
602
}
603
}
604
605
mark_stack_carefully(vs_top-1,vs_org,0);
606
mark_stack_carefully(MVloc+(sizeof(MVloc)/sizeof(object)),MVloc,0);
607
608
for (bdp = bds_org; bdp<=bds_top; bdp++) {
609
sgc_mark_object(bdp->bds_sym);
610
sgc_mark_object(bdp->bds_val);
611
}
612
613
for (frp = frs_org; frp <= frs_top; frp++)
614
sgc_mark_object(frp->frs_val);
615
616
for (ihsp = ihs_org; ihsp <= ihs_top; ihsp++)
617
sgc_mark_object(ihsp->ihs_function);
618
619
for (i = 0; i < mark_origin_max; i++)
620
sgc_mark_object(*mark_origin[i]);
621
for (i = 0; i < mark_origin_block_max; i++)
622
for (j = 0; j < mark_origin_block[i].mob_size; j++)
623
sgc_mark_object(mark_origin_block[i].mob_addr[j]);
624
625
for (pp = pack_pointer; pp != NULL; pp = pp->p_link)
626
sgc_mark_object((object)pp);
627
#ifdef KCLOVM
628
if (ovm_process_created)
629
sgc_mark_all_stacks();
630
#endif
631
632
#ifdef DEBUG
633
if (debug) {
634
printf("symbol navigation\n");
635
fflush(stdout);
636
}
637
#endif
638
{
639
int size;
640
641
for (pp = pack_pointer; pp != NULL; pp = pp->p_link) {
642
size = pp->p_internal_size;
643
if (pp->p_internal != NULL)
644
for (i = 0; i < size; i++)
645
sgc_mark_pack_list(pp->p_internal[i]);
646
size = pp->p_external_size;
647
if (pp->p_external != NULL)
648
for (i = 0; i < size; i++)
649
sgc_mark_pack_list(pp->p_external[i]);
650
}
651
}
652
653
mark_c_stack(0,N_RECURSION_REQD,mark_stack_carefully);
654
655
}
656
657
static void
658
sgc_sweep_phase(void) {
659
STATIC long j, k;
660
STATIC object x;
661
STATIC char *p;
662
STATIC struct typemanager *tm;
663
STATIC object f;
664
int size;
665
STATIC struct pageinfo *v;
666
667
for (v=cell_list_head;v;v=v->next) {
668
669
tm = tm_of((enum type)v->type);
670
671
if (!WRITABLE_PAGE_P(page(v)))
672
continue;
673
674
p = pagetochar(page(v));
675
f = tm->tm_free;
676
k = 0;
677
size=tm->tm_size;
678
679
if (v->sgc_flags&SGC_PAGE_FLAG) {
680
681
for (j = tm->tm_nppage; --j >= 0; p += size) {
682
683
x = (object)p;
684
685
if (is_free(x))
686
continue;
687
else if (is_marked(x)) {
688
unmark(x);
689
continue;
690
}
691
692
if (TYPEWORD_TYPE_P(pageinfo(x)->type) && x->d.s == SGC_NORMAL)
693
continue;
694
695
/* it is ok to free x */
696
697
SET_LINK(x,f);
698
make_free(x);
699
if (TYPEWORD_TYPE_P(v->type)) x->d.s = SGC_RECENT;
700
f = x;
701
k++;
702
703
}
704
tm->tm_free = f;
705
tm->tm_nfree += k;
706
v->in_use-=k;
707
708
} else /*non sgc_page */
709
for (j = tm->tm_nppage; --j >= 0; p += size) {
710
x = (object)p;
711
if (is_marked(x) && !is_free(x)) {
712
unmark(x);
713
}
714
}
715
716
}
717
}
718
719
720
static void
721
sgc_contblock_sweep_phase(void) {
722
723
STATIC char *s, *e, *p, *q;
724
STATIC struct pageinfo *v;
725
726
cb_pointer = NULL;
727
ncb = 0;
728
for (v=contblock_list_head;v;v=v->next) {
729
bool z;
730
731
if (!(v->sgc_flags&SGC_PAGE_FLAG)) continue;
732
733
s=CB_DATA_START(v);
734
e=CB_DATA_END(v);
735
736
z=get_mark_bit(v,s);
737
for (p=s;p<e;) {
738
q=get_mark_bits(v,p);
739
if (!z)
740
insert_contblock(p,q-p);
741
z=1-z;
742
p=q;
743
}
744
745
bzero(CB_MARK_START(v),CB_SGCF_START(v)-CB_MARK_START(v));
746
747
}
748
749
sweep_link_array();
750
751
}
752
753
754
755
#define PAGE_ROUND_UP(adr) \
756
((char *)(PAGESIZE*(((long)(adr)+PAGESIZE -1) >> PAGEWIDTH)))
757
758
/* char *old_rb_start; */
759
760
#undef tm
761
762
#ifdef SDEBUG
763
sgc_count(object yy) {
764
fixnum count=0;
765
object y=yy;
766
while(y)
767
{count++;
768
y=OBJ_LINK(y);}
769
printf("[length %x = %d]",yy,count);
770
fflush(stdout);
771
}
772
773
#endif
774
775
fixnum writable_pages=0;
776
777
/* count writable pages excluding the hole */
778
static fixnum
779
sgc_count_writable(void) {
780
781
return page(core_end)-page(rb_start)+writable_pages-(page(old_rb_start)-page(heap_end));
782
783
}
784
785
786
fixnum
787
sgc_count_type(int t) {
788
789
if (t==t_relocatable)
790
return page(rb_limit)-page(rb_start);
791
else
792
return tm_of(t)->tm_npage-tm_of(t)->tm_alt_npage;
793
794
}
795
796
#ifdef SGC_CONT_DEBUG
797
798
void
799
pcb(struct contblock *p) {
800
for (;p;p=p->cb_link)
801
printf("%p %d\n",p,p->cb_size);
802
}
803
804
void
805
overlap_check(struct contblock *t1,struct contblock *t2) {
806
807
struct contblock *p;
808
809
for (;t1;t1=t1->cb_link) {
810
811
if (!inheap(t1)) {
812
fprintf(stderr,"%p not in heap\n",t1);
813
exit(1);
814
}
815
816
for (p=t2;p;p=p->cb_link) {
817
818
if (!inheap(p)) {
819
fprintf(stderr,"%p not in heap\n",t1);
820
exit(1);
821
}
822
823
if ((p<=t1 && (void *)p+p->cb_size>(void *)t1) ||
824
(t1<=p && (void *)t1+t1->cb_size>(void *)p)) {
825
fprintf(stderr,"Overlap %u %p %u %p\n",t1->cb_size,t1,p->cb_size,p);
826
exit(1);
827
}
828
829
if (p==p->cb_link) {
830
fprintf(stderr,"circle detected at %p\n",p);
831
exit(1);
832
}
833
834
}
835
836
if (t1==t1->cb_link) {
837
fprintf(stderr,"circle detected at %p\n",t1);
838
exit(1);
839
}
840
841
}
842
843
}
844
845
void
846
tcc(struct contblock *t) {
847
848
for (;t;t=t->cb_link) {
849
850
if (!inheap(t)) {
851
fprintf(stderr,"%p not in heap\n",t);
852
break;
853
}
854
855
fprintf(stderr,"%u at %p\n",t->cb_size,t);
856
857
if (t==t->cb_link) {
858
fprintf(stderr,"circle detected at %p\n",t);
859
break;
860
}
861
862
}
863
864
}
865
866
#endif
867
868
typedef enum {memprotect_none,memprotect_cannot_protect,memprotect_sigaction,
869
memprotect_bad_return,memprotect_no_signal,
870
memprotect_multiple_invocations,memprotect_no_restart,
871
memprotect_bad_fault_address,memprotect_success} memprotect_enum;
872
static volatile memprotect_enum memprotect_result;
873
static int memprotect_handler_invocations,memprotect_print_enable;
874
static void *memprotect_test_address;
875
876
#define MEM_ERR_CASE(a_) \
877
case a_: \
878
fprintf(stderr,"The SGC segfault recovery test failed with %s, SGC disabled\n",#a_); \
879
break
880
881
static void
882
memprotect_print(void) {
883
884
if (!memprotect_print_enable)
885
return;
886
887
switch(memprotect_result) {
888
case memprotect_none: case memprotect_success:
889
break;
890
891
MEM_ERR_CASE(memprotect_cannot_protect);
892
MEM_ERR_CASE(memprotect_sigaction);
893
MEM_ERR_CASE(memprotect_bad_return);
894
MEM_ERR_CASE(memprotect_no_signal);
895
MEM_ERR_CASE(memprotect_no_restart);
896
MEM_ERR_CASE(memprotect_bad_fault_address);
897
MEM_ERR_CASE(memprotect_multiple_invocations);
898
899
}
900
901
}
902
903
904
static void
905
memprotect_handler_test(int sig, long code, void *scp, char *addr) {
906
907
char *faddr;
908
faddr=GET_FAULT_ADDR(sig,code,scp,addr);
909
910
if (memprotect_handler_invocations) {
911
memprotect_result=memprotect_multiple_invocations;
912
exit(-1);
913
}
914
memprotect_handler_invocations=1;
915
if (faddr!=memprotect_test_address)
916
memprotect_result=memprotect_bad_fault_address;
917
else
918
memprotect_result=memprotect_none;
919
mprotect(memprotect_test_address,PAGESIZE,PROT_READ_WRITE_EXEC);
920
921
}
922
923
static int
924
memprotect_test(void) {
925
926
char *b1,*b2;
927
unsigned long p=PAGESIZE;
928
struct sigaction sa,sao,saob;
929
930
if (memprotect_result!=memprotect_none)
931
return memprotect_result!=memprotect_success;
932
if (atexit(memprotect_print)) {
933
fprintf(stderr,"Cannot setup memprotect_print on exit\n");
934
exit(-1);
935
}
936
937
if (!(b1=alloca(2*p))) {
938
memprotect_result=memprotect_cannot_protect;
939
return -1;
940
}
941
942
if (!(b2=alloca(p))) {
943
memprotect_result=memprotect_cannot_protect;
944
return -1;
945
}
946
947
memset(b1,32,2*p);
948
memset(b2,0,p);
949
memprotect_test_address=(void *)(((unsigned long)b1+p-1) & ~(p-1));
950
sa.sa_sigaction=(void *)memprotect_handler_test;
951
sa.sa_flags=MPROTECT_ACTION_FLAGS;
952
if (sigaction(SIGSEGV,&sa,&sao)) {
953
memprotect_result=memprotect_sigaction;
954
return -1;
955
}
956
if (sigaction(SIGBUS,&sa,&saob)) {
957
sigaction(SIGSEGV,&sao,NULL);
958
memprotect_result=memprotect_sigaction;
959
return -1;
960
}
961
{ /* mips kernel bug test -- SIGBUS with no faddr when floating point is emulated. */
962
float *f1=(void *)memprotect_test_address,*f2=(void *)b2,*f1e=f1+p/sizeof(*f1);
963
964
if (mprotect(memprotect_test_address,p,PROT_READ_EXEC)) {
965
memprotect_result=memprotect_cannot_protect;
966
return -1;
967
}
968
memprotect_result=memprotect_bad_return;
969
for (;f1<f1e;) *f1++=*f2;
970
if (memprotect_result==memprotect_bad_return)
971
memprotect_result=memprotect_no_signal;
972
if (memprotect_result!=memprotect_none) {
973
sigaction(SIGSEGV,&sao,NULL);
974
sigaction(SIGBUS,&saob,NULL);
975
return -1;
976
}
977
memprotect_handler_invocations=0;
978
979
}
980
if (mprotect(memprotect_test_address,p,PROT_READ_EXEC)) {
981
memprotect_result=memprotect_cannot_protect;
982
return -1;
983
}
984
memprotect_result=memprotect_bad_return;
985
memset(memprotect_test_address,0,p);
986
if (memprotect_result==memprotect_bad_return)
987
memprotect_result=memprotect_no_signal;
988
if (memprotect_result!=memprotect_none) {
989
sigaction(SIGSEGV,&sao,NULL);
990
sigaction(SIGBUS,&saob,NULL);
991
return -1;
992
}
993
if (memcmp(memprotect_test_address,b2,p)) {
994
memprotect_result=memprotect_no_restart;
995
sigaction(SIGSEGV,&sao,NULL);
996
sigaction(SIGBUS,&saob,NULL);
997
return -1;
998
}
999
memprotect_result=memprotect_success;
1000
sigaction(SIGSEGV,&sao,NULL);
1001
sigaction(SIGBUS,&saob,NULL);
1002
return 0;
1003
1004
}
1005
1006
static int
1007
do_memprotect_test(void) {
1008
1009
int rc=0;
1010
1011
memprotect_print_enable=1;
1012
if (memprotect_test()) {
1013
memprotect_print();
1014
if (sgc_enabled)
1015
sgc_quit();
1016
rc=-1;
1017
}
1018
memprotect_print_enable=0;
1019
return rc;
1020
1021
}
1022
1023
void
1024
memprotect_test_reset(void) {
1025
1026
memprotect_result=memprotect_none;
1027
memprotect_handler_invocations=0;
1028
memprotect_test_address=NULL;
1029
1030
if (sgc_enabled)
1031
do_memprotect_test();
1032
1033
}
1034
1035
#define MMIN(a,b) ({long _a=a,_b=b;_a<_b ? _a : _b;})
1036
#define MMAX(a,b) ({long _a=a,_b=b;_a>_b ? _a : _b;})
1037
/* If opt_maxpage is set, don't lose balancing information gained thus
1038
far if we are triggered 'artificially' via a hole overrun. FIXME --
1039
try to allocate a small working set with the right proportions
1040
later on. 20040804 CM*/
1041
#define WSGC(tm) ({struct typemanager *_tm=tm;long _t=MMAX(MMIN(_tm->tm_opt_maxpage,_tm->tm_npage),_tm->tm_sgc);_t*scale;})
1042
/* If opt_maxpage is set, add full pages to the sgc set if needed
1043
too. 20040804 CM*/
1044
/* #define FSGC(tm) (tm->tm_type==t_cons ? tm->tm_nppage : (tm->tm_opt_maxpage ? 0 : tm->tm_sgc_minfree)) */
1045
#define FSGC(tm) (!TYPEWORD_TYPE_P(tm->tm_type) ? tm->tm_nppage : tm->tm_sgc_minfree)
1046
1047
DEFVAR("*WRITABLE*",sSAwritableA,SI,Cnil,"");
1048
1049
unsigned char *wrimap=NULL;
1050
1051
int
1052
sgc_start(void) {
1053
1054
long i,count,minfree,allocate_more_pages=!saving_system && 10*available_pages>2*(real_maxpage-first_data_page);
1055
long np;
1056
struct typemanager *tm;
1057
struct pageinfo *v;
1058
object omp=sSAoptimize_maximum_pagesA->s.s_dbind;
1059
double tmp,scale;
1060
1061
sSAoptimize_maximum_pagesA->s.s_dbind=Cnil;
1062
1063
if (memprotect_result!=memprotect_success && do_memprotect_test())
1064
return 0;
1065
1066
if (sgc_enabled)
1067
return 1;
1068
1069
/* Reset maxpage statistics if not invoked automatically on a hole
1070
overrun. 20040804 CM*/
1071
/* if (!hole_overrun) { */
1072
/* vs_mark; */
1073
/* object *old_vs_base=vs_base; */
1074
/* vs_base=vs_top; */
1075
/* FFN(siLreset_gbc_count)(); */
1076
/* vs_base=old_vs_base; */
1077
/* vs_reset; */
1078
/* } */
1079
1080
for (i=t_start,scale=1.0,tmp=0.0;i<t_other;i++)
1081
if (TM_BASE_TYPE_P(i))
1082
tmp+=WSGC(tm_of(i));
1083
tmp+=WSGC(tm_of(t_relocatable));
1084
scale=tmp>available_pages/10 ? (float)available_pages/(10*tmp) : 1.0;
1085
1086
for (i= t_start; i < t_contiguous ; i++) {
1087
1088
if (!TM_BASE_TYPE_P(i) || !(np=(tm=tm_of(i))->tm_sgc)) continue;
1089
1090
minfree = FSGC(tm) > 0 ? FSGC(tm) : 1;
1091
count=0;
1092
1093
FIND_FREE_PAGES:
1094
1095
for (v=cell_list_head;v && (count<MMAX(tm->tm_sgc_max,WSGC(tm)));v=v->next) {
1096
1097
if (v->type!=i || tm->tm_nppage-v->in_use<minfree) continue;
1098
1099
v->sgc_flags|=SGC_PAGE_FLAG;
1100
count++;
1101
1102
}
1103
1104
if (count<WSGC(tm) && !FSGC(tm))
1105
for (v=cell_list_head;v && (count<MMAX(tm->tm_sgc_max,WSGC(tm)));v=v->next) {
1106
1107
if (v->type!=i || tm->tm_nppage!=v->in_use) continue;
1108
1109
v->sgc_flags|=SGC_PAGE_FLAG;
1110
count++;
1111
if (count >= MMAX(tm->tm_sgc_max,WSGC(tm)))
1112
break;
1113
}
1114
1115
/* don't do any more allocations for this type if saving system */
1116
if (!allocate_more_pages)
1117
continue;
1118
1119
if (count < WSGC(tm)) {
1120
/* try to get some more free pages of type i */
1121
long n = WSGC(tm) - count;
1122
long again=0,nfree = tm->tm_nfree;
1123
char *p=alloc_page(n);
1124
if (tm->tm_nfree > nfree) again=1; /* gc freed some objects */
1125
if (tm->tm_npage+n>tm->tm_maxpage)
1126
if (!set_tm_maxpage(tm,tm->tm_npage+n))
1127
n=0;
1128
while (n-- > 0) {
1129
/* (sgc_enabled=1,add_page_to_freelist(p,tm),sgc_enabled=0); */
1130
add_page_to_freelist(p,tm);
1131
p += PAGESIZE;
1132
}
1133
if (again)
1134
goto FIND_FREE_PAGES;
1135
}
1136
1137
}
1138
1139
1140
/* SGC cont pages: Here we implement the contblock page division into
1141
SGC and non-SGC types. Unlike the other types, we need *whole*
1142
free pages for contblock SGC, as there is no persistent data
1143
element (e.g. .m) on an allocated block itself which can indicate
1144
its live status. If anything on a page which is to be marked
1145
read-only points to a live object on an SGC cont page, it will
1146
never be marked and will be erroneously swept. It is also possible
1147
for dead objects to unnecessarily mark dead regions on SGC pages
1148
and delay sweeping until the pointing type is GC'ed if SGC is
1149
turned off for the pointing type, e.g. tm_sgc=0. (This was so by
1150
default for a number of types, including bignums, and has now been
1151
corrected in gcl_init_alloc in alloc.c.) We can't get around this
1152
AFAICT, as old data on (writable) SGC pages must be marked lest it
1153
is lost, and (old) data on now writable non-SGC pages might point
1154
to live regions on SGC pages, yet might not themselves be reachable
1155
from the mark origin through an unbroken chain of writable pages.
1156
In any case, the possibility of a lot of garbage marks on contblock
1157
pages, especially when the blocks are small as in bignums, makes
1158
necessary the sweeping of minimal contblocks to prevent leaks. CM
1159
20030827 */
1160
1161
{
1162
1163
void *p=NULL,*pe;
1164
struct pageinfo *pi;
1165
fixnum i,j,count=0;
1166
struct contblock **cbpp;
1167
1168
tm=tm_of(t_contiguous);
1169
1170
for (pi=contblock_list_head;pi && count<WSGC(tm);pi=pi->next) {
1171
1172
p=CB_DATA_START(pi);
1173
pe=CB_DATA_END(pi);
1174
1175
for (cbpp=&cb_pointer,j=0;*cbpp;cbpp=&(*cbpp)->cb_link)
1176
if ((void*)*cbpp>=p && (void *)*cbpp<pe)
1177
j+=(*cbpp)->cb_size;
1178
1179
if (j*tm->tm_nppage<FSGC(tm)*(CB_DATA_END(pi)-CB_DATA_START(pi))) continue;
1180
1181
pi->sgc_flags=SGC_PAGE_FLAG;
1182
count+=pi->in_use;
1183
1184
}
1185
i=allocate_more_pages ? WSGC(tm) : (saving_system ? 1 : 0);
1186
1187
if (i>count) {
1188
/* SGC cont pages: allocate more if necessary, dumping possible
1189
GBC freed pages onto the old contblock list. CM 20030827*/
1190
unsigned long z=(i-count)+1;
1191
void *old_contblock_list_tail=contblock_list_tail;
1192
1193
if (maxcbpage<ncbpage+z)
1194
if (!set_tm_maxpage(tm_table+t_contiguous,ncbpage+z))
1195
z=0;
1196
1197
add_pages(tm_table+t_contiguous,z);
1198
1199
massert(old_contblock_list_tail!=contblock_list_tail);
1200
1201
contblock_list_tail->sgc_flags=SGC_PAGE_FLAG;
1202
1203
}
1204
1205
}
1206
1207
/* Now allocate the sgc relblock. We do this as the tail
1208
end of the ordinary rb. */
1209
{
1210
char *new;
1211
tm=tm_of(t_relocatable);
1212
1213
{
1214
old_rb_start=rb_start;
1215
if(((unsigned long)WSGC(tm)) && allocate_more_pages) {
1216
new=alloc_relblock(((unsigned long)WSGC(tm))*PAGESIZE);
1217
/* the above may cause a gc, shifting the relblock */
1218
old_rb_start=rb_start;
1219
new= PAGE_ROUND_UP(new);
1220
} else new=PAGE_ROUND_UP(rb_pointer);
1221
rb_start=rb_pointer=new;
1222
}
1223
}
1224
/* the relblock has been allocated */
1225
1226
sSAwritableA->s.s_dbind=fSmake_vector1_1((page(rb_start)-first_data_page),aet_bit,Cnil);
1227
wrimap=(void *)sSAwritableA->s.s_dbind->v.v_self;
1228
1229
/* now move the sgc free lists into place. alt_free should
1230
contain the others */
1231
for (i= t_start; i < t_contiguous ; i++)
1232
if (TM_BASE_TYPE_P(i) && (np=(tm=tm_of(i))->tm_sgc)) {
1233
object f=tm->tm_free ,x,y,next;
1234
fixnum count=0;
1235
x=y=OBJNULL;
1236
1237
while (f!=OBJNULL) {
1238
next=OBJ_LINK(f);
1239
#ifdef SDEBUG
1240
if (!is_free(f))
1241
printf("Not FREE in freelist f=%d",f);
1242
#endif
1243
if (pageinfo(f)->sgc_flags&SGC_PAGE_FLAG) {
1244
SET_LINK(f,x);
1245
if (TYPEWORD_TYPE_P(pageinfo(f)->type)) f->d.s = SGC_RECENT;
1246
x=f;
1247
count++;
1248
} else {
1249
SET_LINK(f,y);
1250
if (TYPEWORD_TYPE_P(pageinfo(f)->type)) f->d.s = SGC_NORMAL;
1251
y=f;
1252
}
1253
f=next;
1254
}
1255
tm->tm_free = x;
1256
tm->tm_alt_free = y;
1257
tm->tm_alt_nfree = tm->tm_nfree - count;
1258
tm->tm_nfree=count;
1259
}
1260
1261
{
1262
1263
struct pageinfo *pi;
1264
1265
{
1266
1267
struct contblock *new_cb_pointer=NULL,*tmp_cb_pointer=NULL,**cbpp;
1268
void *p=NULL,*pe;
1269
struct pageinfo *pi;
1270
1271
for (pi=contblock_list_head;pi;pi=pi->next) {
1272
1273
if (pi->sgc_flags!=SGC_PAGE_FLAG) continue;
1274
1275
p=CB_DATA_START(pi);
1276
pe=p+CB_DATA_SIZE(pi->in_use);
1277
1278
for (cbpp=&cb_pointer;*cbpp;)
1279
if ((void *)*cbpp>=p && (void *)*cbpp<pe) {
1280
void *s=*cbpp,*e=s+(*cbpp)->cb_size,*l=(*cbpp)->cb_link;
1281
set_sgc_bits(pi,s,e);
1282
tmp_cb_pointer=cb_pointer;
1283
cb_pointer=new_cb_pointer;
1284
insert_contblock(s,e-s);
1285
new_cb_pointer=cb_pointer;
1286
cb_pointer=tmp_cb_pointer;
1287
*cbpp=l;
1288
} else
1289
cbpp=&(*cbpp)->cb_link;
1290
1291
}
1292
1293
/* SGC contblock pages: switch to new free SGC contblock list. CM
1294
20030827 */
1295
old_cb_pointer=cb_pointer;
1296
cb_pointer=new_cb_pointer;
1297
1298
#ifdef SGC_CONT_DEBUG
1299
overlap_check(old_cb_pointer,cb_pointer);
1300
#endif
1301
}
1302
1303
for (i=t_start;i<t_other;i++)
1304
tm_of(i)->tm_alt_npage=0;
1305
writable_pages=0;
1306
1307
for (pi=cell_list_head;pi;pi=pi->next) {
1308
if (pi->sgc_flags&SGC_WRITABLE)
1309
SET_WRITABLE(page(pi));
1310
else
1311
tm_of(pi->type)->tm_alt_npage++;
1312
#ifndef NO_SETBUF /*FIXME, implement restartable getc with read in readc_stream*/
1313
{
1314
void *v,*ve;
1315
if (pi->type!=(tm=tm_of(t_stream))->tm_type) continue;
1316
for (v=pagetochar(page(pi)),ve=v+tm->tm_nppage*tm->tm_size;v<ve;v+=tm->tm_size) {
1317
object x=v;
1318
if (type_of(x)!=t_stream || is_free(x)) continue;
1319
if (x->sm.sm_buffer)
1320
for (i=page(x->sm.sm_buffer);i<=page(x->sm.sm_buffer+BUFSIZ-1);i++)
1321
SET_WRITABLE(i);
1322
}
1323
}
1324
#endif
1325
}
1326
for (pi=contblock_list_head;pi;pi=pi->next)/*FIXME*/
1327
if (pi->sgc_flags&SGC_WRITABLE)
1328
for (i=0;i<pi->in_use;i++)
1329
SET_WRITABLE(page(pi)+i);
1330
else
1331
tm_of(t_contiguous)->tm_alt_npage+=pi->in_use;
1332
#ifdef GCL_GPROF
1333
{
1334
extern object gprof_array;
1335
if (gprof_array!=Cnil)
1336
for (i=0;i<(gprof_array->st.st_fillp +PAGESIZE-1)/PAGESIZE;i++)
1337
SET_WRITABLE(page(gprof_array->st.st_self)+i);
1338
}
1339
#endif
1340
for (i=page(heap_end);i<page(old_rb_start);i++)
1341
SET_WRITABLE(i);
1342
tm_of(t_relocatable)->tm_alt_npage=page(rb_start)-page(old_rb_start);
1343
for (i=page(rb_start);i<page(core_end);i++)
1344
SET_WRITABLE(i);
1345
1346
fault_pages=0;
1347
1348
}
1349
1350
/* Whew. We have now allocated the sgc space
1351
and modified the tm_table;
1352
Turn memory protection on for the pages which are writable.
1353
*/
1354
memory_protect(1);
1355
sgc_enabled=1;
1356
if (sSAnotify_gbcA->s.s_dbind != Cnil) {
1357
printf("[SGC on]");
1358
fflush(stdout);
1359
}
1360
1361
sSAoptimize_maximum_pagesA->s.s_dbind=omp;
1362
1363
return 1;
1364
1365
}
1366
1367
/* int */
1368
/* pdebug(void) { */
1369
1370
/* extern object malloc_list; */
1371
/* object x=malloc_list; */
1372
/* struct pageinfo *v; */
1373
/* for (;x!=Cnil;x=x->c.c_cdr) */
1374
/* printf("%p %d\n",x->c.c_car->st.st_self,x->c.c_car->st.st_dim); */
1375
1376
/* for (v=contblock_list_head;v;v=v->next) */
1377
/* printf("%p %ld\n",v,v->in_use<<12); */
1378
/* return 0; */
1379
/* } */
1380
1381
1382
int
1383
sgc_quit(void) {
1384
1385
struct typemanager *tm;
1386
struct contblock *tmp_cb_pointer,*next;
1387
unsigned long i,j,np;
1388
char *p;
1389
struct pageinfo *v;
1390
1391
memory_protect(0);
1392
1393
if(sSAnotify_gbcA->s.s_dbind != Cnil)
1394
printf("[SGC off]"); fflush(stdout);
1395
1396
if (sgc_enabled==0)
1397
return 0;
1398
1399
sSAwritableA->s.s_dbind=Cnil;
1400
wrimap=NULL;
1401
1402
sgc_enabled=0;
1403
rb_start = old_rb_start;
1404
1405
/* SGC cont pages: restore contblocks, each tmp_cb_pointer coming
1406
from the new list is guaranteed not to be on the old. Need to
1407
grab 'next' before insert_contblock writes is. CM 20030827 */
1408
1409
if (old_cb_pointer) {
1410
#ifdef SGC_CONT_DEBUG
1411
overlap_check(old_cb_pointer,cb_pointer);
1412
#endif
1413
tmp_cb_pointer=cb_pointer;
1414
cb_pointer=old_cb_pointer;
1415
for (;tmp_cb_pointer; tmp_cb_pointer=next) {
1416
next=tmp_cb_pointer->cb_link;
1417
insert_contblock((void *)tmp_cb_pointer,tmp_cb_pointer->cb_size);
1418
}
1419
}
1420
1421
for (i= t_start; i < t_contiguous ; i++)
1422
1423
if (TM_BASE_TYPE_P(i) && (np=(tm=tm_of(i))->tm_sgc)) {
1424
1425
object f,y;
1426
1427
f=tm->tm_free;
1428
if (f==OBJNULL)
1429
tm->tm_free=tm->tm_alt_free;
1430
else {
1431
/* tack the alt_free onto the end of free */
1432
#ifdef SDEBUG
1433
fixnum count=0;
1434
f=tm->tm_free;
1435
while(y= (object) F_LINK(f)) {
1436
if(y->d.s != SGC_RECENT)
1437
printf("[bad %d]",y);
1438
count++; f=y;
1439
}
1440
1441
count=0;
1442
if (f==tm->tm_alt_free)
1443
while(y= F_LINK(f)) {
1444
if(y->d.s != SGC_NORMAL)
1445
printf("[alt_bad %d]",y);
1446
count++; f=y;
1447
}
1448
1449
#endif
1450
f=tm->tm_free;
1451
while((y= (object) F_LINK(f))!=OBJNULL)
1452
f=y;
1453
F_LINK(f)= (long)(tm->tm_alt_free);
1454
}
1455
/* tm->tm_free has all of the free objects */
1456
tm->tm_nfree += tm->tm_alt_nfree;
1457
tm->tm_alt_nfree = 0;
1458
tm->tm_alt_free = OBJNULL;
1459
1460
}
1461
1462
/*FIXME*/
1463
/* remove the recent flag from any objects on sgc pages */
1464
for (v=cell_list_head;v;v=v->next)
1465
if (v->type==(tm=tm_of(v->type))->tm_type && TYPEWORD_TYPE_P(v->type) && v->sgc_flags & SGC_PAGE_FLAG)
1466
for (p=pagetochar(page(v)),j=tm->tm_nppage;j>0;--j,p+=tm->tm_size)
1467
((object) p)->d.s=SGC_NORMAL;
1468
1469
for (v=contblock_list_head;v;v=v->next)
1470
if (v->sgc_flags&SGC_PAGE_FLAG)
1471
bzero(CB_SGCF_START(v),CB_DATA_START(v)-CB_SGCF_START(v));
1472
1473
{
1474
struct pageinfo *pi;
1475
for (pi=cell_list_head;pi;pi=pi->next)
1476
pi->sgc_flags&=SGC_PERM_WRITABLE;
1477
for (pi=contblock_list_head;pi;pi=pi->next)
1478
pi->sgc_flags&=SGC_PERM_WRITABLE;
1479
}
1480
1481
return 0;
1482
1483
}
1484
1485
fixnum debug_fault =0;
1486
fixnum fault_count =0;
1487
extern char etext;
1488
static void
1489
memprotect_handler(int sig, long code, void *scp, char *addr) {
1490
1491
unsigned long p;
1492
void *faddr; /* Needed because we must not modify signal handler
1493
arguments on the stack! */
1494
#ifdef GET_FAULT_ADDR
1495
faddr=GET_FAULT_ADDR(sig,code,scp,addr);
1496
debug_fault = (long) faddr;
1497
#ifdef DEBUG_MPROTECT
1498
printf("fault:0x%x [%d] (%d) ",faddr,page(faddr),faddr >= core_end);
1499
#endif
1500
if (faddr >= (void *)core_end || faddr < data_start) {
1501
if (fault_count > 300) error("fault count too high");
1502
fault_count ++;
1503
INSTALL_MPROTECT_HANDLER;
1504
return;
1505
}
1506
#else
1507
faddr = addr;
1508
#endif
1509
p = page(faddr);
1510
/* p = ROUND_DOWN_PAGE_NO(p); */
1511
if (p >= first_protectable_page
1512
&& faddr < (void *)core_end
1513
&& !(WRITABLE_PAGE_P(p))) {
1514
/* CHECK_RANGE(p,1); */
1515
#ifdef DEBUG_MPROTECT
1516
printf("mprotect(0x%x,0x%x,0x%x)\n",
1517
pagetoinfo(p),PAGESIZE, sbrk(0));
1518
fflush(stdout);
1519
#endif
1520
1521
#ifndef BSD
1522
INSTALL_MPROTECT_HANDLER;
1523
#endif
1524
1525
mprotect(pagetoinfo(p),PAGESIZE,PROT_READ_WRITE_EXEC);
1526
SET_WRITABLE(p);
1527
fault_pages++;
1528
1529
return;
1530
1531
}
1532
1533
#ifndef BSD
1534
INSTALL_MPROTECT_HANDLER;
1535
#endif
1536
1537
segmentation_catcher(0);
1538
1539
}
1540
1541
static void
1542
sgc_mprotect(long pbeg, long n, int writable) {
1543
/* CHECK_RANGE(pbeg,n); */
1544
#ifdef DEBUG_MPROTECT
1545
printf("prot[%d,%d,(%d),%s]\n",pbeg,pbeg+n,writable & SGC_WRITABLE,
1546
(writable & SGC_WRITABLE ? "writable" : "not writable"));
1547
printf("mprotect(0x%x,0x%x), sbrk(0)=0x%x\n",
1548
pagetoinfo(pbeg), n * PAGESIZE, sbrk(0));
1549
fflush(stdout);
1550
#endif
1551
if(mprotect(pagetoinfo(pbeg),n*PAGESIZE,
1552
(writable & SGC_WRITABLE ? PROT_READ_WRITE_EXEC : PROT_READ_EXEC)))
1553
FEerror("Couldn't protect",0);
1554
}
1555
1556
1557
1558
void
1559
memory_protect(int on) {
1560
1561
unsigned long i,beg,end= page(core_end);
1562
int writable=1;
1563
extern void install_segmentation_catcher(void);
1564
1565
1566
first_protectable_page=first_data_page;
1567
1568
/* turning it off */
1569
if (on==0) {
1570
sgc_mprotect(first_protectable_page,end-first_protectable_page,SGC_WRITABLE);
1571
install_segmentation_catcher();
1572
return;
1573
}
1574
1575
INSTALL_MPROTECT_HANDLER;
1576
1577
beg=first_protectable_page;
1578
writable = IS_WRITABLE(beg);
1579
for (i=beg ; ++i<= end; ) {
1580
1581
if (writable==IS_WRITABLE(i) && i<=end) continue;
1582
1583
sgc_mprotect(beg,i-beg,writable);
1584
writable=1-writable;
1585
beg=i;
1586
1587
}
1588
1589
}
1590
1591
static void
1592
FFN(siLsgc_on)(void) {
1593
1594
if (vs_base==vs_top) {
1595
vs_base[0]=(sgc_enabled ? Ct :Cnil);
1596
vs_top=vs_base+1; return;
1597
}
1598
check_arg(1);
1599
if(vs_base[0]==Cnil)
1600
sgc_quit();
1601
else
1602
vs_base[0]=sgc_start() ? Ct : Cnil;
1603
}
1604
1605
void
1606
system_error(void) {
1607
FEerror("System error",0);
1608
}
Loggerhead is a web-based interface for Breezy
Version: 2.0.1