1
/* Copyright William Schelter. All rights reserved.
3
Stratified Garbage Collection (SGC)
5
Write protects pages to tell which ones have been written
6
to recently, for more efficient garbage collection.
11
sgc_mark_object1(object);
14
sgc_mprotect(long, long, int);
18
/* ulong may have been defined in mp.h but the define is no longer needed */
21
#define PROT_READ_WRITE_EXEC (PROT_READ | PROT_WRITE |PROT_EXEC)
22
#define PROT_READ_EXEC (PROT_READ|PROT_EXEC)
25
#include <sys/vmuser.h>
26
#define PROT_READ_EXEC RDONLY /*FIXME*/
27
#define PROT_READ_WRITE_EXEC UDATAKEY
33
#define PROT_READ_WRITE_EXEC PAGE_EXECUTE_READWRITE
34
#define PROT_READ_EXEC PAGE_READONLY /*FIXME*/
36
int gclmprotect ( void *addr, size_t len, int prot ) {
38
rv = VirtualProtect ( (LPVOID) addr, len, prot, &old );
40
fprintf ( stderr, "mprotect: VirtualProtect %x %d %d failed\n", addr, len, prot );
47
/* Avoid clash with libgcc's mprotect */
48
#define mprotect gclmprotect
53
#include <sys/ucontext.h>
58
/* void segmentation_catcher(void); */
61
#define sgc_mark_pack_list(u) \
62
do {register object xtmp = u; \
63
while (xtmp != Cnil) \
64
{if (ON_WRITABLE_PAGE(xtmp)) xtmp->d.m = TRUE; \
65
sgc_mark_object(xtmp->c.c_car); \
66
xtmp=xtmp->c.c_cdr;}}while(0)
76
sgc_mark_cons(object x) {
80
/* x is already marked. */
86
sgc_mark_object(x->c.c_car);
88
IF_WRITABLE(x->c.c_car, goto MARK_CAR;);
92
if (x->c.c_car->c.m ==0) {
93
if (type_of(x->c.c_car) == t_cons) {
94
x->c.c_car->c.m = TRUE;
95
sgc_mark_cons(x->c.c_car);
97
sgc_mark_object1(x->c.c_car);}
101
IF_WRITABLE(x, goto WRITABLE_CDR;);
105
if (type_of(x) == t_cons) {
113
/* Whenever two arrays are linked together by displacement,
114
if one is live, the other will be made live */
115
#define sgc_mark_displaced_field(ar) sgc_mark_object(ar->a.a_displaced)
118
/* structures and arrays of type t, need to be marked if their
119
bodies are not write protected even if the headers are.
120
So we should keep these on pages particular to them.
121
Actually we will change structure sets to touch the structure
122
header, that way we won't have to keep the headers in memory.
123
This takes only 1.47 as opposed to 1.33 microseconds per set.
126
sgc_mark_object1(object x) {
136
if (x == OBJNULL || !ON_WRITABLE_PAGE(x))
138
IF_WRITABLE(x,goto OK);
145
if(x==sdebug) joe1();
148
if (NULL_OR_ON_C_STACK(x))
150
/* otherwise if DBEGIN==0 the IF_WRITABLE test will
151
always fail on x that satisfy (NULL_OR_ON_C_STACK(x))
155
switch (type_of(x)) {
160
sgc_mark_object(x->rat.rat_num);
162
IF_WRITABLE(x,if(x->d.m==0) goto BEGIN);
171
sgc_mark_object(x->cmp.cmp_imag);
173
IF_WRITABLE(x,if(x->d.m==0) goto BEGIN);
179
IF_WRITABLE(x->s.s_plist,if(x->s.s_plist->d.m==0)
180
{x->s.s_plist->d.m=TRUE;
181
sgc_mark_cons(x->s.s_plist);});
182
sgc_mark_object(x->s.s_gfdef);
183
sgc_mark_object(x->s.s_dbind);
184
if (x->s.s_self == NULL)
187
if ((int)what_to_collect >= (int)t_contiguous) {
188
if (inheap(x->s.s_self)) {
189
if (what_to_collect == t_contiguous)
190
mark_contblock(x->s.s_self,
192
} else if(SGC_RELBLOCK_P(x->s.s_self))
194
copy_relblock(x->s.s_self, x->s.s_fillp);
199
sgc_mark_object(x->p.p_name);
200
sgc_mark_object(x->p.p_nicknames);
201
sgc_mark_object(x->p.p_shadowings);
202
sgc_mark_object(x->p.p_uselist);
203
sgc_mark_object(x->p.p_usedbylist);
204
if (what_to_collect != t_contiguous)
206
if (x->p.p_internal != NULL)
207
mark_contblock((char *)(x->p.p_internal),
208
x->p.p_internal_size*sizeof(object));
209
if (x->p.p_external != NULL)
210
mark_contblock((char *)(x->p.p_external),
211
x->p.p_external_size*sizeof(object));
216
sgc_mark_object(x->c.c_car);
224
sgc_mark_object(x->ht.ht_rhsize);
225
sgc_mark_object(x->ht.ht_rhthresh);
226
if (x->ht.ht_self == NULL)
228
for (i = 0, j = x->ht.ht_size; i < j; i++) {
229
sgc_mark_object(x->ht.ht_self[i].hte_key);
230
sgc_mark_object(x->ht.ht_self[i].hte_value);
232
if ((short)what_to_collect >= (short)t_contiguous) {
233
if (inheap(x->ht.ht_self)) {
234
if (what_to_collect == t_contiguous)
235
mark_contblock((char *)(x->ht.ht_self),
236
j * sizeof(struct htent));
237
} else if(SGC_RELBLOCK_P(x->ht.ht_self))
238
x->ht.ht_self = (struct htent *)
239
copy_relblock((char *)(x->ht.ht_self),
240
j * sizeof(struct htent));
245
if ((x->a.a_displaced) != Cnil)
246
sgc_mark_displaced_field(x);
247
if ((int)what_to_collect >= (int)t_contiguous &&
248
x->a.a_dims != NULL) {
249
if (inheap(x->a.a_dims)) {
250
if (what_to_collect == t_contiguous)
251
mark_contblock((char *)(x->a.a_dims),
252
sizeof(int)*x->a.a_rank);
253
} else if(SGC_RELBLOCK_P(x->a.a_dims))
254
x->a.a_dims = (int *)
255
copy_relblock((char *)(x->a.a_dims),
256
sizeof(int)*x->a.a_rank);
258
if ((enum aelttype)x->a.a_elttype == aet_ch)
260
if ((enum aelttype)x->a.a_elttype == aet_bit)
262
if ((enum aelttype)x->a.a_elttype == aet_object)
266
cp = (char *)(x->fixa.fixa_self);
269
/* set j to the size in char of the body of the array */
271
switch((enum aelttype)x->a.a_elttype){
273
j= sizeof(longfloat)*x->lfa.lfa_dim;
274
if (((int)what_to_collect >= (int)t_contiguous) &&
275
!(inheap(cp)) && SGC_RELBLOCK_P(x->a.a_self))
276
ROUND_RB_POINTERS_DOUBLE;
280
j=sizeof(char)*x->a.a_dim;
284
j=sizeof(short)*x->a.a_dim;
287
j=sizeof(fixnum)*x->fixa.fixa_dim;}
295
|| (char *)p >= core_end
301
if (x->a.a_displaced->c.c_car == Cnil)
302
for (i = 0, j = x->a.a_dim; i < j; i++)
303
if (ON_WRITABLE_PAGE(&p[i]))
304
sgc_mark_object(p[i]);
308
if ((int)what_to_collect >= (int)t_contiguous) {
310
if (what_to_collect == t_contiguous)
311
mark_contblock(cp, j);
312
} else if (!SGC_RELBLOCK_P(cp))
314
else if (x->a.a_displaced == Cnil) {
316
if (!NULL_OR_ON_C_STACK(cp)) /* only if body of array not on C stack */
318
x->a.a_self = (object *)copy_relblock(cp, j);
320
else if (x->a.a_displaced->c.c_car == Cnil) {
321
i = (long)(object *)copy_relblock(cp, j)
322
- (long)(x->a.a_self);
323
adjust_displaced(x, i);
329
if ((x->v.v_displaced) != Cnil)
330
sgc_mark_displaced_field(x);
331
if ((enum aelttype)x->v.v_elttype == aet_object)
338
if (type_map[page(x->big.big_self)] < t_contiguous)
339
printf("bad body for %x (%x)\n",x,cp);
342
if ((int)what_to_collect >= (int)t_contiguous) {
343
j = x->big.big_length;
344
cp = (char *)x->big.big_self;
347
if (j != lg(MP(x)) &&
348
/* we don't bother to zero this register,
349
and its contents may get over written */
350
! (x == big_register_1 &&
354
printf("bad length 0x%x ",x);
358
if (what_to_collect == t_contiguous)
359
mark_contblock(cp, j);
361
if (SGC_RELBLOCK_P(cp))
362
x->big.big_self = (plong *)copy_relblock(cp, j);}}
364
#ifndef GMP_USE_MALLOC
365
if ((int)what_to_collect >= (int)t_contiguous) {
367
cp = (char *)MP_SELF(x);
371
if (j != lg(MP(x)) &&
372
/* we don't bother to zero this register,
373
and its contents may get over written */
374
! (x == big_register_1 &&
377
printf("bad length 0x%x ",x);
379
j = j * MP_LIMB_SIZE;
381
if (what_to_collect == t_contiguous)
382
mark_contblock(cp, j);
384
if (SGC_RELBLOCK_P(cp))
385
MP_SELF(x) = (void *) copy_relblock(cp, j);
387
#endif /* not GMP_USE_MALLOC */
393
if ((x->st.st_displaced) != Cnil)
394
sgc_mark_displaced_field(x);
401
if ((int)what_to_collect >= (int)t_contiguous) {
403
if (what_to_collect == t_contiguous)
404
mark_contblock(cp, j);
406
else if (!SGC_RELBLOCK_P(cp)) ;
407
else if (x->st.st_displaced == Cnil)
408
x->st.st_self = copy_relblock(cp, j);
409
else if (x->st.st_displaced->c.c_car == Cnil) {
410
i = copy_relblock(cp, j) - cp;
411
adjust_displaced(x, i);
418
if ((x->bv.bv_displaced) != Cnil)
419
sgc_mark_displaced_field(x);
420
/* We make bitvectors multiple of sizeof(int) in size allocated
421
Assume 8 = number of bits in char */
423
#define W_SIZE (8*sizeof(int))
425
((BV_OFFSET(x) + x->bv.bv_dim + W_SIZE -1)/W_SIZE);
432
sgc_mark_object(x->str.str_def);
437
object def=x->str.str_def;
438
unsigned char * s_type = &SLOT_TYPE(def,0);
439
unsigned short *s_pos= & SLOT_POS(def,0);
440
for (i = 0, j = S_DATA(def)->length; i < j; i++)
442
ON_WRITABLE_PAGE(& STREF(object,x,s_pos[i]))
444
sgc_mark_object(STREF(object,x,s_pos[i]));
445
if ((int)what_to_collect >= (int)t_contiguous) {
446
if (inheap(x->str.str_self)) {
447
if (what_to_collect == t_contiguous)
448
mark_contblock((char *)p,
451
} else if(SGC_RELBLOCK_P(p))
452
x->str.str_self = (object *)
453
copy_relblock((char *)p, S_DATA(def)->size);
459
switch (x->sm.sm_mode) {
465
sgc_mark_object(x->sm.sm_object0);
466
sgc_mark_object(x->sm.sm_object1);
468
FILE *fp = x->sm.sm_fp;
469
if (fp != 0 && fp != stdin && fp !=stdout) {
475
if (what_to_collect == t_contiguous &&
478
mark_contblock(x->sm.sm_buffer, BUFSIZ);
482
sgc_mark_object(x->sm.sm_object0);
486
case smm_concatenated:
487
sgc_mark_object(x->sm.sm_object0);
492
sgc_mark_object(x->sm.sm_object0);
493
sgc_mark_object(x->sm.sm_object1);
496
case smm_string_input:
497
case smm_string_output:
498
sgc_mark_object(x->sm.sm_object0);
500
#ifdef USER_DEFINED_STREAMS
501
case smm_user_defined:
502
sgc_mark_object(x->sm.sm_object0);
503
sgc_mark_object(x->sm.sm_object1);
507
error("mark stream botch");
515
if (x->rt.rt_self == NULL)
517
if (what_to_collect == t_contiguous)
518
mark_contblock((char *)(x->rt.rt_self),
519
RTABSIZE*sizeof(struct rtent));
520
for (i = 0; i < RTABSIZE; i++) {
521
sgc_mark_object(x->rt.rt_self[i].rte_macro);
522
if (x->rt.rt_self[i].rte_dtab != NULL) {
523
if (what_to_collect == t_contiguous)
524
mark_contblock((char *)(x->rt.rt_self[i].rte_dtab),
525
RTABSIZE*sizeof(object));
526
for (j = 0; j < RTABSIZE; j++)
527
sgc_mark_object(x->rt.rt_self[i].rte_dtab[j]);
533
sgc_mark_object(x->pn.pn_host);
534
sgc_mark_object(x->pn.pn_device);
535
sgc_mark_object(x->pn.pn_directory);
536
sgc_mark_object(x->pn.pn_name);
537
sgc_mark_object(x->pn.pn_type);
538
sgc_mark_object(x->pn.pn_version);
544
if (what_to_collect == t_contiguous)
545
mark_contblock(x->cc.cc_turbo,x->cc.cc_envdim);
546
for (i= 0 ; i < x->cc.cc_envdim ; i++)
547
sgc_mark_object(x->cc.cc_turbo[i]);
555
sgc_mark_object(x->cf.cf_name);
556
sgc_mark_object(x->cf.cf_data);
561
if (x->cfd.cfd_self != NULL) {
562
int i=x->cfd.cfd_fillp;
564
sgc_mark_object(x->cfd.cfd_self[i]);
566
if (x->cfd.cfd_start == NULL)
568
if (what_to_collect == t_contiguous) {
569
if (!MAYBE_DATA_P((x->cfd.cfd_start)) ||
570
get_mark_bit((int *)(x->cfd.cfd_start)))
572
mark_contblock(x->cfd.cfd_start, x->cfd.cfd_size);
576
sgc_mark_object(x->cc.cc_name);
577
sgc_mark_object(x->cc.cc_env);
578
sgc_mark_object(x->cc.cc_data);
579
if (what_to_collect == t_contiguous) {
580
if (x->cc.cc_turbo != NULL)
581
mark_contblock((char *)(x->cc.cc_turbo-1),
582
(1+fix(*(x->cc.cc_turbo-1)))*sizeof(object));
592
printf("\ttype = %d\n", type_of(x));
600
sgc_mark_stack_carefully(void *topv, void *bottomv, int offset) {
605
struct typemanager *tm;
607
long *top=topv,*bottom=bottomv;
609
/* if either of these happens we are marking the C stack
610
and need to use a local */
612
if (top==0) top = c_stack_where;
613
if (bottom==0) bottom= c_stack_where;
615
/* On machines which align local pointers on multiple of 2 rather
616
than 4 we need to mark twice
620
sgc_mark_stack_carefully((((char *) top) +offset),bottom,0);
621
for (j=top ; j >= bottom ; j--) {
622
if (VALID_DATA_ADDRESS_P(*j)
623
&& type_map[(p=page(*j))]< (char)t_end) {
624
pageoffset=((char *)*j - pagetochar(p));
625
tm=tm_of((enum type) type_map[p]);
628
((pageoffset=((char *)*j - pagetochar(p))) %
630
if ((pageoffset < (tm->tm_size * tm->tm_nppage))
631
&& (m=x->d.m) != FREE) {
632
if (m==TRUE) continue;
635
"**bad value %ld of d.m in gbc page %ld skipping mark**"
636
,m,p);fflush(stdout);
646
sgc_mark_phase(void) {
649
STATIC struct package *pp;
651
STATIC frame_ptr frp;
654
sgc_mark_object(Cnil);
657
/* mark all non recent data on writable pages */
659
long t,i=page(heap_end);
660
struct typemanager *tm;
664
if (WRITABLE_PAGE_P(i)
665
&& (t=type_map[i]) < (int) t_end)
672
for (j = tm->tm_nppage; --j >= 0; p += tm_table[t_cons].tm_size/* sizeof(struct cons) */) {
673
object x = (object) p;
676
if (x->d.t==t_cons) {
683
int size=tm->tm_size;
684
for (j = tm->tm_nppage; --j >= 0; p += size) {
685
object x = (object) p;
686
if (SGC_OR_M(x)) continue;
693
sgc_mark_stack_carefully(vs_top-1,vs_org,0);
694
clear_stack(vs_top,vs_limit);
695
sgc_mark_stack_carefully(MVloc+(sizeof(MVloc)/sizeof(object)),MVloc,0);
697
for (p = vs_org; p < vs_top; p++) {
698
if (p && (inheap(*p)))
704
printf("value stack marked\n");
709
for (bdp = bds_org; bdp<=bds_top; bdp++) {
710
sgc_mark_object(bdp->bds_sym);
711
sgc_mark_object(bdp->bds_val);
714
for (frp = frs_org; frp <= frs_top; frp++)
715
sgc_mark_object(frp->frs_val);
717
for (ihsp = ihs_org; ihsp <= ihs_top; ihsp++)
718
sgc_mark_object(ihsp->ihs_function);
720
for (i = 0; i < mark_origin_max; i++)
721
sgc_mark_object(*mark_origin[i]);
722
for (i = 0; i < mark_origin_block_max; i++)
723
for (j = 0; j < mark_origin_block[i].mob_size; j++)
724
sgc_mark_object(mark_origin_block[i].mob_addr[j]);
726
for (pp = pack_pointer; pp != NULL; pp = pp->p_link)
727
sgc_mark_object((object)pp);
729
if (ovm_process_created)
730
sgc_mark_all_stacks();
735
printf("symbol navigation\n");
742
for (pp = pack_pointer; pp != NULL; pp = pp->p_link) {
743
size = pp->p_internal_size;
744
if (pp->p_internal != NULL)
745
for (i = 0; i < size; i++)
746
sgc_mark_pack_list(pp->p_internal[i]);
747
size = pp->p_external_size;
748
if (pp->p_external != NULL)
749
for (i = 0; i < size; i++)
750
sgc_mark_pack_list(pp->p_external[i]);
754
mark_c_stack(0,N_RECURSION_REQD,sgc_mark_stack_carefully);
759
sgc_sweep_phase(void) {
763
STATIC struct typemanager *tm;
772
printf("type map\n");
774
for (i = 0; i < maxpage; i++) {
775
if (type_map[i] == (int)t_contiguous) {
784
if (type_map[i] >= (int)t_end)
787
tm = tm_of((enum type)type_map[i]);
795
printf("%c", tm->tm_name[0]);
801
if (!WRITABLE_PAGE_P(i))
808
for (j = tm->tm_nppage; --j >= 0; p += size) {
817
if(x->d.s == SGC_NORMAL)
820
/* it is ok to free x */
823
/* old_displace: from might be free, to not */
824
if(x->d.t >=t_array && x->d.t <= t_bitvector) {
830
if (x->a.a_displaced->c.c_car != Cnil) {
832
/* The cons x->a.a_displaced cons has been saved,
833
so as to save the pointer to x->a.a_displaced->c.c_car;
834
However any arrays in its cdr, must have been
835
freed, or we would not be freeing x. To avoid
836
having a cons with trash in the cdr we set the
839
x->a.a_displaced->c.c_cdr = Cnil;
842
#endif /* OLD_DISPLACE */
843
#ifdef GMP_USE_MALLOC
844
if (x->d.t == t_bignum)
850
x->d.s = (int)SGC_RECENT;
857
else /*non sgc_page */
858
for (j = tm->tm_nppage; --j >= 0; p += size) {
860
if (x->d.m == TRUE) x->d.m=FALSE;
874
sgc_contblock_sweep_phase(void) {
877
STATIC char *s, *e, *p, *q;
878
STATIC struct contblock *cbp;
882
for (i = 0; i < maxpage;) {
883
if (type_map[i] != (int)t_contiguous
889
j < maxpage && type_map[j] == (int)t_contiguous
894
for (p = s; p < e;) {
895
if (get_mark_bit((int *)p)) {
896
/* SGC cont pages: cont blocks must be no smaller than
897
sizeof(struct contblock), and must not have a sweep
898
granularity greater than this amount (e.g. CPTR_ALIGN) if
899
contblock leaks are to be avoided. Used to be aligned at
900
PTR_ALIGN. CM 20030827 */
906
if (!get_mark_bit((int *)q)) {
912
insert_contblock(p, q - p);
919
for (cbp = cb_pointer; cbp != NULL; cbp = cbp->cb_link)
920
printf("%d-byte contblock\n", cbp->cb_size);
928
#define PAGE_ROUND_UP(adr) \
929
((char *)(PAGESIZE*(((long)(adr)+PAGESIZE -1) >> PAGEWIDTH)))
936
sgc_count(object yy) {
942
printf("[length %x = %d]",yy,count);
947
/* count writable pages excluding the hole */
949
sgc_count_writable(int end) {
951
unsigned long j = first_protectable_page -1;
952
unsigned long count = 0;
953
unsigned long hp_end= page(heap_end)-1;
955
if (WRITABLE_PAGE_P(j)) count++;
958
if (WRITABLE_PAGE_P(j)) count++;
964
sgc_count_type(int t) {
966
unsigned long j = first_protectable_page -1;
967
unsigned long end = page(core_end)-1;
968
unsigned long count=0;
969
/* FIXME ensure core_end in range for type_map reference below. CM*/
971
if (type_map[j]==t && SGC_PAGE_P(j))
977
sgc_count_read_only_type(int t) {
979
unsigned long j = first_protectable_page -1;
980
unsigned long hp_end = page(heap_end)-1;
981
unsigned long end = page(rb_limit)-1;
982
unsigned long count=0;
984
if ((type_map[j]==t || (t<0 && type_map[j]!=t_other)) && !WRITABLE_PAGE_P(j))
987
while(j++ < end) /* FIXME: relocatable pages are marked as type t_other */
988
if ((t==t_relocatable || t<0) && !WRITABLE_PAGE_P(j))
993
#ifdef SGC_CONT_DEBUG
995
overlap_check(struct contblock *t1,struct contblock *t2) {
999
for (;t1;t1=t1->cb_link) {
1002
fprintf(stderr,"%p not in heap\n",t1);
1006
for (p=t2;p;p=p->cb_link) {
1009
fprintf(stderr,"%p not in heap\n",t1);
1013
if ((p<=t1 && (void *)p+p->cb_size>(void *)t1) ||
1014
(t1<=p && (void *)t1+t1->cb_size>(void *)p)) {
1015
fprintf(stderr,"Overlap %u %p %u %p\n",t1->cb_size,t1,p->cb_size,p);
1019
if (p==p->cb_link) {
1020
fprintf(stderr,"circle detected at %p\n",p);
1026
if (t1==t1->cb_link) {
1027
fprintf(stderr,"circle detected at %p\n",t1);
1036
tcc(struct contblock *t) {
1038
for (;t;t=t->cb_link) {
1041
fprintf(stderr,"%p not in heap\n",t);
1045
fprintf(stderr,"%u at %p\n",t->cb_size,t);
1047
if (t==t->cb_link) {
1048
fprintf(stderr,"circle detected at %p\n",t);
1058
typedef enum {memprotect_none,memprotect_cannot_protect,memprotect_sigaction,
1059
memprotect_bad_return,memprotect_no_signal,
1060
memprotect_multiple_invocations,memprotect_no_restart,
1061
memprotect_bad_fault_address,memprotect_success} memprotect_enum;
1062
static memprotect_enum memprotect_result;
1063
static int memprotect_handler_invocations,memprotect_print_enable;
1064
static void *memprotect_test_address;
1066
#define MEM_ERR_CASE(a_) \
1068
fprintf(stderr,"The SGC segfault recovery test failed with %s, SGC disabled\n",#a_); \
1072
memprotect_print(void) {
1074
if (!memprotect_print_enable)
1077
switch(memprotect_result) {
1078
case memprotect_none: case memprotect_success:
1081
MEM_ERR_CASE(memprotect_cannot_protect);
1082
MEM_ERR_CASE(memprotect_sigaction);
1083
MEM_ERR_CASE(memprotect_bad_return);
1084
MEM_ERR_CASE(memprotect_no_signal);
1085
MEM_ERR_CASE(memprotect_no_restart);
1086
MEM_ERR_CASE(memprotect_bad_fault_address);
1087
MEM_ERR_CASE(memprotect_multiple_invocations);
1095
memprotect_handler_test(int sig, long code, void *scp, char *addr) {
1098
faddr=GET_FAULT_ADDR(sig,code,scp,addr);
1100
if (memprotect_handler_invocations) {
1101
memprotect_result=memprotect_multiple_invocations;
1104
memprotect_handler_invocations=1;
1105
if (faddr!=memprotect_test_address)
1106
memprotect_result=memprotect_bad_fault_address;
1108
memprotect_result=memprotect_none;
1109
mprotect(memprotect_test_address,PAGESIZE,PROT_READ_WRITE_EXEC);
1114
memprotect_test(void) {
1116
char b1[2*PAGESIZE],b2[PAGESIZE];
1117
struct sigaction sa,sao,saob;
1119
if (memprotect_result!=memprotect_none)
1120
return memprotect_result!=memprotect_success;
1121
if (atexit(memprotect_print)) {
1122
fprintf(stderr,"Cannot setup memprotect_print on exit\n");
1126
memset(b1,32,sizeof(b1));
1127
memset(b2,0,sizeof(b2));
1128
memprotect_test_address=(void *)(((unsigned long)b1+PAGESIZE-1) & ~(PAGESIZE-1));
1129
if (mprotect(memprotect_test_address,PAGESIZE,PROT_READ_EXEC)) {
1130
memprotect_result=memprotect_cannot_protect;
1133
sa.sa_sigaction=(void *)memprotect_handler_test;
1134
sa.sa_flags=MPROTECT_ACTION_FLAGS;
1135
if (sigaction(SIGSEGV,&sa,&sao)) {
1136
memprotect_result=memprotect_sigaction;
1139
if (sigaction(SIGBUS,&sa,&saob)) {
1140
sigaction(SIGSEGV,&sao,NULL);
1141
memprotect_result=memprotect_sigaction;
1144
memprotect_result=memprotect_bad_return;
1145
memset(memprotect_test_address,0,PAGESIZE);
1146
if (memprotect_result==memprotect_bad_return)
1147
memprotect_result=memprotect_no_signal;
1148
if (memprotect_result!=memprotect_none) {
1149
sigaction(SIGSEGV,&sao,NULL);
1150
sigaction(SIGBUS,&saob,NULL);
1153
if (memcmp(memprotect_test_address,b2,PAGESIZE)) {
1154
memprotect_result=memprotect_no_restart;
1155
sigaction(SIGSEGV,&sao,NULL);
1156
sigaction(SIGBUS,&saob,NULL);
1159
memprotect_result=memprotect_success;
1160
sigaction(SIGSEGV,&sao,NULL);
1161
sigaction(SIGBUS,&saob,NULL);
1167
do_memprotect_test(void) {
1171
memprotect_print_enable=1;
1172
if (memprotect_test()) {
1178
memprotect_print_enable=0;
1184
memprotect_test_reset(void) {
1186
memprotect_result=memprotect_none;
1187
memprotect_handler_invocations=0;
1188
memprotect_test_address=NULL;
1191
do_memprotect_test();
1200
unsigned short free_map[MAXPAGE];
1202
struct typemanager *tm;
1206
if (memprotect_result!=memprotect_success && do_memprotect_test())
1209
npp=page((&sgc_type_map[0]));
1210
if (npp<MAXPAGE && sgc_type_map[npp] != SGC_PERM_WRITABLE)
1211
perm_writable(&sgc_type_map[0],sizeof(sgc_type_map));
1215
/* FIXME ensure core_end in range for type_map reference below. CM*/
1216
i=npages=page(core_end);
1218
sgc_type_map[i] = sgc_type_map[i] & SGC_PERM_WRITABLE ;
1220
for (i= t_start; i < t_contiguous ; i++)
1221
if (TM_BASE_TYPE_P(i) && (np=(tm=tm_of(i))->tm_sgc))
1224
unsigned long maxp=0;
1226
/* SGC cont pages: This used to be simply set to tm_sgc_minfree,
1227
which is a definite bug, as minfree could then be zero,
1228
leading this type to claim SGC pages not of its type as
1229
specified in type_map. CM 20030827*/
1230
unsigned short minfree = tm->tm_sgc_minfree > 0 ? tm->tm_sgc_minfree : 1 ;
1231
unsigned long count;
1232
bzero(free_map,npages*sizeof(short));
1238
error("Address in tm freelist out of range");
1239
/* protect against overflow */
1240
free_map[j]=free_map[j]<minfree ? free_map[j]+1 : free_map[j];
1241
if (j>=maxp) maxp=j;
1248
if (count!=tm->tm_nfree)
1249
printf("[Count differed type(%d)nfree= %ld in freelist %ld]\n"
1250
,tm->tm_type,tm->tm_nfree,
1251
count);fflush(stdout);
1253
for(j=0,count=0; j <= maxp ;j++) {
1254
if (free_map[j] >= minfree) {
1255
sgc_type_map[j] |= (SGC_PAGE_FLAG | SGC_TEMP_WRITABLE);
1257
if (count >= tm->tm_sgc_max)
1262
/* don't do any more allocations for this type if saving system */
1266
if (count < tm->tm_sgc) {
1267
/* try to get some more free pages of type i */
1268
long n = tm->tm_sgc - count;
1269
long again=0,nfree = tm->tm_nfree;
1270
char *p=alloc_page(n);
1271
if (tm->tm_nfree > nfree) again=1; /* gc freed some objects */
1273
(sgc_enabled=1,add_page_to_freelist(p,tm),sgc_enabled=0);
1277
goto FIND_FREE_PAGES;
1281
/* SGC cont pages: Here we implement the contblock page division into
1282
SGC and non-SGC types. Unlike the other types, we need *whole*
1283
free pages for contblock SGC, as there is no psersistent data
1284
element (e.g. .m) on an allocated block itself which can indicate
1285
its live status. If anything on a page which is to be marked
1286
read-only points to a live object on an SGC cont page, it will
1287
never be marked and will be erroneously swept. It is also possible
1288
for dead objects to unnecessarily mark dead regions on SGC pages
1289
and delay sweeping until the pointing type is GC'ed if SGC is
1290
turned off for the pointing type, e.g. tm_sgc=0. (This was so by
1291
default for a number of types, including bignums, and has now been
1292
corrected in gcl_init_alloc in alloc.c.) We can't get around this
1293
AFAICT, as old data on (writable) SGC pages must be marked lest it
1294
is lost, and (old) data on now writable non-SGC pages might point
1295
to live regions on SGC pages, yet might not themselves be reachable
1296
from the mark origin through an unbroken chain of writable pages.
1297
In any case, the possibility of a lot of garbage marks on contblock
1298
pages, especially when the blocks are small as in bignums, makes
1299
necessary the sweeping of minimal contblocks to prevent leaks. CM
1304
unsigned long i,j,k,count;
1305
struct contblock *new_cb_pointer=NULL,*tmp_cb_pointer=NULL,**cbpp;
1307
tm=tm_of(t_contiguous);
1309
/* SGC cont pages: First count whole free pages available. CM 20030827 */
1310
for (cbpp=&cb_pointer,count=0;*cbpp;cbpp=&(*cbpp)->cb_link) {
1311
p=PAGE_ROUND_UP((void *)(*cbpp));
1312
k=p-((void *)(*cbpp));
1313
if ((*cbpp)->cb_size<k || (*cbpp)->cb_size-k<PAGESIZE)
1315
i=((*cbpp)->cb_size-k)/PAGESIZE;
1318
count=tm->tm_sgc>count ? tm->tm_sgc - count : 0;
1321
/* SGC cont pages: allocate more if necessary, dumping possible
1322
GBC freed pages onto the old contblock list. CM 20030827*/
1323
unsigned long z=count+1;
1324
void *p1=alloc_contblock(z*PAGESIZE);
1325
p=PAGE_ROUND_UP(p1);
1328
insert_contblock(p1,p-p1);
1329
insert_contblock(p+z*PAGESIZE,PAGESIZE-(p-p1));
1331
tmp_cb_pointer=cb_pointer;
1332
cb_pointer=new_cb_pointer;
1333
/* SGC cont pages: add new pages to new contblock list. p is not
1334
already on any list as ensured by alloc_contblock. CM
1336
insert_contblock(p,PAGESIZE*z);
1337
new_cb_pointer=cb_pointer;
1338
cb_pointer=tmp_cb_pointer;
1342
if (i>=MAXPAGE || k>MAXPAGE)
1343
error("Pages out of range in sgc_start");
1345
sgc_type_map[i]|= SGC_PAGE_FLAG;
1348
for (cbpp=&cb_pointer;*cbpp;) {
1349
p=PAGE_ROUND_UP((void *)(*cbpp));
1350
k=p-((void *)(*cbpp));
1351
if ((*cbpp)->cb_size<k || (*cbpp)->cb_size-k<PAGESIZE) {
1352
cbpp=&(*cbpp)->cb_link;
1355
i=((*cbpp)->cb_size-k)/PAGESIZE;
1357
j=(*cbpp)->cb_size-i-k;
1358
/* SGC contblock pages: remove this block from old list CM 20030827 */
1359
*cbpp=(*cbpp)->cb_link;
1360
/* SGC contblock pages: add fragments old list CM 20030827 */
1363
insert_contblock(p-k,k);
1367
insert_contblock(p+i,j);
1369
tmp_cb_pointer=cb_pointer;
1370
cb_pointer=new_cb_pointer;
1371
/* SGC contblock pages: add whole pages to new list, p p-k, and
1372
p+i are guaranteed to be distinct when used. CM 20030827 */
1373
insert_contblock(p,i);
1374
new_cb_pointer=cb_pointer;
1375
cb_pointer=tmp_cb_pointer;
1379
if (j>=MAXPAGE || i>MAXPAGE)
1380
error("Pages out of range in sgc_start");
1382
sgc_type_map[j]|= SGC_PAGE_FLAG;
1385
/* SGC contblock pages: switch to new free SGC contblock list. CM
1387
old_cb_pointer=cb_pointer;
1388
cb_pointer=new_cb_pointer;
1390
#ifdef SGC_CONT_DEBUG
1391
overlap_check(old_cb_pointer,cb_pointer);
1396
/* Now allocate the sgc relblock. We do this as the tail
1397
end of the ordinary rb. */
1400
tm=tm_of(t_relocatable);
1403
old_rb_start=rb_start;
1404
if(!saving_system) {
1405
new=alloc_relblock(((unsigned long)tm->tm_sgc)*PAGESIZE);
1406
/* the above may cause a gc, shifting the relblock */
1407
old_rb_start=rb_start;
1408
new= PAGE_ROUND_UP(new);
1409
rb_start=rb_pointer=new;
1413
/* the relblock has been allocated */
1415
/* now move the sgc free lists into place. alt_free should
1416
contain the others */
1418
for (i= t_start; i < t_contiguous ; i++)
1419
if (TM_BASE_TYPE_P(i)
1420
&& (np=(tm=tm_of(i))->tm_sgc)) {
1421
object f=tm->tm_free ,x,y,next;
1429
printf("Not FREE in freelist f=%d",f);
1431
if (ON_SGC_PAGE(f)) {
1433
f->d.s = SGC_RECENT;
1438
f->d.s = SGC_NORMAL;
1444
tm->tm_alt_free = y;
1445
tm->tm_alt_nfree = tm->tm_nfree - count;
1449
/* Whew. We have now allocated the sgc space
1450
and modified the tm_table;
1451
Turn memory protection on for the pages which are writable.
1455
if (sSAnotify_gbcA->s.s_dbind != Cnil) {
1467
struct typemanager *tm;
1471
if(sSAnotify_gbcA->s.s_dbind != Cnil)
1472
printf("[SGC off]"); fflush(stdout);
1476
rb_start = old_rb_start;
1478
/* SGC cont pages: restore contblocks, each tmp_cb_pointer coming
1479
from the new list is guaranteed not to be on the old. Need to
1480
grab 'next' before insert_contblock writes is. CM 20030827 */
1483
struct contblock *tmp_cb_pointer,*next;
1484
if (old_cb_pointer) {
1485
#ifdef SGC_CONT_DEBUG
1486
overlap_check(old_cb_pointer,cb_pointer);
1488
tmp_cb_pointer=cb_pointer;
1489
cb_pointer=old_cb_pointer;
1490
for (;tmp_cb_pointer; tmp_cb_pointer=next) {
1491
next=tmp_cb_pointer->cb_link;
1492
insert_contblock((void *)tmp_cb_pointer,tmp_cb_pointer->cb_size);
1497
for (i= t_start; i < t_contiguous ; i++)
1498
if (TM_BASE_TYPE_P(i)) {
1500
if ((np=tm->tm_sgc)) {
1504
tm->tm_free=tm->tm_alt_free;
1506
/* tack the alt_free onto the end of free */
1510
while(y= (object) F_LINK(f)) {
1511
if(y->d.s != SGC_RECENT)
1512
printf("[bad %d]",y);
1517
if (f=tm->tm_alt_free)
1518
while(y= F_LINK(f)) {
1519
if(y->d.s != SGC_NORMAL)
1520
printf("[alt_bad %d]",y);
1526
while((y= (object) F_LINK(f)))
1528
F_LINK(f)= (long)(tm->tm_alt_free);
1530
/* tm->tm_free has all of the free objects */
1531
tm->tm_nfree += tm->tm_alt_nfree;
1532
tm->tm_alt_nfree = 0;
1533
tm->tm_alt_free = 0;
1535
/* remove the recent flag from any objects on sgc pages */
1537
unsigned long hp=page(heap_end);
1539
char t = (char) tm->tm_type;
1541
for (i=0 ; i < hp; i++)
1542
if (type_map[i]==t && (sgc_type_map[i] & SGC_PAGE_FLAG))
1543
for (p= pagetochar(i),j = tm->tm_nppage;
1544
j > 0; --j, p += tm->tm_size)
1545
((object) p)->d.s = SGC_NORMAL;
1555
make_writable(unsigned long beg, unsigned long i) {
1558
beg=ROUND_DOWN_PAGE_NO(beg);
1559
i=ROUND_UP_PAGE_NO(i);
1561
unsigned long k=beg;
1562
if (k>=MAXPAGE || i>MAXPAGE)
1563
error("Pages out of range in make_writable");
1565
sgc_type_map[k++] |= SGC_TEMP_WRITABLE;
1567
sgc_mprotect(beg, i-beg, SGC_WRITABLE);
1571
long debug_fault =0;
1575
memprotect_handler(int sig, long code, void *scp, char *addr) {
1578
int j=page_multiple;
1579
char *faddr; /* Needed because we must not modify signal handler
1580
arguments on the stack! */
1581
#ifdef GET_FAULT_ADDR
1582
faddr=GET_FAULT_ADDR(sig,code,scp,addr);
1583
debug_fault = (long) faddr;
1584
#ifdef DEBUG_MPROTECT
1585
printf("fault:0x%x [%d] (%d) ",faddr,page(faddr),faddr >= core_end);
1587
if (faddr >= core_end || (unsigned long)faddr < DBEGIN) {
1588
if (fault_count > 300) error("fault count too high");
1590
INSTALL_MPROTECT_HANDLER;
1597
p = ROUND_DOWN_PAGE_NO(p);
1598
if (p >= first_protectable_page
1600
&& !(WRITABLE_PAGE_P(p))) {
1601
/* CHECK_RANGE(p,1); */
1602
#ifdef DEBUG_MPROTECT
1603
printf("mprotect(0x%x,0x%x,0x%x)\n",
1604
pagetochar(p),page_multiple * PAGESIZE, sbrk(0));
1607
mprotect(pagetochar(p),page_multiple * PAGESIZE, PROT_READ_WRITE_EXEC);
1608
if (p>=MAXPAGE || p+j>MAXPAGE)
1609
error("Pages out of range in memprotect_handler");
1611
sgc_type_map[p+j] = sgc_type_map[p+j] | SGC_TEMP_WRITABLE;
1614
INSTALL_MPROTECT_HANDLER;
1621
INSTALL_MPROTECT_HANDLER;
1624
segmentation_catcher(0);
1629
sgc_mprotect(long pbeg, long n, int writable) {
1630
/* CHECK_RANGE(pbeg,n); */
1631
#ifdef DEBUG_MPROTECT
1632
printf("prot[%d,%d,(%d),%s]\n",pbeg,pbeg+n,writable & SGC_WRITABLE,
1633
(writable & SGC_WRITABLE ? "writable" : "not writable"));
1634
printf("mprotect(0x%x,0x%x), sbrk(0)=0x%x\n",
1635
pagetochar(pbeg), n * PAGESIZE, sbrk(0));
1638
if(mprotect(pagetochar(pbeg),n*PAGESIZE,
1639
(writable & SGC_WRITABLE ? PROT_READ_WRITE_EXEC : PROT_READ_EXEC)))
1640
FEerror("Couldn't protect",0);
1644
/* for page numbers from beg below end,
1645
if one page in a a page_multiple grouping is writable,the
1649
fix_for_page_multiple(unsigned long beg, unsigned long end) {
1655
beg = ROUND_DOWN_PAGE_NO(beg);
1656
for (i = beg ; i < end; i = i+ page_multiple){
1657
p = sgc_type_map + i;
1659
writable = ((*p++) & SGC_WRITABLE);
1661
/* all pages must be */
1663
if (((*p++) & SGC_WRITABLE) == 0)
1667
if ((*p++) & SGC_WRITABLE )
1672
p = sgc_type_map + i;
1674
(*p++) |= SGC_WRITABLE;
1680
memory_protect(int on) {
1682
unsigned long i,beg,end= page(core_end);
1684
extern void install_segmentation_catcher(void);
1686
if (first_protectable_page==0) {
1687
for (i=page_multiple; i< maxpage ; i++)
1688
if (type_map[i]!=t_other)
1691
/* We want page(0) to be non writable since that
1692
is the only check for 0 pointer in sgc */
1693
sgc_type_map[i] = SGC_PERM_WRITABLE;
1695
first_protectable_page= ROUND_DOWN_PAGE_NO(i);
1697
if(page_multiple > 1)
1698
fix_for_page_multiple(first_protectable_page,end);
1699
/* turning it off */
1700
if (on==0) {sgc_mprotect((first_protectable_page),
1701
(end - first_protectable_page), SGC_WRITABLE);
1702
install_segmentation_catcher();
1705
/* write protect some pages by first write protecting them
1706
all and then selectively disabling */
1707
/* sgc_mprotect((first_protectable_page),
1708
(end - first_protectable_page), 0);
1710
INSTALL_MPROTECT_HANDLER;
1711
beg=first_protectable_page;
1712
writable = WRITABLE_PAGE_P(beg);
1713
for (i=beg ; ++i<= end; ) {
1714
int wri = WRITABLE_PAGE_P(i);
1715
if ((wri==0 && writable)
1716
|| (writable ==0 && wri)
1718
/* it is changing */
1720
make_writable(beg,i);
1722
sgc_mprotect(beg,i-beg,writable);
1730
FFN(siLsgc_on)(void) {
1732
if (vs_base==vs_top) {
1733
vs_base[0]=(sgc_enabled ? Ct :Cnil);
1734
vs_top=vs_base+1; return;
1737
if(vs_base[0]==Cnil)
1740
vs_base[0]=sgc_start() ? Ct : Cnil;
1743
/* make permanently writable pages containing pointers p thru p+n-1 */
1746
perm_writable(char *p, long n) {
1748
unsigned long beg=page(p);
1749
unsigned long end=page(PAGE_ROUND_UP(p+n));
1750
unsigned long i,must_protect=0;
1752
beg = ROUND_DOWN_PAGE_NO(beg);
1753
end = ROUND_UP_PAGE_NO(end);
1754
if (beg >= MAXPAGE || end >MAXPAGE)
1755
error("Address supplied to perm_writable out of range");
1756
for (i=beg ; i < end ; i++) {
1757
if (sgc_enabled & !(WRITABLE_PAGE_P(i)))
1759
sgc_type_map [i] |= SGC_PERM_WRITABLE;
1762
make_writable(beg,end);
1766
system_error(void) {
1767
FEerror("System error",0);
added
removed
o/sgbc.c
