2
Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa
4
This file is part of GNU Common Lisp, herein referred to as GCL
6
GCL is free software; you can redistribute it and/or modify it under
7
the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by
8
the Free Software Foundation; either version 2, or (at your option)
11
GCL is distributed in the hope that it will be useful, but WITHOUT
12
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public
14
License for more details.
16
You should have received a copy of the GNU Library General Public License
17
along with GCL; see the file COPYING. If not, write to the Free Software
18
Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
24
IMPLEMENTATION-DEPENDENT
39
sgc_contblock_sweep_phase(void);
42
sgc_sweep_phase(void);
48
sgc_count_writable(int);
53
mark_c_stack(jmp_buf, int, void (*)(void *,void *,int));
56
mark_contblock(void *, int);
62
/* the following in line definitions seem to be twice as fast (at
63
least on mc68020) as going to the assembly function calls in bitop.c so
64
since this is more portable and faster lets use them --W. Schelter
65
These assume that DBEGIN is divisible by 32, or else we should have
66
#define Shamt(x) (((((int) x -DBEGIN) >> 2) & ~(~0 << 5)))
72
#elif SIZEOF_LONG == 8
75
#error Do not recognize SIZEOF_LONG
79
#define BBYTES_CONTBLOCK 3
80
#elif CPTR_ALIGN == 16
81
#define BBYTES_CONTBLOCK 4
83
#error Do not recognize CPTR_ALIGN
86
#define BBITS_LONG (BBYTES_LONG+BBITS_CHAR)
87
#define BCHARS_TABLE (BBITS_LONG+BBYTES_CONTBLOCK)
89
#define Shamt(x) (((((unsigned long) x) >> BBYTES_CONTBLOCK) & ~(~0 << BBITS_LONG)))
90
#define Madr(x) (mark_table+((((unsigned long) x) - ((unsigned long)DBEGIN)) >> (BCHARS_TABLE)))
91
#define get_mark_bit(x) (*(Madr(x)) >> Shamt(x) & 1)
92
#define set_mark_bit(x) ((*(Madr(x))) |= ((unsigned long)1 << Shamt(x)))
94
/* #define Shamt(x) (((((long) x) >> 3) & ~(~0 << 6))) */
95
/* #define Madr(x) (mark_table+((((long) x) - ((long)DBEGIN)) >> (9))) */
96
/* #define get_mark_bit(x) (*(Madr(x)) >> Shamt(x) & 1) */
97
/* #define set_mark_bit(x) ((*(Madr(x))) |= ((unsigned long)1 << Shamt(x))) */
100
void mark_all_stacks();
101
bool ovm_process_created;
105
static int gc_time = -1;
106
static int gc_start = 0;
107
static int gc_recursive = 0;
111
long first_protectable_page = 0;
115
static char *copy_relblock(char *p, int s);
117
extern bool saving_system;
118
extern long real_maxpage;
119
extern long new_holepage;
121
#define available_pages \
122
(real_maxpage-page(heap_end)-(new_holepage>=holepage ? new_holepage : holepage)-2*nrbpage-real_maxpage/32)
125
char apage_self[PAGESIZE];
130
object sSAnotify_gbcA;
134
object sSAgbc_messageA;
137
#define MARK_ORIGIN_MAX 300
138
#define MARK_ORIGIN_BLOCK_MAX 20
162
#define symbol_marked(x) ((x)->d.m)
164
object *mark_origin[MARK_ORIGIN_MAX];
168
object *mob_addr; /* mark origin block address */
169
int mob_size; /* mark origin block size */
170
} mark_origin_block[MARK_ORIGIN_BLOCK_MAX];
171
int mark_origin_block_max;
173
/* must be a long * to match with SIZEOF_LONG usage above*/
176
enum type what_to_collect;
181
enter_mark_origin(object *p)
183
unsigned long np=page(p);
184
/* if (np>=MAXPAGE) */
185
/* error("Address supplied to enter_mar_origin out of range"); */
186
if (mark_origin_max >= MARK_ORIGIN_MAX)
187
error("too many mark origins");
190
sgc_type_map[np] |= SGC_PERM_WRITABLE ;
192
mark_origin[mark_origin_max++] = p;
196
/* enter_mark_origin_block(object *p, int n) { */
197
/* if (mark_origin_block_max >= MARK_ORIGIN_BLOCK_MAX) */
198
/* error("too many mark origin blocks"); */
199
/* mark_origin_block[mark_origin_block_max].mob_addr = p; */
200
/* mark_origin_block[mark_origin_block_max++].mob_size = n; */
204
mark_cons(object x) {
208
/* x is already marked. */
211
if (NULL_OR_ON_C_STACK(x->c.c_car)) goto MARK_CDR;
212
if (type_of(x->c.c_car) == t_cons) {
216
x->c.c_car->c.m = TRUE;
217
mark_cons(x->c.c_car);
220
mark_object(x->c.c_car);
223
if (NULL_OR_ON_C_STACK(x))
225
if (type_of(x) == t_cons) {
236
/* Whenever two arrays are linked together by displacement,
237
if one is live, the other will be made live */
238
#define mark_displaced_field(ar) mark_object(ar->a.a_displaced)
241
mark_object(object x) {
250
/* if the body of x is in the c stack, its elements
251
are marked anyway by the c stack mark carefully, and
252
if this x is somehow hanging around in a cons that
253
should be dead, we dont want to mark it. -wfs
256
if (NULL_OR_ON_C_STACK(x))
261
switch (type_of(x)) {
266
mark_object(x->rat.rat_num);
277
mark_object(x->cmp.cmp_imag);
285
mark_object(x->s.s_plist);
286
mark_object(x->s.s_gfdef);
287
mark_object(x->s.s_dbind);
288
if (x->s.s_self == NULL)
290
if ((int)what_to_collect >= (int)t_contiguous) {
291
if (inheap(x->s.s_self)) {
292
if (what_to_collect == t_contiguous)
293
mark_contblock(x->s.s_self,
297
copy_relblock(x->s.s_self, x->s.s_fillp);
302
mark_object(x->p.p_name);
303
mark_object(x->p.p_nicknames);
304
mark_object(x->p.p_shadowings);
305
mark_object(x->p.p_uselist);
306
mark_object(x->p.p_usedbylist);
307
if (what_to_collect != t_contiguous)
309
if (x->p.p_internal != NULL)
310
mark_contblock((char *)(x->p.p_internal),
311
x->p.p_internal_size*sizeof(object));
312
if (x->p.p_external != NULL)
313
mark_contblock((char *)(x->p.p_external),
314
x->p.p_external_size*sizeof(object));
319
mark_object(x->c.c_car);
327
mark_object(x->ht.ht_rhsize);
328
mark_object(x->ht.ht_rhthresh);
329
if (x->ht.ht_self == NULL)
331
for (i = 0, j = x->ht.ht_size; i < j; i++) {
332
mark_object(x->ht.ht_self[i].hte_key);
333
mark_object(x->ht.ht_self[i].hte_value);
335
if ((short)what_to_collect >= (short)t_contiguous) {
336
if (inheap(x->ht.ht_self)) {
337
if (what_to_collect == t_contiguous)
338
mark_contblock((char *)(x->ht.ht_self),
339
j * sizeof(struct htent));
341
x->ht.ht_self = (struct htent *)
342
copy_relblock((char *)(x->ht.ht_self),
343
j * sizeof(struct htent));
348
if ((x->a.a_displaced) != Cnil)
349
mark_displaced_field(x);
350
if ((int)what_to_collect >= (int)t_contiguous &&
351
x->a.a_dims != NULL) {
352
if (inheap(x->a.a_dims)) {
353
if (what_to_collect == t_contiguous)
354
mark_contblock((char *)(x->a.a_dims),
355
sizeof(int)*x->a.a_rank);
357
x->a.a_dims = (int *)
358
copy_relblock((char *)(x->a.a_dims),
359
sizeof(int)*x->a.a_rank);
361
if ((enum aelttype)x->a.a_elttype == aet_ch)
363
if ((enum aelttype)x->a.a_elttype == aet_bit)
365
if ((enum aelttype)x->a.a_elttype == aet_object)
369
cp = (char *)(x->fixa.fixa_self);
372
/* set j to the size in char of the body of the array */
374
switch((enum aelttype)x->a.a_elttype){
375
#define ROUND_RB_POINTERS_DOUBLE \
376
{int tem = ((long)rb_pointer1) & (sizeof(double)-1); \
378
{ rb_pointer += (sizeof(double) - tem); \
379
rb_pointer1 += (sizeof(double) - tem); \
382
j= sizeof(longfloat)*x->lfa.lfa_dim;
383
if (((int)what_to_collect >= (int)t_contiguous) &&
384
!(inheap(cp))) ROUND_RB_POINTERS_DOUBLE;
388
j=sizeof(char)*x->a.a_dim;
392
j=sizeof(short)*x->a.a_dim;
395
j=sizeof(fixnum)*x->fixa.fixa_dim;}
403
|| (char *)p >= core_end
408
if (x->a.a_displaced->c.c_car == Cnil)
409
for (i = 0, j = x->a.a_dim; i < j; i++)
414
if ((int)what_to_collect >= (int)t_contiguous) {
416
if (what_to_collect == t_contiguous)
417
mark_contblock(cp, j);
418
} else if (x->a.a_displaced == Cnil) {
420
if (!NULL_OR_ON_C_STACK(cp)) /* only if body of array not on C stack */
422
x->a.a_self = (object *)copy_relblock(cp, j);}
423
else if (x->a.a_displaced->c.c_car == Cnil) {
424
i = (long)(object *)copy_relblock(cp, j)
425
- (long)(x->a.a_self);
426
adjust_displaced(x, i);
432
if ((x->v.v_displaced) != Cnil)
433
mark_displaced_field(x);
434
if ((enum aelttype)x->v.v_elttype == aet_object)
441
if (type_map[page(x->big.big_self)] < t_contiguous)
443
printf("bad body for %x (%x)\n",x,cp);
447
#ifndef GMP_USE_MALLOC
448
if ((int)what_to_collect >= (int)t_contiguous) {
450
cp = (char *)MP_SELF(x);
454
if (j != lg(MP(x)) &&
455
/* we don't bother to zero this register,
456
and its contents may get over written */
457
! (x == big_register_1 &&
460
printf("bad length 0x%x ",x);
462
j = j * MP_LIMB_SIZE;
464
if (what_to_collect == t_contiguous)
465
mark_contblock(cp, j);
467
MP_SELF(x) = (void *) copy_relblock(cp, j);}}
468
#endif /* not GMP_USE_MALLOC */
473
if ((x->st.st_displaced) != Cnil)
474
mark_displaced_field(x);
480
if ((int)what_to_collect >= (int)t_contiguous) {
482
if (what_to_collect == t_contiguous)
483
mark_contblock(cp, j);
484
} else if (x->st.st_displaced == Cnil)
485
x->st.st_self = copy_relblock(cp, j);
486
else if (x->st.st_displaced->c.c_car == Cnil) {
487
i = copy_relblock(cp, j) - cp;
488
adjust_displaced(x, i);
495
if ((x->bv.bv_displaced) != Cnil)
496
mark_displaced_field(x);
497
/* We make bitvectors multiple of sizeof(int) in size allocated
498
Assume 8 = number of bits in char */
500
#define W_SIZE (8*sizeof(int))
502
((BV_OFFSET(x) + x->bv.bv_dim + W_SIZE -1)/W_SIZE);
509
mark_object(x->str.str_def);
513
{object def=x->str.str_def;
514
unsigned char * s_type = &SLOT_TYPE(def,0);
515
unsigned short *s_pos= & SLOT_POS(def,0);
516
for (i = 0, j = S_DATA(def)->length; i < j; i++)
517
if (s_type[i]==0) mark_object(STREF(object,x,s_pos[i]));
518
if ((int)what_to_collect >= (int)t_contiguous) {
519
if (inheap(x->str.str_self)) {
520
if (what_to_collect == t_contiguous)
521
mark_contblock((char *)p,
525
x->str.str_self = (object *)
526
copy_relblock((char *)p, S_DATA(def)->size);
531
switch (x->sm.sm_mode) {
537
mark_object(x->sm.sm_object0);
538
mark_object(x->sm.sm_object1);
540
{FILE *fp = x->sm.sm_fp;
541
if (fp != 0 && fp != stdin && fp !=stdout
547
if (what_to_collect == t_contiguous &&
550
mark_contblock(x->sm.sm_buffer, BUFSIZ);
554
mark_object(x->sm.sm_object0);
558
case smm_concatenated:
559
mark_object(x->sm.sm_object0);
564
mark_object(x->sm.sm_object0);
565
mark_object(x->sm.sm_object1);
568
case smm_string_input:
569
case smm_string_output:
570
mark_object(x->sm.sm_object0);
572
#ifdef USER_DEFINED_STREAMS
573
case smm_user_defined:
574
mark_object(x->sm.sm_object0);
575
mark_object(x->sm.sm_object1);
579
error("mark stream botch");
587
if (x->rt.rt_self == NULL)
589
if (what_to_collect == t_contiguous)
590
mark_contblock((char *)(x->rt.rt_self),
591
RTABSIZE*sizeof(struct rtent));
592
for (i = 0; i < RTABSIZE; i++) {
593
mark_object(x->rt.rt_self[i].rte_macro);
594
if (x->rt.rt_self[i].rte_dtab != NULL) {
596
if (what_to_collect == t_contiguous)
597
mark_contblock((char *)(x->rt.rt_self[i].rte_dtab),
598
RTABSIZE*sizeof(object));
599
for (j = 0; j < RTABSIZE; j++)
600
mark_object(x->rt.rt_self[i].rte_dtab[j]);
607
mark_object(x->pn.pn_host);
608
mark_object(x->pn.pn_device);
609
mark_object(x->pn.pn_directory);
610
mark_object(x->pn.pn_name);
611
mark_object(x->pn.pn_type);
612
mark_object(x->pn.pn_version);
617
if (what_to_collect == t_contiguous)
618
mark_contblock(x->cc.cc_turbo,x->cc.cc_envdim);
619
for (i= 0 ; i < x->cc.cc_envdim ; i++) {
620
mark_object(x->cc.cc_turbo[i]);}}
627
mark_object(x->cf.cf_name);
628
mark_object(x->cf.cf_data);
633
if (x->cfd.cfd_self != NULL)
634
{int i=x->cfd.cfd_fillp;
636
mark_object(x->cfd.cfd_self[i]);}
637
if (x->cfd.cfd_start == NULL)
639
if (what_to_collect == t_contiguous) {
640
if (!MAYBE_DATA_P((x->cfd.cfd_start)) ||
641
get_mark_bit((long *)(x->cfd.cfd_start)))
643
mark_contblock(x->cfd.cfd_start, x->cfd.cfd_size);}
646
mark_object(x->cc.cc_name);
647
mark_object(x->cc.cc_env);
648
mark_object(x->cc.cc_data);
649
if (what_to_collect == t_contiguous) {
650
if (x->cc.cc_turbo != NULL)
651
mark_contblock((char *)(x->cc.cc_turbo-1),
652
(1+fix(*(x->cc.cc_turbo-1)))*sizeof(object));
661
printf("\ttype = %d\n", type_of(x));
667
static long *c_stack_where;
670
mark_stack_carefully(void *topv, void *bottomv, int offset) {
675
struct typemanager *tm;
677
long *top = (long *) topv, *bottom = (long *) bottomv;
679
/* if either of these happens we are marking the C stack
680
and need to use a local */
682
if (top==0) top = c_stack_where;
683
if (bottom==0) bottom= c_stack_where;
685
/* On machines which align local pointers on multiple of 2 rather
686
than 4 we need to mark twice
690
mark_stack_carefully ( (((char *) top) +offset), bottom, 0 );
692
for (j=top ; j >= bottom ; j--) {
693
if (VALID_DATA_ADDRESS_P(*j)
694
&& type_map[(p=page(*j))]< (char)t_end) {
695
pageoffset=((char *)*j - pagetochar(p));
696
tm=tm_of((enum type) type_map[p]);
699
((pageoffset=((char *)*j - pagetochar(p))) %
701
if ((pageoffset < (tm->tm_size * tm->tm_nppage))
702
&& (m=x->d.m) != FREE) {
703
if (m==TRUE) continue;
706
"**bad value %ld of d.m in gbc page %ld skipping mark**"
707
,m,p);fflush(stdout);
721
STATIC struct package *pp;
723
STATIC frame_ptr frp;
729
mark_stack_carefully(vs_top-1,vs_org,0);
730
clear_stack(vs_top,vs_limit);
731
mark_stack_carefully(MVloc+(sizeof(MVloc)/sizeof(object)),MVloc,0);
733
for (p = vs_org; p < vs_top; p++) {
734
if (p && (inheap(*p)))
740
printf("value stack marked\n");
745
for (bdp = bds_org; bdp<=bds_top; bdp++) {
746
mark_object(bdp->bds_sym);
747
mark_object(bdp->bds_val);
750
for (frp = frs_org; frp <= frs_top; frp++)
751
mark_object(frp->frs_val);
753
for (ihsp = ihs_org; ihsp <= ihs_top; ihsp++)
754
mark_object(ihsp->ihs_function);
756
for (i = 0; i < mark_origin_max; i++)
757
mark_object(*mark_origin[i]);
758
for (i = 0; i < mark_origin_block_max; i++)
759
for (j = 0; j < mark_origin_block[i].mob_size; j++)
760
mark_object(mark_origin_block[i].mob_addr[j]);
762
for (pp = pack_pointer; pp != NULL; pp = pp->p_link)
763
mark_object((object)pp);
765
if (ovm_process_created)
771
printf("symbol navigation\n");
777
if (what_to_collect != t_symbol &&
778
(int)what_to_collect < (int)t_contiguous) {
783
for (pp = pack_pointer; pp != NULL; pp = pp->p_link) {
784
size = pp->p_internal_size;
785
if (pp->p_internal != NULL)
786
for (i = 0; i < size; i++)
787
mark_object(pp->p_internal[i]);
788
size = pp->p_external_size;
789
if (pp->p_external != NULL)
790
for (i = 0; i < size; i++)
791
mark_object(pp->p_external[i]);
794
/* mark the c stack */
795
#ifndef N_RECURSION_REQD
796
#define N_RECURSION_REQD 2
798
mark_c_stack(0,N_RECURSION_REQD,mark_stack_carefully);
802
#if defined(__ia64__)
810
asm(" .global GC_save_regs_in_stack");
811
asm(" .proc GC_save_regs_in_stack");
812
asm("GC_save_regs_in_stack:");
816
asm(" mov r8=ar.bsp");
817
asm(" br.ret.sptk.few rp");
818
asm(" .endp GC_save_regs_in_stack");
820
void * GC_save_regs_in_stack();
823
#if defined(__hppa__) /* Courtesy of Lamont Jones */
824
/* the calling sequence */
826
void *callee_saves[16];
828
void hppa_save_regs(struct regs);
833
asm(".export hppa_save_regs, entry");
836
asm(".label hppa_save_regs");
839
asm("stw %r3,0(%arg0)");
840
asm("stw %r4,4(%arg0)");
841
asm("stw %r5,8(%arg0)");
842
asm("stw %r6,12(%arg0)");
843
asm("stw %r7,16(%arg0)");
844
asm("stw %r8,20(%arg0)");
845
asm("stw %r9,24(%arg0)");
846
asm("stw %r10,28(%arg0)");
847
asm("stw %r11,32(%arg0)");
848
asm("stw %r12,36(%arg0)");
849
asm("stw %r13,40(%arg0)");
850
asm("stw %r14,44(%arg0)");
851
asm("stw %r15,48(%arg0)");
852
asm("stw %r16,52(%arg0)");
853
asm("stw %r17,56(%arg0)");
855
asm("stw %r18,60(%arg0)");
863
mark_c_stack(jmp_buf env1, int n, void (*fn)(void *,void *,int)) {
865
#if defined(__hppa__)
866
struct regs hppa_regs;
870
if (n== N_RECURSION_REQD)
871
c_stack_where = (long *) (void *) &env;
873
#if defined(__hppa__)
874
hppa_save_regs(hppa_regs);
878
mark_c_stack(env,n - 1,fn);
881
/* If the locals of type object in a C function could be
882
aligned other than on multiples of sizeof (char *)
883
then define this. At the moment 2 is the only other
884
legitimate value besides 0 */
887
#define C_GC_OFFSET 0
890
(*fn)(0,cs_org,C_GC_OFFSET);
892
(*fn)(cs_org,0,C_GC_OFFSET);}
894
#if defined(__ia64__)
896
extern void * __libc_ia64_register_backing_store_base;
897
void * bst=GC_save_regs_in_stack();
898
void * bsb=__libc_ia64_register_backing_store_base;
901
(*fn)(bsb,bst,C_GC_OFFSET);
903
(*fn)(bst,bsb,C_GC_OFFSET);
916
STATIC struct typemanager *tm;
924
printf("type map\n");
926
for (i = 0; i < maxpage; i++) {
927
if (type_map[i] == (int)t_contiguous) {
936
if (type_map[i] >= (int)t_end)
939
tm = tm_of((enum type)type_map[i]);
947
printf("%c", tm->tm_name[0]);
956
for (j = tm->tm_nppage; j > 0; --j, p += tm->tm_size) {
964
/* Since we now mark forwards and backwards on displaced
965
arrays, this is not necessary.
971
if (x->a.a_displaced->c.c_car != Cnil)
976
/* ((struct freelist *)x)->f_link = f; */
978
#ifdef GMP_USE_MALLOC
979
if (x->d.t == t_bignum) {
1001
contblock_sweep_phase(void) {
1004
STATIC char *s, *e, *p, *q;
1005
STATIC struct contblock *cbp;
1009
for (i = 0; i < maxpage;) {
1010
if (type_map[i] != (int)t_contiguous) {
1015
j < maxpage && type_map[j] == (int)t_contiguous;
1020
for (p = s; p < e;) {
1021
if (get_mark_bit((int *)p)) {
1022
/* SGC cont pages: cont blocks must be no smaller than
1023
sizeof(struct contblock), and must not have a sweep
1024
granularity greater than this amount (e.g. CPTR_ALIGN) if
1025
contblock leaks are to be avoided. Used to be aligned at
1026
PTR_ALIGN. CM 20030827 */
1032
if (!get_mark_bit((int *)q)) {
1038
insert_contblock(p, q - p);
1045
for (cbp = cb_pointer; cbp != NULL; cbp = cbp->cb_link)
1046
printf("%d-byte contblock\n", cbp->cb_size);
1053
int (*GBC_enter_hook)() = NULL;
1054
int (*GBC_exit_hook)() = NULL;
1061
struct apage *pp, *qq;
1063
int in_sgc = sgc_enabled;
1069
if (in_signal_handler && t == t_relocatable)
1070
error("cant gc relocatable in signal handler");
1072
if (GBC_enter_hook != NULL)
1073
(*GBC_enter_hook)();
1076
error("GBC is not enabled");
1077
interrupt_enable = FALSE;
1080
{t = t_contiguous; gc_time = -1;
1082
if(sgc_enabled) sgc_quit();
1088
debug = symbol_value(sSAgbc_messageA) != Cnil;
1091
what_to_collect = t;
1093
tm_table[(int)t].tm_gbccount++;
1094
tm_table[(int)t].tm_adjgbccnt++;
1097
if (debug || (sSAnotify_gbcA->s.s_dbind != Cnil)) {
1099
if (gc_time < 0) gc_time=0;
1101
printf("[%s for %ld %s pages..",
1102
(sgc_enabled ? "SGC" : "GC"),
1103
(sgc_enabled ? sgc_count_type(t) : tm_of(t)->tm_npage),
1104
(tm_table[(int)t].tm_name)+1);
1106
printf("[%s for %d %s pages..",
1108
(tm_of(t)->tm_npage),
1109
(tm_table[(int)t].tm_name)+1);
1113
printf("(%d writable)..",sgc_count_writable(page(core_end)));
1118
if (gc_time >=0 && !gc_recursive++) {gc_start=runtime();}
1120
maxpage = page(heap_end);
1122
if ((int)t >= (int)t_contiguous) {
1123
j = maxpage*(PAGESIZE/(CPTR_ALIGN*SIZEOF_LONG*CHAR_SIZE)) ;
1125
(PAGESIZE / sizeof(int)) = x * (sizeof(int)*CHAR_SIZE)
1126
eg if PAGESIZE = 2048 x=16
1127
1 page = 512 long word
1128
512 bit = 16 long word
1131
if (t == t_relocatable)
1133
/* if in sgc we don't need more pages below hole
1134
just more relocatable or cleaning it */
1138
if (holepage < new_holepage)
1139
holepage = new_holepage;
1142
i = rb_pointer - (sgc_enabled ? old_rb_start : rb_start);
1144
i = rb_pointer - rb_start;
1147
if (nrbpage > (real_maxpage-page(heap_end)
1148
-holepage-real_maxpage/32)/2) {
1149
if (i > nrbpage*PAGESIZE)
1150
error("Can't allocate. Good-bye!.");
1153
(real_maxpage-page(heap_end)
1154
-holepage-real_maxpage/32)/2;
1158
rb_start = heap_end;
1163
{rb_start = heap_end + PAGESIZE*holepage;}
1165
rb_end = heap_end + (holepage + nrbpage) *PAGESIZE;
1167
if (rb_start < rb_pointer)
1168
rb_start1 = (char *)
1169
((long)(rb_pointer + PAGESIZE-1) & -(unsigned long)PAGESIZE);
1171
rb_start1 = rb_start;
1173
/* as we walk through marking data, we replace the
1174
relocatable pointers
1175
in objects by the rb_pointer, advance that
1176
by the size, and copy the actual
1177
data there to rb_pointer1, and advance it by the size
1178
at the end [rb_start1,rb_pointer1] is copied
1179
to [rb_start,rb_pointer]
1181
rb_pointer = rb_start; /* where the new relblock will start */
1182
rb_pointer1 = rb_start1;/* where we will copy it to during gc*/
1184
mark_table = (long *)(rb_start1 + i);
1186
if (rb_end < (char *)&mark_table[j])
1187
i = (char *)&mark_table[j] - heap_end;
1189
i = rb_end - heap_end;
1190
alloc_page(-(i + PAGESIZE - 1)/PAGESIZE);
1192
for (i = 0; i < j; i++)
1198
printf("mark phase\n");
1205
{ if (t < t_end && tm_of(t)->tm_sgc == 0)
1207
if (sSAnotify_gbcA->s.s_dbind != Cnil)
1208
{fprintf(stdout, " (doing full gc)");
1218
printf("mark ended (%d)\n", runtime() - tm);
1225
printf("sweep phase\n");
1238
printf("sweep ended (%d)\n", runtime() - tm);
1243
if (t == t_contiguous) {
1246
printf("contblock sweep phase\n");
1254
sgc_contblock_sweep_phase();
1257
contblock_sweep_phase();
1260
printf("contblock sweep ended (%d)\n",
1265
if ((int)t >= (int)t_contiguous) {
1267
if (rb_start < rb_start1) {
1268
j = (rb_pointer-rb_start + PAGESIZE - 1)/PAGESIZE;
1269
pp = (struct apage *)rb_start;
1270
qq = (struct apage *)rb_start1;
1271
for (i = 0; i < j; i++)
1276
/* we don't know which pages have relblock on them */
1278
make_writable(page(rb_start),
1279
(rb_pointer-rb_start + PAGESIZE - 1)/PAGESIZE);
1282
rb_limit = rb_end - 2*RB_GETA;
1288
for (i = 0, j = 0; i < (int)t_end; i++) {
1289
if (tm_table[i].tm_type == (enum type)i) {
1290
printf("%13s: %8ld used %8ld free %4ld/%ld pages\n",
1291
tm_table[i].tm_name,
1292
TM_NUSED(tm_table[i]),
1293
tm_table[i].tm_nfree,
1294
tm_table[i].tm_npage,
1295
tm_table[i].tm_maxpage);
1296
j += tm_table[i].tm_npage;
1298
printf("%13s: linked to %s\n",
1299
tm_table[i].tm_name,
1300
tm_table[(int)tm_table[i].tm_type].tm_name);
1302
printf("contblock: %ld blocks %ld pages\n", ncb, ncbpage);
1303
printf("hole: %ld pages\n", holepage);
1304
printf("relblock: %ld bytes used %ld bytes free %ld pages\n",
1305
(long)(rb_pointer - rb_start), (long)(rb_end - rb_pointer), nrbpage);
1306
printf("GBC ended\n");
1311
interrupt_enable = TRUE;
1314
if (in_sgc && sgc_enabled==0)
1318
if (saving_system) {
1319
j = (rb_pointer-rb_start+PAGESIZE-1) / PAGESIZE;
1321
heap_end += PAGESIZE*j;
1323
/* When the program is re-loaded, the system initialization
1324
code may use malloc() before main() begins. This
1325
happens in Linux. We need to allow some heap expansion
1326
space for this. One page is enough for Linux.
1327
Bill Metzenthen May95.
1329
if ( core_end < heap_end + PAGESIZE )
1332
"Not enough memory available for saved image\n");
1335
core_end = heap_end + PAGESIZE;
1337
/* for (i = 0; i < maxpage; i++) */
1338
/* if ((enum type)type_map[i] == t_contiguous) */
1339
/* type_map[i] = (char)t_other; */
1340
/* cb_pointer = NULL; */
1341
/* maxcbpage -= ncbpage; */
1342
/* if (maxcbpage < 100) */
1343
/* maxcbpage = 100; */
1347
/* hmm.... why is this test necessary.*/
1351
{holepage = new_holepage;
1352
nrbpage = INIT_NRBPAGE;}
1355
error("no relocatable pages left");
1357
rb_start = heap_end + PAGESIZE*holepage;
1358
rb_end = rb_start + PAGESIZE*nrbpage;
1359
rb_limit = rb_end - 2*RB_GETA;
1360
rb_pointer = rb_start;
1363
if (GBC_exit_hook != NULL)
1366
if(gc_time>=0 && !--gc_recursive) {gc_time=gc_time+(gc_start=(runtime()-gc_start));}
1368
if (sSAnotify_gbcA->s.s_dbind != Cnil) {
1371
fprintf(stdout, "(T=...).GC finished]\n");
1373
fprintf(stdout, "(T=%d).GC finished]\n",gc_start);
1383
FFN(siLroom_report)(void) {
1393
vs_check_push(make_fixnum(real_maxpage));
1394
vs_push(make_fixnum(available_pages));
1395
vs_push(make_fixnum(ncbpage));
1396
vs_push(make_fixnum(maxcbpage));
1397
vs_push(make_fixnum(ncb));
1398
vs_push(make_fixnum(cbgbccount));
1399
vs_push(make_fixnum(holepage));
1400
vs_push(make_fixnum(rb_pointer - rb_start));
1401
vs_push(make_fixnum(rb_end - rb_pointer));
1402
vs_push(make_fixnum(nrbpage));
1403
vs_push(make_fixnum(rbgbccount));
1404
for (i = 0; i < (int)t_end; i++) {
1405
if (tm_table[i].tm_type == (enum type)i) {
1406
vs_check_push(make_fixnum(TM_NUSED(tm_table[i])));
1407
vs_push(make_fixnum(tm_table[i].tm_nfree));
1408
vs_push(make_fixnum(tm_table[i].tm_npage));
1409
vs_push(make_fixnum(tm_table[i].tm_maxpage));
1410
vs_push(make_fixnum(tm_table[i].tm_gbccount));
1412
vs_check_push(Cnil);
1413
vs_push(make_fixnum(tm_table[i].tm_type));
1422
FFN(siLreset_gbc_count)(void) {
1428
for (i = 0; i < (int)t_other; i++)
1429
tm_table[i].tm_gbccount = tm_table[i].tm_adjgbccnt = 0;
1432
/* copy S bytes starting at P to beyond rb_pointer1 (temporarily)
1433
but return a pointer to where this will be copied back to,
1434
when gc is done. alignment of rb_pointer is kept at a multiple
1439
copy_relblock(char *p, int s)
1440
{ char *res = rb_pointer;
1441
char *q = rb_pointer1;
1442
s = ROUND_UP_PTR(s);
1454
mark_contblock(void *p, int s) {
1460
if (!MAYBE_DATA_P(p) || np >= MAXPAGE || (enum type)type_map[page(p)] != t_contiguous)
1463
/* SGC cont pages: contblock pages must be no smaller than
1464
sizeof(struct contblock). CM 20030827 */
1465
x = (char *)ROUND_DOWN_PTR_CONT(p);
1466
y = (char *)ROUND_UP_PTR_CONT(q);
1467
for (; x < y; x+=CPTR_ALIGN)
1471
DEFUN_NEW("GBC",object,fLgbc,LISP
1472
,1,1,NONE,OO,OO,OO,OO,(object x0),"")
1479
else if (x0 == Cnil)
1482
{ x0 = small_fixnum(1); GBC(t_relocatable);}
1487
FFN(siLgbc_time)(void) {
1489
gc_time=fix(vs_base[0]);
1491
vs_base[0]=make_fixnum(gc_time);
1500
DEFVAR("*NOTIFY-GBC*",sSAnotify_gbcA,SI,Cnil,"");
1502
DEFVAR("*GBC-MESSAGE*",sSAgbc_messageA,SI,Cnil,"");
1506
gcl_init_GBC(void) {
1508
make_si_function("ROOM-REPORT", siLroom_report);
1509
make_si_function("RESET-GBC-COUNT", siLreset_gbc_count);
1510
make_si_function("GBC-TIME",siLgbc_time);
1513
/* we use that maxpage is a power of 2 in this
1514
case, to quickly be able to look in our table */
1518
for(i=j=1 ; i< 32 ; i++)
1519
if (MAXPAGE == (1 <<i))
1522
perror("MAXPAGE is not a power of 2. Recompile");
1525
make_si_function("SGC-ON",siLsgc_on);
added
removed
o/gbc.c
