[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [Gcl-devel] Re: GCL allocation
|
From: |
Camm Maguire |
|
Subject: |
Re: [Gcl-devel] Re: GCL allocation |
|
Date: |
29 Aug 2003 00:04:34 -0400 |
|
User-agent: |
Gnus/5.09 (Gnus v5.9.0) Emacs/21.2 |
Greetings! OK my apologies -- I wrongly assumed that alloc_contblock
returned aligned pages. This one works for me (acl2 and maxima pass
all tests). You can try it now, or wait until I clean up the
debugging stuff and commit into CVS version 2.5.4 sometime tomorrow.
Take care,
=============================================================================
Index: h/object.h
===================================================================
RCS file: /cvsroot/gcl/gcl/h/object.h,v
retrieving revision 1.18.4.1
diff -u -r1.18.4.1 object.h
--- h/object.h 16 Jul 2003 02:02:49 -0000 1.18.4.1
+++ h/object.h 29 Aug 2003 03:54:25 -0000
@@ -759,6 +759,7 @@
short tm_max_grow; /* max amount to grow when growing */
short tm_growth_percent; /* percent to increase maxpages */
short tm_percent_free; /* percent which must be free after a gc for
this type */
+ short tm_distinct; /* pages of this type are distinct */
};
Index: h/page.h
===================================================================
RCS file: /cvsroot/gcl/gcl/h/page.h,v
retrieving revision 1.4.4.1
diff -u -r1.4.4.1 page.h
--- h/page.h 21 Aug 2003 04:17:47 -0000 1.4.4.1
+++ h/page.h 29 Aug 2003 03:54:25 -0000
@@ -29,6 +29,12 @@
#define ROUND_UP_PTR(n) (((long)(n) + (PTR_ALIGN-1)) & ~(PTR_ALIGN-1))
#define ROUND_DOWN_PTR(n) (((long)(n) & ~(PTR_ALIGN-1)))
+/* alignment required for contiguous pointers */
+#define CPTR_ALIGN (PTR_ALIGN < sizeof(struct contblock) ? sizeof(struct
contblock) : PTR_ALIGN)
+
+#define ROUND_UP_PTR_CONT(n) (((long)(n) + (CPTR_ALIGN-1)) & ~(CPTR_ALIGN-1))
+#define ROUND_DOWN_PTR_CONT(n) (((long)(n) & ~(CPTR_ALIGN-1)))
+
#ifdef SGC
Index: o/alloc.c
===================================================================
RCS file: /cvsroot/gcl/gcl/o/alloc.c,v
retrieving revision 1.19
diff -u -r1.19 alloc.c
--- o/alloc.c 1 Mar 2003 22:37:37 -0000 1.19
+++ o/alloc.c 29 Aug 2003 03:54:35 -0000
@@ -425,9 +425,19 @@
/*
printf("allocating %d-byte contiguous block...\n", n);
*/
+ /* SGC cont pages: contiguous pointers must be aligned at
+ CPTR_ALIGN, no smaller than sizeof (struct contblock).
+ Here we allocate a bigger block, and rely on the fact that
+ allocate_page returns pointers appropriately aligned,
+ being also aligned on page boundaries. Protection against
+ a too small contblock was aforded before by a minimum
+ contblock size enforced by CBMINSIZE in insert_contblock.
+ However, this leads to a leak when many small cont blocks
+ are allocated, e.g. with bignums, so is now removed. CM
+ 20030827 */
g = FALSE;
- n = ROUND_UP_PTR(n);
+ n = ROUND_UP_PTR_CONT(n);
ONCE_MORE:
CHECK_INTERRUPT;
@@ -472,8 +482,16 @@
}
p = alloc_page(m);
- for (i = 0; i < m; i++)
+ for (i = 0; i < m; i++) {
type_map[page(p) + i] = (char)t_contiguous;
+
+ /* SGC cont pages: Before this point, GCL never marked
contiguous
+ pages for SGC, causing no contiguous pages to be
+ swept when SGC was on. Here we follow the behavior
+ for other pages in add_to_freelist. CM 20030827 */
+ if (sgc_enabled && tm_table[t_contiguous].tm_sgc)
+ sgc_type_map[page(p)+i]|= SGC_PAGE_FLAG;
+ }
ncbpage += m;
insert_contblock(p+n, PAGESIZE*m - n);
return(p);
@@ -484,19 +502,53 @@
struct contblock **cbpp, *cbp;
- if (s < CBMINSIZE)
+ /* SGC cont pages: This used to return when s<CBMINSIZE, but we need
+ to be able to sweep small (e.g. bignum) contblocks. FIXME:
+ should never be called with s<=0 to begin with. CM 20030827*/
+ if (s<=0)
return;
ncb++;
cbp = (struct contblock *)p;
- cbp->cb_size = s;
+ /* SGC cont pages: allocated sizes may not be zero mod CPTR_SIZE,
+ e.g. string fillp, but alloc_contblock rounded up the allocation
+ like this, which we follow here. CM 20030827 */
+ cbp->cb_size = ROUND_UP_PTR_CONT(s);
for (cbpp = &cb_pointer; *cbpp; cbpp = &((*cbpp)->cb_link))
if ((*cbpp)->cb_size >= s) {
+#undef DEBUG
+#define DEBUG
+#ifdef DEBUG
+ if (*cbpp==cbp) {
+ fprintf(stderr,"Trying to install a circle at %p\n",cbp);
+ exit(1);
+ }
+ if (sgc_enabled) {
+ extern struct contblock *old_cb_pointer;
+ extern void overlap_check(struct contblock *,struct contblock *);
+
+ overlap_check(old_cb_pointer,cb_pointer);
+ }
+#endif
cbp->cb_link = *cbpp;
*cbpp = cbp;
+#ifdef DEBUG
+ if (sgc_enabled) {
+ extern struct contblock *old_cb_pointer;
+ extern void overlap_check(struct contblock *,struct contblock *);
+ overlap_check(old_cb_pointer,cb_pointer);
+ }
+#endif
return;
}
cbp->cb_link = NULL;
*cbpp = cbp;
+#ifdef DEBUG
+ if (sgc_enabled) {
+ extern struct contblock *old_cb_pointer;
+ extern void overlap_check(struct contblock *,struct contblock *);
+ overlap_check(old_cb_pointer,cb_pointer);
+ }
+#endif
}
@@ -568,19 +620,30 @@
return(p);
}
+/* Add a tm_distinct field to prevent page type sharing if desired.
+ Not used now, as its never desirable from an efficiency point of
+ view, and as the only known place one must separate is cons and
+ fixnum, which are of different sizes unless PTR_ALIGN is set too
+ high (e.g. 16 on a 32bit machine). See the ordering of init_tm
+ calls for these types below -- reversing would wind up merging the
+ types with the current algorithm. CM 20030827 */
+
static void
-init_tm(enum type t, char *name, int elsize, int nelts, int sgc) {
+init_tm(enum type t, char *name, int elsize, int nelts, int sgc,int distinct) {
int i, j;
int maxpage;
/* round up to next number of pages */
maxpage = (((nelts * elsize) + PAGESIZE -1)/PAGESIZE);
tm_table[(int)t].tm_name = name;
- for (j = -1, i = 0; i < (int)t_end; i++)
- if (tm_table[i].tm_size != 0 &&
- tm_table[i].tm_size >= elsize &&
- (j < 0 || tm_table[j].tm_size > tm_table[i].tm_size))
- j = i;
+ j=-1;
+ if (!distinct)
+ for (i = 0; i < (int)t_end; i++)
+ if (tm_table[i].tm_size != 0 &&
+ tm_table[i].tm_size >= elsize &&
+ !tm_table[i].tm_distinct &&
+ (j < 0 || tm_table[j].tm_size > tm_table[i].tm_size))
+ j = i;
if (j >= 0) {
tm_table[(int)t].tm_type = (enum type)j;
tm_table[j].tm_maxpage += maxpage;
@@ -598,6 +661,7 @@
/*tm_table[(int)t].tm_npage = 0; */ /* dont zero nrbpage.. */
tm_table[(int)t].tm_maxpage = maxpage;
tm_table[(int)t].tm_gbccount = 0;
+ tm_table[(int)t].tm_distinct=distinct;
#ifdef SGC
tm_table[(int)t].tm_sgc = sgc;
tm_table[(int)t].tm_sgc_max = 3000;
@@ -688,40 +752,46 @@
for (i = 0; i < MAXPAGE; i++)
type_map[i] = (char)t_other;
+ /* Unused (at present) tm_distinct flag added. Note that if cons
+ and fixnum share page types, errors will be introduced.
+
+ Gave each page type at least some sgc pages by default. Of
+ course changeable by allocate-sgc. CM 20030827 */
+
init_tm(t_fixnum, "NFIXNUM",
- sizeof(struct fixnum_struct), 8192,20);
- init_tm(t_cons, ".CONS", sizeof(struct cons), 65536 ,50 );
- init_tm(t_structure, "SSTRUCTURE", sizeof(struct structure), 5461,0 );
- init_tm(t_cfun, "fCFUN", sizeof(struct cfun), 4096,0 );
- init_tm(t_sfun, "gSFUN", sizeof(struct sfun),409,0 );
- init_tm(t_string, "\"STRING", sizeof(struct string), 5461,1 );
- init_tm(t_array, "aARRAY", sizeof(struct array), 4681,1 );
- init_tm(t_symbol, "|SYMBOL", sizeof(struct symbol), 3640,1 );
- init_tm(t_bignum, "BBIGNUM", sizeof(struct bignum), 2730,0 );
- init_tm(t_ratio, "RRATIONAL", sizeof(struct ratio), 170,0 );
+ sizeof(struct fixnum_struct), 8192,20,0);
+ init_tm(t_cons, ".CONS", sizeof(struct cons), 65536 ,50,0 );
+ init_tm(t_structure, "SSTRUCTURE", sizeof(struct structure), 5461,1,0 );
+ init_tm(t_cfun, "fCFUN", sizeof(struct cfun), 4096,1,0 );
+ init_tm(t_sfun, "gSFUN", sizeof(struct sfun),409,1,0 );
+ init_tm(t_string, "\"STRING", sizeof(struct string), 5461,1,0 );
+ init_tm(t_array, "aARRAY", sizeof(struct array), 4681,1,0 );
+ init_tm(t_symbol, "|SYMBOL", sizeof(struct symbol), 3640,1,0 );
+ init_tm(t_bignum, "BBIGNUM", sizeof(struct bignum), 2730,1,0 );
+ init_tm(t_ratio, "RRATIONAL", sizeof(struct ratio), 170,1,0 );
init_tm(t_shortfloat, "FSHORT-FLOAT",
- sizeof(struct shortfloat_struct), 256 ,1);
+ sizeof(struct shortfloat_struct), 256 ,1,0);
init_tm(t_longfloat, "LLONG-FLOAT",
- sizeof(struct longfloat_struct), 170 ,0);
- init_tm(t_complex, "CCOMPLEX", sizeof(struct complex), 170 ,0);
- init_tm(t_character,"#CHARACTER",sizeof(struct character), 256 ,0);
- init_tm(t_package, ":PACKAGE", sizeof(struct package), 2*PAGESIZE /
sizeof(struct package),0);
- init_tm(t_hashtable, "hHASH-TABLE", sizeof(struct hashtable), 78,0 );
- init_tm(t_vector, "vVECTOR", sizeof(struct vector), 146 ,0);
- init_tm(t_bitvector, "bBIT-VECTOR", sizeof(struct bitvector), 73 ,0);
- init_tm(t_stream, "sSTREAM", sizeof(struct stream), 78 ,0);
- init_tm(t_random, "$RANDOM-STATE", sizeof(struct random), 256 ,0);
- init_tm(t_readtable, "rREADTABLE", sizeof(struct readtable), 256 ,0);
- init_tm(t_pathname, "pPATHNAME", sizeof(struct pathname), 73 ,0);
- init_tm(t_cclosure, "cCCLOSURE", sizeof(struct cclosure), 85 ,0);
- init_tm(t_closure, "cCLOSURE", sizeof(struct cclosure), 85 ,0);
- init_tm(t_vfun, "VVFUN", sizeof(struct vfun), 102 ,0);
- init_tm(t_gfun, "gGFUN", sizeof(struct sfun), 0 ,0);
- init_tm(t_afun, "AAFUN", sizeof(struct sfun), 0 ,0);
- init_tm(t_cfdata, "cCFDATA", sizeof(struct cfdata), 102 ,0);
- init_tm(t_spice, "!SPICE", sizeof(struct spice), 4096 ,0);
- init_tm(t_relocatable, "%RELOCATABLE-BLOCKS", 1000,0,20);
- init_tm(t_contiguous, "_CONTIGUOUS-BLOCKS", 1001,0,20);
+ sizeof(struct longfloat_struct), 170 ,1,0);
+ init_tm(t_complex, "CCOMPLEX", sizeof(struct complex), 170 ,1,0);
+ init_tm(t_character,"#CHARACTER",sizeof(struct character), 256 ,1,0);
+ init_tm(t_package, ":PACKAGE", sizeof(struct package), 2*PAGESIZE /
sizeof(struct package),1,0);
+ init_tm(t_hashtable, "hHASH-TABLE", sizeof(struct hashtable), 78,1,0 );
+ init_tm(t_vector, "vVECTOR", sizeof(struct vector), 146 ,1,0);
+ init_tm(t_bitvector, "bBIT-VECTOR", sizeof(struct bitvector), 73 ,1,0);
+ init_tm(t_stream, "sSTREAM", sizeof(struct stream), 78 ,1,0);
+ init_tm(t_random, "$RANDOM-STATE", sizeof(struct random), 256 ,1,0);
+ init_tm(t_readtable, "rREADTABLE", sizeof(struct readtable), 256 ,1,0);
+ init_tm(t_pathname, "pPATHNAME", sizeof(struct pathname), 73 ,1,0);
+ init_tm(t_cclosure, "cCCLOSURE", sizeof(struct cclosure), 85 ,1,0);
+ init_tm(t_closure, "cCLOSURE", sizeof(struct cclosure), 85 ,1,0);
+ init_tm(t_vfun, "VVFUN", sizeof(struct vfun), 102 ,1,0);
+ init_tm(t_gfun, "gGFUN", sizeof(struct sfun), 0 ,1,0);
+ init_tm(t_afun, "AAFUN", sizeof(struct sfun), 0 ,1,0);
+ init_tm(t_cfdata, "cCFDATA", sizeof(struct cfdata), 102 ,1,0);
+ init_tm(t_spice, "!SPICE", sizeof(struct spice), 4096 ,1,0);
+ init_tm(t_relocatable, "%RELOCATABLE-BLOCKS", 1000,0,20,0);
+ init_tm(t_contiguous, "_CONTIGUOUS-BLOCKS", 1001,0,20,0);
tm_table[t_relocatable].tm_nppage = PAGESIZE;
tm_table[t_contiguous].tm_nppage = PAGESIZE;
@@ -895,8 +965,15 @@
FEerror("Can't allocate ~D pages for contiguous blocks.",
1, make_fixnum(npages));
- for (i = 0; i < m; i++)
+ for (i = 0; i < m; i++) {
type_map[page(p + PAGESIZE*i)] = (char)t_contiguous;
+ /* SGC cont pages: Before this point, GCL never marked contiguous
+ pages for SGC, causing no contiguous pages to be
+ swept when SGC was on. Here we follow the behavior
+ for other pages in add_to_freelist. CM 20030827 */
+ if (sgc_enabled && tm_table[t_contiguous].tm_sgc)
+ sgc_type_map[page(p)+i]|= SGC_PAGE_FLAG;
+ }
ncbpage += m;
insert_contblock(p, PAGESIZE*m);
@@ -1140,8 +1217,11 @@
#endif
for (p = &malloc_list; *p && !endp(*p); p = &((*p)->c.c_cdr))
if ((*p)->c.c_car->st.st_self == ptr) {
- insert_contblock((*p)->c.c_car->st.st_self,
- (*p)->c.c_car->st.st_dim);
+/* SGC contblock pages: leave sweeping to GBC. Could also try
+ protecting this with sgc_enabled && strm->d.s==SGC_NORMAL and a
+ switch to old_cb_pointer as appropriate */
+/* insert_contblock((*p)->c.c_car->st.st_self, */
+/* (*p)->c.c_car->st.st_dim); */
(*p)->c.c_car->st.st_self = NULL;
*p = (*p)->c.c_cdr;
return ;
@@ -1189,7 +1269,10 @@
x->st.st_fillp = x->st.st_dim = size;
for (i = 0; i < size; i++)
x->st.st_self[i] = ((char *)ptr)[i];
- insert_contblock(ptr, j);
+/* SGC contblock pages: leave sweeping to GBC. Could also try
+ protecting this with sgc_enabled && strm->d.s==SGC_NORMAL and a
+ switch to old_cb_pointer as appropriate */
+/* insert_contblock(ptr, j); */
return(x->st.st_self);
}
}
Index: o/file.d
===================================================================
RCS file: /cvsroot/gcl/gcl/o/file.d,v
retrieving revision 1.21
diff -u -r1.21 file.d
--- o/file.d 18 Feb 2003 02:32:03 -0000 1.21
+++ o/file.d 29 Aug 2003 03:54:35 -0000
@@ -303,11 +303,16 @@
deallocate_stream_buffer(strm)
object strm;
{
- if (strm->sm.sm_buffer)
- {insert_contblock(strm->sm.sm_buffer, BUFSIZ);
- strm->sm.sm_buffer = 0;}
- else
- printf("no buffer? %p \n",strm->sm.sm_fp);
+
+/* SGC contblock pages: leave sweeping to GBC. Could also try
+ protecting this with sgc_enabled && strm->d.s==SGC_NORMAL and a
+ switch to old_cb_pointer as appropriate */
+
+/* if (strm->sm.sm_buffer) */
+/* {insert_contblock(strm->sm.sm_buffer, BUFSIZ); */
+/* strm->sm.sm_buffer = 0;} */
+/* else */
+/* printf("no buffer? %p \n",strm->sm.sm_fp); */
#ifndef FCLOSE_SETBUF_OK
strm->sm.sm_fp->_base = NULL;
Index: o/gbc.c
===================================================================
RCS file: /cvsroot/gcl/gcl/o/gbc.c,v
retrieving revision 1.13.4.1
diff -u -r1.13.4.1 gbc.c
--- o/gbc.c 30 Jul 2003 15:11:12 -0000 1.13.4.1
+++ o/gbc.c 29 Aug 2003 03:54:36 -0000
@@ -1012,19 +1012,24 @@
e = pagetochar(j);
for (p = s; p < e;) {
if (get_mark_bit((int *)p)) {
- p += PTR_ALIGN;
+ /* SGC cont pages: cont blocks must be no smaller than
+ sizeof(struct contblock), and must not have a sweep
+ granularity greater than this amount (e.g. CPTR_ALIGN) if
+ contblock leaks are to be avoided. Used to be aligned at
+ PTR_ALIGN. CM 20030827 */
+ p += CPTR_ALIGN;
continue;
}
- q = p + PTR_ALIGN;
+ q = p + CPTR_ALIGN;
while (q < e) {
if (!get_mark_bit((int *)q)) {
- q += PTR_ALIGN;
+ q += CPTR_ALIGN;
continue;
}
break;
}
insert_contblock(p, q - p);
- p = q + PTR_ALIGN;
+ p = q + CPTR_ALIGN;
}
i = j + 1;
}
@@ -1067,8 +1072,8 @@
if(sgc_enabled) sgc_quit();
}
-
-
+
+
#ifdef DEBUG
debug = symbol_value(sSAgbc_messageA) != Cnil;
#endif
@@ -1278,6 +1283,9 @@
interrupt_enable = TRUE;
+ if (in_sgc && sgc_enabled==0)
+ sgc_start();
+
if (saving_system) {
j = (rb_pointer-rb_start+PAGESIZE-1) / PAGESIZE;
@@ -1323,10 +1331,6 @@
if (GBC_exit_hook != NULL)
(*GBC_exit_hook)();
-
- if (in_sgc && sgc_enabled==0)
- sgc_start();
-
if(gc_time>=0 && !--gc_recursive)
{gc_time=gc_time+(gc_start=(runtime()-gc_start));}
if (sSAnotify_gbcA->s.s_dbind != Cnil) {
@@ -1423,8 +1427,10 @@
if (!MAYBE_DATA_P(p) || (enum type)type_map[page(p)] != t_contiguous)
return;
q = p + s;
- x = (int *)ROUND_DOWN_PTR(p);
- y = (int *)ROUND_UP_PTR(q);
+ /* SGC cont pages: contblock pages must be no smaller than
+ sizeof(struct contblock). CM 20030827 */
+ x = (int *)ROUND_DOWN_PTR_CONT(p);
+ y = (int *)ROUND_UP_PTR_CONT(q);
for (; x < y; x++)
set_mark_bit(x);
}
Index: o/gmp.c
===================================================================
RCS file: /cvsroot/gcl/gcl/o/gmp.c,v
retrieving revision 1.3
diff -u -r1.3 gmp.c
--- o/gmp.c 15 Feb 2003 00:38:28 -0000 1.3
+++ o/gmp.c 29 Aug 2003 03:54:36 -0000
@@ -15,7 +15,10 @@
old = oldmem;
bcopy(MP_SELF(big_gcprotect),new,oldsize);
MP_SELF(big_gcprotect)=0;
- if (inheap(oldmem)) insert_contblock(oldmem,oldsize);
+/* SGC contblock pages: leave sweeping to GBC. Could also try
+ protecting this with sgc_enabled && strm->d.s==SGC_NORMAL and a
+ switch to old_cb_pointer as appropriate */
+/* if (inheap(oldmem)) insert_contblock(oldmem,oldsize); */
return new;
}
Index: o/sgbc.c
===================================================================
RCS file: /cvsroot/gcl/gcl/o/sgbc.c,v
retrieving revision 1.9
diff -u -r1.9 sgbc.c
--- o/sgbc.c 15 Feb 2003 00:38:28 -0000 1.9
+++ o/sgbc.c 29 Aug 2003 03:54:36 -0000
@@ -887,19 +887,24 @@
e = pagetochar(j);
for (p = s; p < e;) {
if (get_mark_bit((int *)p)) {
- p += PTR_ALIGN;
+ /* SGC cont pages: cont blocks must be no smaller than
+ sizeof(struct contblock), and must not have a sweep
+ granularity greater than this amount (e.g. CPTR_ALIGN) if
+ contblock leaks are to be avoided. Used to be aligned at
+ PTR_ALIGN. CM 20030827 */
+ p += CPTR_ALIGN;
continue;
}
- q = p + PTR_ALIGN;
+ q = p + CPTR_ALIGN;
while (q < e) {
if (!get_mark_bit((int *)q)) {
- q += PTR_ALIGN;
+ q += CPTR_ALIGN;
continue;
}
break;
}
insert_contblock(p, q - p);
- p = q + PTR_ALIGN;
+ p = q + CPTR_ALIGN;
}
i = j + 1;
}
@@ -961,6 +966,56 @@
return count;
}
+ /* SGC cont pages: After SGC_start, old_cb_pointer will be a linked
+ list of free blocks on non-SGC pages, and cb_pointer will be
+ likewise for SGC pages. CM 20030827*/
+struct contblock *old_cb_pointer;
+
+#undef MDEBUG
+#define MDEBUG
+#ifdef MDEBUG
+void
+overlap_check(struct contblock *t1,struct contblock *t2) {
+
+ struct contblock *p;
+
+ for (;t1;t1=t1->cb_link) {
+
+ if (!inheap(t1)) {
+ fprintf(stderr,"%p not in heap\n",t1);
+ exit(1);
+ }
+
+ for (p=t2;p;p=p->cb_link) {
+
+ if (!inheap(p)) {
+ fprintf(stderr,"%p not in heap\n",t1);
+ exit(1);
+ }
+
+ if ((p<=t1 && (void *)p+p->cb_size>(void *)t1) ||
+ (t1<=p && (void *)t1+t1->cb_size>(void *)p)) {
+ fprintf(stderr,"Overlap %u %p %u %p\n",t1->cb_size,t1,p->cb_size,p);
+ exit(1);
+ }
+
+ if (p==p->cb_link) {
+ fprintf(stderr,"circle detected at %p\n",p);
+ exit(1);
+ }
+
+ }
+
+ if (t1==t1->cb_link) {
+ fprintf(stderr,"circle detected at %p\n",t1);
+ exit(1);
+ }
+
+ }
+
+}
+#endif
+
int
sgc_start(void) {
@@ -985,7 +1040,11 @@
{
int maxp=0;
int j;
- int minfree = tm->tm_sgc_minfree;
+ /* SGC cont pages: This used to be simply set to tm_sgc_minfree,
+ which is a definite bug, as minfree could then be zero,
+ leading this type to claim SGC pages not of its type as
+ specified in type_map. CM 20030827*/
+ int minfree = tm->tm_sgc_minfree > 0 ? tm->tm_sgc_minfree : 1 ;
int count;
bzero(free_map,npages*sizeof(short));
f = tm->tm_free;
@@ -1031,6 +1090,112 @@
goto FIND_FREE_PAGES;
}
}
+
+/* SGC cont pages: Here we implement the contblock page division into
+ SGC and non-SGC types. Unlike the other types, we need *whole*
+ free pages for contblock SGC, as there is no psersistent data
+ element (e.g. .m) on an allocated block itself which can indicate
+ its live status. If anything on a page which is to be marked
+ read-only points to a live object on an SGC cont page, it will
+ never be marked and will be erroneously swept. It is also possible
+ for dead objects to unnecessarily mark dead regions on SGC pages
+ and delay sweeping until the pointing type is GC'ed if SGC is
+ turned off for the pointing type, e.g. tm_sgc=0. (This was so by
+ default for a number of types, including bignums, and has now been
+ corrected in init_alloc in alloc.c.) We can't get around this
+ AFAICT, as old data on (writable) SGC pages must be marked lest it
+ is lost, and (old) data on now writable non-SGC pages might point
+ to live regions on SGC pages, yet might not themselves be reachable
+ from the mark origin through an unbroken chain of writable pages.
+ In any case, the possibility of a lot of garbage marks on contblock
+ pages, especially when the blocks are small as in bignums, makes
+ necessary the sweeping of minimal contblocks to prevent leaks. CM
+ 20030827 */
+ {
+ void *p=NULL;
+ unsigned i,j,k,count;
+ struct contblock *new_cb_pointer=NULL,*tmp_cb_pointer=NULL,**cbpp;
+
+ tm=tm_of(t_contiguous);
+
+ /* SGC cont pages: First count whole free pages available. CM 20030827 */
+ for (cbpp=&cb_pointer,count=0;*cbpp;cbpp=&(*cbpp)->cb_link) {
+ p=PAGE_ROUND_UP((void *)(*cbpp));
+ k=p-((void *)(*cbpp));
+ if ((*cbpp)->cb_size<k || (*cbpp)->cb_size-k<PAGESIZE)
+ continue;
+ i=((*cbpp)->cb_size-k)/PAGESIZE;
+ count+=i;
+ }
+ count=tm->tm_sgc>count ? tm->tm_sgc - count : 0;
+
+ if (count>0) {
+ /* SGC cont pages: allocate more if necessary, dumping possible
+ GBC freed pages onto the old contblock list. CM 20030827*/
+ int z=count+1;
+ void *p1=alloc_contblock(z*PAGESIZE);
+ p=PAGE_ROUND_UP(p1);
+ if (p>p1) {
+ z--;
+ insert_contblock(p1,p-p1);
+ insert_contblock(p+z*PAGESIZE,PAGESIZE-(p-p1));
+ }
+ tmp_cb_pointer=cb_pointer;
+ cb_pointer=new_cb_pointer;
+ /* SGC cont pages: add new pages to new contblock list. p is not
+ already on any list as ensured by alloc_contblock. CM
+ 20030827 */
+ insert_contblock(p,PAGESIZE*z);
+ new_cb_pointer=cb_pointer;
+ cb_pointer=tmp_cb_pointer;
+ for (i=0;i<z;i++)
+ sgc_type_map[page(p)+i]|= SGC_PAGE_FLAG;
+ }
+
+ for (cbpp=&cb_pointer;*cbpp;) {
+ p=PAGE_ROUND_UP((void *)(*cbpp));
+ k=p-((void *)(*cbpp));
+ if ((*cbpp)->cb_size<k || (*cbpp)->cb_size-k<PAGESIZE) {
+ cbpp=&(*cbpp)->cb_link;
+ continue;
+ }
+ i=((*cbpp)->cb_size-k)/PAGESIZE;
+ i*=PAGESIZE;
+ j=(*cbpp)->cb_size-i-k;
+ /* SGC contblock pages: remove this block from old list CM 20030827 */
+ *cbpp=(*cbpp)->cb_link;
+ /* SGC contblock pages: add fragments old list CM 20030827 */
+ if (k) {
+ ncb--;
+ insert_contblock(p-k,k);
+ }
+ if (j) {
+ ncb--;
+ insert_contblock(p+i,j);
+ }
+ tmp_cb_pointer=cb_pointer;
+ cb_pointer=new_cb_pointer;
+ /* SGC contblock pages: add whole pages to new list, p p-k, and
+ p+i are guaranteed to be distinct when used. CM 20030827 */
+ insert_contblock(p,i);
+ new_cb_pointer=cb_pointer;
+ cb_pointer=tmp_cb_pointer;
+ i/=PAGESIZE;
+ for (j=0;j<i;j++)
+ sgc_type_map[page(p)+j]|= SGC_PAGE_FLAG;
+ }
+
+ /* SGC contblock pages: switch to new free SGC contblock list. CM
+ 20030827 */
+ old_cb_pointer=cb_pointer;
+ cb_pointer=new_cb_pointer;
+
+#ifdef MDEBUG
+ overlap_check(old_cb_pointer,cb_pointer);
+#endif
+
+ }
+
/* Now allocate the sgc relblock. We do this as the tail
end of the ordinary rb. */
{
@@ -1117,6 +1282,25 @@
return 0;
sgc_enabled=0;
rb_start = old_rb_start;
+
+ /* SGC cont pages: restore contblocks, each tmp_cb_pointer coming
+ from the new list is guaranteed not to be on the old. Need to
+ grab 'next' before insert_contblock writes is. CM 20030827 */
+ {
+ struct contblock *tmp_cb_pointer,*next;
+#ifdef MDEBUG
+ overlap_check(old_cb_pointer,cb_pointer);
+#endif
+ if (old_cb_pointer) {
+ tmp_cb_pointer=cb_pointer;
+ cb_pointer=old_cb_pointer;
+ for (;tmp_cb_pointer; tmp_cb_pointer=next) {
+ next=tmp_cb_pointer->cb_link;
+ insert_contblock((void *)tmp_cb_pointer,tmp_cb_pointer->cb_size);
+ }
+ }
+ }
+
for (i= t_start; i < t_contiguous ; i++)
if (TM_BASE_TYPE_P(i)) {
tm=tm_of(i);
=============================================================================
"Matt Kaufmann" <address@hidden> writes:
> Hi, Camm --
>
> I applied your patches to the GCL version we have at AMD (which incorporates
> the other patches you've sent) and got a segmentation violation during GC.
> The
> last few lines are as shown below. I'm afraid I can't send out the source
> files, but if there's some way you'd like me to re-run this test, let me know.
> (Maybe you want to send me a tarball of gcl, or point to it on the web for me
> to fetch, in case I messed up in applying the patches, and in case you've made
> other patches that I don't have.) Interestingly, the wall times for the first
> two parts of the test were significantly different between this run and the
> latest one before the new patches were applied.
>
> In minutes,
> new vs. old:
>
> 9 vs. 18 [model-raw]
> 26 vs. 16 [bvecp-raw]
>
> Here are those last few lines.
>
> [SGC for 58 STRING pages..(3398 writable)..(T=5).GC finished]
> [SGC for 58 STRING pages..(3399 writable)..(T=5).GC finished]
> [SGC for 53 CONTIGUOUS-BLOCKS pages..(3400 writable)..(T=5).GC finished]
> [SGC for 58 STRING pages..(3405 writable)..(T=5).GC finished]
> [SGC for 58 STRING pages..(3406 writable)..(T=5).GC finished]
> [SGC for 58 STRING pages..(3406 writable)..(T=6).GC finished]
> [SGC for 58 STRING pages..(3426 writable)..(T=5).GC finished]
> [SGC for 918 CONS pages..(3443 writable)..(T=6).GC finished]
> [SGC for 918 CONS pages..(3443 writable)..(T=6).GC finished]
> [SGC for 918 CONS pages..(3444 writable)..(T=6).GC finished]
> [SGC for 53 CONTIGUOUS-BLOCKS pages..(3445 writable)..(T=7).GC finished]
> [SGC for 58 STRING pages..(3556 writable)..(T=7).GC finished]
> [SGC for 58 STRING pages..(3592 writable)..(T=7).GC finished]
> [SGC for 58 STRING pages..(3627 writable)..(T=6).GC finished]
> [SGC for 58 STRING pages..(3663 writable)..(T=7).GC finished]
> [SGC for 95 SYMBOL pages..(3664 writable)..(T=7).GC finished]
> [SGC for 58 STRING pages..(3726 writable)..(T=7).GC finished]
> [SGC for 53 CONTIGUOUS-BLOCKS pages..(3764 writable)..(T=7).GC finished]
> [SGC for 58 STRING pages..(3814 writable)..(T=8).GC finished]
> [SGC off][GC for 500 RELOCATABLE-BLOCKS pages..
> Unrecoverable error: Segmentation violation..
>
> -- Matt
> Resent-From: address@hidden
> Resent-To: address@hidden
> cc: address@hidden, address@hidden, address@hidden
> From: "Camm Maguire" <address@hidden>
> Date: 27 Aug 2003 16:17:54 -0400
> User-Agent: Gnus/5.09 (Gnus v5.9.0) Emacs/21.2
> X-WSS-ID: 1350D47E1239945-01-01
> Content-Type: text/plain;
> charset=us-ascii
>
> Greetings!
>
> OK, here's the short version:
>
> It was broken. Now its fixed :-).
>
> Slightly longer than this, current GCL never marks contiguous pages as
> SGC pages, and only sweeps the latter when SGC is on, leading to the
> massive leak. The extra reloc pages in the example put it over the
> top.
>
> One can of course address this in several ways. One is to turn off
> SGC on contiguous pages with (si::allocate-sgc 'contiguous 0 3000 0).
> But this is obviously not optimal.
>
> Instead I've constructed a patch which implements SGC for contiguous
> pages. Its quite tricky, being close to the most involved change yet
> I've made to GCL. I've tried to document all the details in the
> comments. You can read them in the patch below if you'd like.
>
> A patch of this import of course needs to be well tested. All goes
> well with maxima, self-build, and ansi thus far. Am presently testing
> the acl2 book certification. Then it probably needs to be run by
> axiom. I've tried it on the test below using quite a few permutations
> of (allocate, allocate-sgc) (contiguous,relblock,cfun(==bignum)),
> sgc-on, and even si::SET-GMP-ALLOCATE-RELOCATABLE successfully,
> although nothing exhaustive as yet.
>
> Just as a reminder, gmp bignums are allocated on contiguous pages by
> default, as these reproduce malloc semantics (i.e. they don't move),
> and one is thus assured that no caching in the external gmp library
> will be corrupted. Dr. Schelter apparently audited the gmp code at
> the point when support for it was added, identifying and removing
> precisely one malloc in a bad place with a safe alloca, allowing
> bignums to be allocated on faster relocatable pages instead. I have
> never repeated this analysis, but we do overwrite said malloc with the
> new alloca even when linking gmp in dynamically. gmp could introduce
> another bad malloc without our noticing conceivably, but as of right
> now, relocatable bignums work fine at least in this test. Of course
> building GCL with its own copy of gmp will always work as it ever
> has. (si::set-gmp-allocate-relocatable t) to try it out.
>
> Separately, several page types had no SGC pages allocated by default,
> including bignums, leading to a thrashing of sgc-on, sgc-off in the
> test below when the bignum header underwent GC. I've remedied this
> default situation here as well.
>
> I've not even committed this change yet as it still might need
> a few minor adjustments, but it basically appears to be working.
> Feedback from GC gurus of course appreciated as always :-). Hammer on
> it and find the bugs if you are so inclined!
>
> To the list -- sorry about being delayed on this time consuming
> project, but I feel it takes precedence over things I'd rather get to,
> like ansi support.
>
> Take care,
>
>
> =============================================================================
> Index: h/object.h
> ===================================================================
> RCS file: /cvsroot/gcl/gcl/h/object.h,v
> retrieving revision 1.18.4.1
> diff -u -r1.18.4.1 object.h
> --- h/object.h 16 Jul 2003 02:02:49 -0000 1.18.4.1
> +++ h/object.h 27 Aug 2003 19:21:52 -0000
> @@ -759,6 +759,7 @@
> short tm_max_grow; /* max amount to grow when growing */
> short tm_growth_percent; /* percent to increase maxpages */
> short tm_percent_free; /* percent which must be free after a gc
> for this type */
> + short tm_distinct; /* pages of this type are distinct */
>
> };
>
> Index: h/page.h
> ===================================================================
> RCS file: /cvsroot/gcl/gcl/h/page.h,v
> retrieving revision 1.4.4.1
> diff -u -r1.4.4.1 page.h
> --- h/page.h 21 Aug 2003 04:17:47 -0000 1.4.4.1
> +++ h/page.h 27 Aug 2003 19:21:52 -0000
> @@ -29,6 +29,12 @@
> #define ROUND_UP_PTR(n) (((long)(n) + (PTR_ALIGN-1)) & ~(PTR_ALIGN-1))
> #define ROUND_DOWN_PTR(n) (((long)(n) & ~(PTR_ALIGN-1)))
>
> +/* alignment required for contiguous pointers */
> +#define CPTR_ALIGN (PTR_ALIGN < sizeof(struct contblock) ? sizeof(struct
> contblock) : PTR_ALIGN)
> +
> +#define ROUND_UP_PTR_CONT(n) (((long)(n) + (CPTR_ALIGN-1)) &
> ~(CPTR_ALIGN-1))
> +#define ROUND_DOWN_PTR_CONT(n) (((long)(n) & ~(CPTR_ALIGN-1)))
> +
>
> #ifdef SGC
>
> Index: o/alloc.c
> ===================================================================
> RCS file: /cvsroot/gcl/gcl/o/alloc.c,v
> retrieving revision 1.19
> diff -u -r1.19 alloc.c
> --- o/alloc.c 1 Mar 2003 22:37:37 -0000 1.19
> +++ o/alloc.c 27 Aug 2003 19:21:52 -0000
> @@ -425,9 +425,19 @@
> /*
> printf("allocating %d-byte contiguous block...\n", n);
> */
> + /* SGC cont pages: contiguous pointers must be aligned at
> + CPTR_ALIGN, no smaller than sizeof (struct contblock).
> + Here we allocate a bigger block, and rely on the fact that
> + allocate_page returns pointers appropriately aligned,
> + being also aligned on page boundaries. Protection against
> + a too small contblock was aforded before by a minimum
> + contblock size enforced by CBMINSIZE in insert_contblock.
> + However, this leads to a leak when many small cont blocks
> + are allocated, e.g. with bignums, so is now removed. CM
> + 20030827 */
>
> g = FALSE;
> - n = ROUND_UP_PTR(n);
> + n = ROUND_UP_PTR_CONT(n);
>
> ONCE_MORE:
> CHECK_INTERRUPT;
> @@ -472,8 +482,16 @@
> }
> p = alloc_page(m);
>
> - for (i = 0; i < m; i++)
> + for (i = 0; i < m; i++) {
> type_map[page(p) + i] = (char)t_contiguous;
> +
> + /* SGC cont pages: Before this point, GCL never marked
> contiguous
> + pages for SGC, causing no contiguous pages to be
> + swept when SGC was on. Here we follow the behavior
> + for other pages in add_to_freelist. CM 20030827 */
> + if (sgc_enabled && tm_table[t_contiguous].tm_sgc)
> + sgc_type_map[page(p)+i]|= SGC_PAGE_FLAG;
> + }
> ncbpage += m;
> insert_contblock(p+n, PAGESIZE*m - n);
> return(p);
> @@ -484,11 +502,17 @@
>
> struct contblock **cbpp, *cbp;
>
> - if (s < CBMINSIZE)
> + /* SGC cont pages: This used to return when s<CBMINSIZE, but we need
> + to be able to sweep small (e.g. bignum) contblocks. FIXME:
> + should never be called with s<=0 to begin with. CM 20030827*/
> + if (s<=0)
> return;
> ncb++;
> cbp = (struct contblock *)p;
> - cbp->cb_size = s;
> + /* SGC cont pages: allocated sizes may not be zero mod CPTR_SIZE,
> + e.g. string fillp, but alloc_contblock rounded up the allocation
> + like this, which we follow here. CM 20030827 */
> + cbp->cb_size = ROUND_UP_PTR_CONT(s);
> for (cbpp = &cb_pointer; *cbpp; cbpp = &((*cbpp)->cb_link))
> if ((*cbpp)->cb_size >= s) {
> cbp->cb_link = *cbpp;
> @@ -568,19 +592,30 @@
> return(p);
> }
>
> +/* Add a tm_distinct field to prevent page type sharing if desired.
> + Not used now, as its never desirable from an efficiency point of
> + view, and as the only known place one must separate is cons and
> + fixnum, which are of different sizes unless PTR_ALIGN is set too
> + high (e.g. 16 on a 32bit machine). See the ordering of init_tm
> + calls for these types below -- reversing would wind up merging the
> + types with the current algorithm. CM 20030827 */
> +
> static void
> -init_tm(enum type t, char *name, int elsize, int nelts, int sgc) {
> +init_tm(enum type t, char *name, int elsize, int nelts, int sgc,int
> distinct) {
>
> int i, j;
> int maxpage;
> /* round up to next number of pages */
> maxpage = (((nelts * elsize) + PAGESIZE -1)/PAGESIZE);
> tm_table[(int)t].tm_name = name;
> - for (j = -1, i = 0; i < (int)t_end; i++)
> - if (tm_table[i].tm_size != 0 &&
> - tm_table[i].tm_size >= elsize &&
> - (j < 0 || tm_table[j].tm_size > tm_table[i].tm_size))
> - j = i;
> + j=-1;
> + if (!distinct)
> + for (i = 0; i < (int)t_end; i++)
> + if (tm_table[i].tm_size != 0 &&
> + tm_table[i].tm_size >= elsize &&
> + !tm_table[i].tm_distinct &&
> + (j < 0 || tm_table[j].tm_size > tm_table[i].tm_size))
> + j = i;
> if (j >= 0) {
> tm_table[(int)t].tm_type = (enum type)j;
> tm_table[j].tm_maxpage += maxpage;
> @@ -598,6 +633,7 @@
> /*tm_table[(int)t].tm_npage = 0; */ /* dont zero nrbpage.. */
> tm_table[(int)t].tm_maxpage = maxpage;
> tm_table[(int)t].tm_gbccount = 0;
> + tm_table[(int)t].tm_distinct=distinct;
> #ifdef SGC
> tm_table[(int)t].tm_sgc = sgc;
> tm_table[(int)t].tm_sgc_max = 3000;
> @@ -688,40 +724,46 @@
> for (i = 0; i < MAXPAGE; i++)
> type_map[i] = (char)t_other;
>
> + /* Unused (at present) tm_distinct flag added. Note that if cons
> + and fixnum share page types, errors will be introduced.
> +
> + Gave each page type at least some sgc pages by default. Of
> + course changeable by allocate-sgc. CM 20030827 */
> +
> init_tm(t_fixnum, "NFIXNUM",
> - sizeof(struct fixnum_struct), 8192,20);
> - init_tm(t_cons, ".CONS", sizeof(struct cons), 65536 ,50 );
> - init_tm(t_structure, "SSTRUCTURE", sizeof(struct structure), 5461,0 );
> - init_tm(t_cfun, "fCFUN", sizeof(struct cfun), 4096,0 );
> - init_tm(t_sfun, "gSFUN", sizeof(struct sfun),409,0 );
> - init_tm(t_string, "\"STRING", sizeof(struct string), 5461,1 );
> - init_tm(t_array, "aARRAY", sizeof(struct array), 4681,1 );
> - init_tm(t_symbol, "|SYMBOL", sizeof(struct symbol), 3640,1 );
> - init_tm(t_bignum, "BBIGNUM", sizeof(struct bignum), 2730,0 );
> - init_tm(t_ratio, "RRATIONAL", sizeof(struct ratio), 170,0 );
> + sizeof(struct fixnum_struct), 8192,20,0);
> + init_tm(t_cons, ".CONS", sizeof(struct cons), 65536 ,50,0 );
> + init_tm(t_structure, "SSTRUCTURE", sizeof(struct structure), 5461,1,0 );
> + init_tm(t_cfun, "fCFUN", sizeof(struct cfun), 4096,1,0 );
> + init_tm(t_sfun, "gSFUN", sizeof(struct sfun),409,1,0 );
> + init_tm(t_string, "\"STRING", sizeof(struct string), 5461,1,0 );
> + init_tm(t_array, "aARRAY", sizeof(struct array), 4681,1,0 );
> + init_tm(t_symbol, "|SYMBOL", sizeof(struct symbol), 3640,1,0 );
> + init_tm(t_bignum, "BBIGNUM", sizeof(struct bignum), 2730,1,0 );
> + init_tm(t_ratio, "RRATIONAL", sizeof(struct ratio), 170,1,0 );
> init_tm(t_shortfloat, "FSHORT-FLOAT",
> - sizeof(struct shortfloat_struct), 256 ,1);
> + sizeof(struct shortfloat_struct), 256 ,1,0);
> init_tm(t_longfloat, "LLONG-FLOAT",
> - sizeof(struct longfloat_struct), 170 ,0);
> - init_tm(t_complex, "CCOMPLEX", sizeof(struct complex), 170 ,0);
> - init_tm(t_character,"#CHARACTER",sizeof(struct character), 256 ,0);
> - init_tm(t_package, ":PACKAGE", sizeof(struct package), 2*PAGESIZE /
> sizeof(struct package),0);
> - init_tm(t_hashtable, "hHASH-TABLE", sizeof(struct hashtable), 78,0 );
> - init_tm(t_vector, "vVECTOR", sizeof(struct vector), 146 ,0);
> - init_tm(t_bitvector, "bBIT-VECTOR", sizeof(struct bitvector), 73 ,0);
> - init_tm(t_stream, "sSTREAM", sizeof(struct stream), 78 ,0);
> - init_tm(t_random, "$RANDOM-STATE", sizeof(struct random), 256 ,0);
> - init_tm(t_readtable, "rREADTABLE", sizeof(struct readtable), 256 ,0);
> - init_tm(t_pathname, "pPATHNAME", sizeof(struct pathname), 73 ,0);
> - init_tm(t_cclosure, "cCCLOSURE", sizeof(struct cclosure), 85 ,0);
> - init_tm(t_closure, "cCLOSURE", sizeof(struct cclosure), 85 ,0);
> - init_tm(t_vfun, "VVFUN", sizeof(struct vfun), 102 ,0);
> - init_tm(t_gfun, "gGFUN", sizeof(struct sfun), 0 ,0);
> - init_tm(t_afun, "AAFUN", sizeof(struct sfun), 0 ,0);
> - init_tm(t_cfdata, "cCFDATA", sizeof(struct cfdata), 102 ,0);
> - init_tm(t_spice, "!SPICE", sizeof(struct spice), 4096 ,0);
> - init_tm(t_relocatable, "%RELOCATABLE-BLOCKS", 1000,0,20);
> - init_tm(t_contiguous, "_CONTIGUOUS-BLOCKS", 1001,0,20);
> + sizeof(struct longfloat_struct), 170 ,1,0);
> + init_tm(t_complex, "CCOMPLEX", sizeof(struct complex), 170 ,1,0);
> + init_tm(t_character,"#CHARACTER",sizeof(struct character), 256 ,1,0);
> + init_tm(t_package, ":PACKAGE", sizeof(struct package), 2*PAGESIZE /
> sizeof(struct package),1,0);
> + init_tm(t_hashtable, "hHASH-TABLE", sizeof(struct hashtable), 78,1,0 );
> + init_tm(t_vector, "vVECTOR", sizeof(struct vector), 146 ,1,0);
> + init_tm(t_bitvector, "bBIT-VECTOR", sizeof(struct bitvector), 73 ,1,0);
> + init_tm(t_stream, "sSTREAM", sizeof(struct stream), 78 ,1,0);
> + init_tm(t_random, "$RANDOM-STATE", sizeof(struct random), 256 ,1,0);
> + init_tm(t_readtable, "rREADTABLE", sizeof(struct readtable), 256 ,1,0);
> + init_tm(t_pathname, "pPATHNAME", sizeof(struct pathname), 73 ,1,0);
> + init_tm(t_cclosure, "cCCLOSURE", sizeof(struct cclosure), 85 ,1,0);
> + init_tm(t_closure, "cCLOSURE", sizeof(struct cclosure), 85 ,1,0);
> + init_tm(t_vfun, "VVFUN", sizeof(struct vfun), 102 ,1,0);
> + init_tm(t_gfun, "gGFUN", sizeof(struct sfun), 0 ,1,0);
> + init_tm(t_afun, "AAFUN", sizeof(struct sfun), 0 ,1,0);
> + init_tm(t_cfdata, "cCFDATA", sizeof(struct cfdata), 102 ,1,0);
> + init_tm(t_spice, "!SPICE", sizeof(struct spice), 4096 ,1,0);
> + init_tm(t_relocatable, "%RELOCATABLE-BLOCKS", 1000,0,20,0);
> + init_tm(t_contiguous, "_CONTIGUOUS-BLOCKS", 1001,0,20,0);
> tm_table[t_relocatable].tm_nppage = PAGESIZE;
> tm_table[t_contiguous].tm_nppage = PAGESIZE;
>
> Index: o/gbc.c
> ===================================================================
> RCS file: /cvsroot/gcl/gcl/o/gbc.c,v
> retrieving revision 1.13.4.1
> diff -u -r1.13.4.1 gbc.c
> --- o/gbc.c 30 Jul 2003 15:11:12 -0000 1.13.4.1
> +++ o/gbc.c 27 Aug 2003 19:21:52 -0000
> @@ -1012,19 +1012,24 @@
> e = pagetochar(j);
> for (p = s; p < e;) {
> if (get_mark_bit((int *)p)) {
> - p += PTR_ALIGN;
> + /* SGC cont pages: cont blocks must be no smaller than
> + sizeof(struct contblock), and must not have a sweep
> + granularity greater than this amount (e.g. CPTR_ALIGN) if
> + contblock leaks are to be avoided. Used to be aligned at
> + PTR_ALIGN. CM 20030827 */
> + p += CPTR_ALIGN;
> continue;
> }
> - q = p + PTR_ALIGN;
> + q = p + CPTR_ALIGN;
> while (q < e) {
> if (!get_mark_bit((int *)q)) {
> - q += PTR_ALIGN;
> + q += CPTR_ALIGN;
> continue;
> }
> break;
> }
> insert_contblock(p, q - p);
> - p = q + PTR_ALIGN;
> + p = q + CPTR_ALIGN;
> }
> i = j + 1;
> }
> @@ -1067,8 +1072,8 @@
> if(sgc_enabled) sgc_quit();
>
> }
> -
> -
> +
> +
> #ifdef DEBUG
> debug = symbol_value(sSAgbc_messageA) != Cnil;
> #endif
> @@ -1423,8 +1428,10 @@
> if (!MAYBE_DATA_P(p) || (enum type)type_map[page(p)] != t_contiguous)
> return;
> q = p + s;
> - x = (int *)ROUND_DOWN_PTR(p);
> - y = (int *)ROUND_UP_PTR(q);
> + /* SGC cont pages: contblock pages must be no smaller than
> + sizeof(struct contblock). CM 20030827 */
> + x = (int *)ROUND_DOWN_PTR_CONT(p);
> + y = (int *)ROUND_UP_PTR_CONT(q);
> for (; x < y; x++)
> set_mark_bit(x);
> }
> Index: o/sgbc.c
> ===================================================================
> RCS file: /cvsroot/gcl/gcl/o/sgbc.c,v
> retrieving revision 1.9
> diff -u -r1.9 sgbc.c
> --- o/sgbc.c 15 Feb 2003 00:38:28 -0000 1.9
> +++ o/sgbc.c 27 Aug 2003 19:21:53 -0000
> @@ -887,19 +887,24 @@
> e = pagetochar(j);
> for (p = s; p < e;) {
> if (get_mark_bit((int *)p)) {
> - p += PTR_ALIGN;
> + /* SGC cont pages: cont blocks must be no smaller than
> + sizeof(struct contblock), and must not have a sweep
> + granularity greater than this amount (e.g. CPTR_ALIGN) if
> + contblock leaks are to be avoided. Used to be aligned at
> + PTR_ALIGN. CM 20030827 */
> + p += CPTR_ALIGN;
> continue;
> }
> - q = p + PTR_ALIGN;
> + q = p + CPTR_ALIGN;
> while (q < e) {
> if (!get_mark_bit((int *)q)) {
> - q += PTR_ALIGN;
> + q += CPTR_ALIGN;
> continue;
> }
> break;
> }
> insert_contblock(p, q - p);
> - p = q + PTR_ALIGN;
> + p = q + CPTR_ALIGN;
> }
> i = j + 1;
> }
> @@ -961,6 +966,11 @@
> return count;
> }
>
> + /* SGC cont pages: After SGC_start, old_cb_pointer will be a linked
> + list of free blocks on non-SGC pages, and cb_pointer will be
> + likewise for SGC pages. CM 20030827*/
> +static struct contblock *old_cb_pointer;
> +
> int
> sgc_start(void) {
>
> @@ -1005,7 +1015,10 @@
> count);fflush(stdout);
> #endif
> for(j=0,count=0; j <= maxp ;j++) {
> - if (free_map[j] >= minfree) {
> + /* SGC cont pages: This used to be >=, which is a definite
> + bug, as minfree could be zero, leading this type to claim
> + SGC pages not of its type in type_map. CM 20030827*/
> + if (free_map[j] > minfree) {
> sgc_type_map[j] |= (SGC_PAGE_FLAG | SGC_TEMP_WRITABLE);
> ++count;
> if (count >= tm->tm_sgc_max)
> @@ -1031,6 +1044,101 @@
> goto FIND_FREE_PAGES;
> }
> }
> +
> +/* SGC cont pages: Here we implement the contblock page division into
> + SGC and non-SGC types. Unlike the other types, we need *whole*
> + free pages for contblock SGC, as there is no psersistent data
> + element (e.g. .m) on an allocated block itself which can indicate
> + its live status. If anything on a page which is to be marked
> + read-only points to a live object on an SGC cont page, it will
> + never be marked and will be erroneously swept. It is also possible
> + for dead objects to unnecessarily mark dead regions on SGC pages
> + and delay sweeping until the pointing type is GC'ed if SGC is
> + turned off for the pointing type, e.g. tm_sgc=0. (This was so by
> + default for a number of types, including bignums, and has now been
> + corrected in init_alloc in alloc.c.) We can't get around this
> + AFAICT, as old data on (writable) SGC pages must be marked lest it
> + is lost, and (old) data on now writable non-SGC pages might point
> + to live regions on SGC pages, yet might not themselves be reachable
> + from the mark origin through an unbroken chain of writable pages.
> + In any case, the possibility of a lot of garbage marks on contblock
> + pages, especially when the blocks are small as in bignums, makes
> + necessary the sweeping of minimal contblocks to prevent leaks. CM
> + 20030827 */
> + {
> + void *p=NULL;
> + unsigned i,j,k,count;
> + struct contblock *new_cb_pointer=NULL,*tmp_cb_pointer=NULL,**cbpp;
> +
> + tm=tm_of(t_contiguous);
> +
> + /* SGC cont pages: First count whole free pages available. CM
> 20030827 */
> + for (cbpp=&cb_pointer,count=0;*cbpp;cbpp=&(*cbpp)->cb_link) {
> + p=PAGE_ROUND_UP((void *)(*cbpp));
> + k=p-((void *)(*cbpp));
> + if ((*cbpp)->cb_size<k || (*cbpp)->cb_size-k<PAGESIZE)
> + continue;
> + i=((*cbpp)->cb_size-k)/PAGESIZE;
> + count+=i;
> + }
> + count=tm->tm_sgc>count ? tm->tm_sgc - count : 0;
> +
> + if (count>0) {
> + /* SGC cont pages: allocate more if necessary, dumping possible
> + GBC freed pages onto the old contblock list. CM 20030827*/
> + p=alloc_contblock(count*PAGESIZE);
> + tmp_cb_pointer=cb_pointer;
> + cb_pointer=new_cb_pointer;
> + /* SGC cont pages: add new pages to new contblock list. p is not
> + already on any list as ensured by alloc_contblock. CM
> + 20030827 */
> + insert_contblock(p,PAGESIZE*count);
> + new_cb_pointer=cb_pointer;
> + cb_pointer=tmp_cb_pointer;
> + for (i=0;i<count;i++)
> + sgc_type_map[page(p)+i]|= SGC_PAGE_FLAG;
> + }
> +
> + for (cbpp=&cb_pointer;*cbpp;) {
> + p=PAGE_ROUND_UP((void *)(*cbpp));
> + k=p-((void *)(*cbpp));
> + if ((*cbpp)->cb_size<k || (*cbpp)->cb_size-k<PAGESIZE) {
> + cbpp=&(*cbpp)->cb_link;
> + continue;
> + }
> + i=((*cbpp)->cb_size-k)/PAGESIZE;
> + i*=PAGESIZE;
> + j=(*cbpp)->cb_size-i-k;
> + /* SGC contblock pages: remove this block from old list CM
> 20030827 */
> + *cbpp=(*cbpp)->cb_link;
> + /* SGC contblock pages: add fragments old list CM 20030827 */
> + if (k) {
> + ncb--;
> + insert_contblock(p-k,k);
> + }
> + if (j) {
> + ncb--;
> + insert_contblock(p+i,j);
> + }
> + tmp_cb_pointer=cb_pointer;
> + cb_pointer=new_cb_pointer;
> + /* SGC contblock pages: add whole pages to new list, p p-k, and
> + p+i are guaranteed to be distinct when used. CM 20030827 */
> + insert_contblock(p,i);
> + new_cb_pointer=cb_pointer;
> + cb_pointer=tmp_cb_pointer;
> + i/=PAGESIZE;
> + for (j=0;j<i;j++)
> + sgc_type_map[page(p)+j]|= SGC_PAGE_FLAG;
> + }
> +
> + /* SGC contblock pages: switch to new free SGC contblock list. CM
> + 20030827 */
> + old_cb_pointer=cb_pointer;
> + cb_pointer=new_cb_pointer;
> +
> + }
> +
> /* Now allocate the sgc relblock. We do this as the tail
> end of the ordinary rb. */
> {
> @@ -1117,6 +1225,22 @@
> return 0;
> sgc_enabled=0;
> rb_start = old_rb_start;
> +
> + /* SGC cont pages: restore contblocks, each tmp_cb_pointer coming
> + from the new list is guaranteed not to be on the old. Need to
> + grab 'next' before insert_contblock writes is. CM 20030827 */
> + {
> + struct contblock *tmp_cb_pointer,*next;
> + if (old_cb_pointer) {
> + tmp_cb_pointer=cb_pointer;
> + cb_pointer=old_cb_pointer;
> + for (;tmp_cb_pointer; tmp_cb_pointer=next) {
> + next=tmp_cb_pointer->cb_link;
> + insert_contblock((void *)tmp_cb_pointer,tmp_cb_pointer->cb_size);
> + }
> + }
> + }
> +
> for (i= t_start; i < t_contiguous ; i++)
> if (TM_BASE_TYPE_P(i)) {
> tm=tm_of(i);
>
> =============================================================================
>
> Matt Kaufmann <address@hidden> writes:
>
> > Hi, Camm --
> >
> > Below is an example where GCL 2.5.0 reports the following:
> >
> > Error: Contiguous blocks exhausted.
> > Currently, 29486 pages are allocated.
> > Use ALLOCATE-CONTIGUOUS-PAGES to expand the space.
> > Fast links are on: do (si::use-fast-links nil) for debugging
> >
> > In fact, GCL appears to go into an infinite loop at this point, until
> getting
> > to this:
> >
> > Error: Caught fatal error [memory may be damaged]
> > Fast links are on: do (si::use-fast-links nil) for debugging
> > Error signalled by SYSTEM:UNIVERSAL-ERROR-HANDLER.
> > Broken at SYSTEM:UNIVERSAL-ERROR-HANDLER. Type :H for Help.
> > >>
> >
> > The following six forms cause the error to happen. However, if either
> of the
> > first two forms is omitted, then the error goes away. Is this expected
> > behavior? This came up because an ACL2 user got the above error using
> the file
> > test3.lisp shown below. It turns out that GCL si::sgc-on is called
> before the
> > ACL2 image is saved, and that si::*top-level-hook* is set to call
> > si::allocate-relocatable-pages when ACL2 is started up.
> >
> > (si::sgc-on t)
> > (si::allocate-relocatable-pages 500)
> > (in-package "USER")
> > (compile-file "test3.lisp") ; test3.lisp is shown below
> > (load "test3")
> > (testfun 1000000 3)
> >
> > ++++++++++++++++++++++++++++++ test3.lisp ++++++++++++++++++++++++++++++
> >
> > (in-package 'user)
> > (defconstant *A* #x5A39BFA0E42A3D15)
> > (defconstant *M* (expt 2 63))
> > (defconstant *C* 1)
> >
> >
> > (defun genseed (seed)
> > (mod (+ (* *A* seed) *C*) *M*))
> >
> >
> > (defun testfun (n seed)
> > (if (or (not (integerp n)) (<= n 0))
> > seed
> > (let* ((s0 (genseed seed))
> > (s1 (genseed s0)))
> > (testfun (1- n) s1))))
> >
> > ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
> >
> > Thanks --
> > -- Matt
> >
> >
> >
>
> --
> Camm Maguire address@hidden
> ==========================================================================
> "The earth is but one country, and mankind its citizens." -- Baha'u'llah
>
>
>
> _______________________________________________
> Gcl-devel mailing list
> address@hidden
> http://mail.gnu.org/mailman/listinfo/gcl-devel
>
>
>
--
Camm Maguire address@hidden
==========================================================================
"The earth is but one country, and mankind its citizens." -- Baha'u'llah