merging in scale_to_free_phys - gcl.git - GNU Common Lisp

diff --git a/gcl/h/object.h b/gcl/h/object.h
index f15a4044e..5eeb3dc1d 100755
--- a/gcl/h/object.h
+++ b/gcl/h/object.h

@@ -306,7 +306,7 @@ EXTER struct typemanager tm_table[ 32 /* (int) t_relocatable */];

*/

EXTER bool prefer_low_mem_contblock;

struct contblock { /* contiguous block header */

- int cb_size; /* size in bytes */

+ ufixnum cb_size; /* size in bytes */

struct contblock

*cb_link; /* contiguous block link */

};

diff --git a/gcl/h/protoize.h b/gcl/h/protoize.h
index 7b45710d0..7c94fbee4 100644
--- a/gcl/h/protoize.h
+++ b/gcl/h/protoize.h

@@ -7,7 +7,7 @@

/* alloc.c:364:OF */ extern object on_stack_cons (object x, object y); /* (x, y) object x; object y; */

/* alloc.c:376:OF */ extern object fSallocated (object typ); /* (typ) object typ; */

/* alloc.c:401:OF */ extern object fSreset_number_used (object typ); /* (typ) object typ; */

-/* alloc.c:480:OF */ extern void insert_contblock (char *p, int s); /* (p, s) char *p; int s; */

+/* alloc.c:480:OF */ extern void insert_contblock (char *p, ufixnum s); /* (p, s) char *p; int s; */

/* alloc.c:480:OF */ extern void insert_maybe_sgc_contblock (char *p, int s); /* (p, s) char *p; int s; */

/* alloc.c:611:OF */ extern void set_maxpage (void); /* () */

/* alloc.c:635:OF */ extern void gcl_init_alloc (void *); /* () */

diff --git a/gcl/o/alloc.c b/gcl/o/alloc.c
index 226d86220..2c6ff9821 100644
--- a/gcl/o/alloc.c
+++ b/gcl/o/alloc.c

@@ -395,6 +395,54 @@ DEFVAR("*OPTIMIZE-MAXIMUM-PAGES*",sSAoptimize_maximum_pagesA,SI,sLnil,"");

#define OPTIMIZE_MAX_PAGES (sSAoptimize_maximum_pagesA ==0 || sSAoptimize_maximum_pagesA->s.s_dbind !=sLnil)

DEFVAR("*NOTIFY-OPTIMIZE-MAXIMUM-PAGES*",sSAnotify_optimize_maximum_pagesA,SI,sLnil,"");

#define MMAX_PG(a_) (a_)->tm_maxpage

+static int

+rebalance_maxpages(struct typemanager *my_tm,fixnum z) {

+

+ fixnum d;

+ ufixnum i,j;

+

+

+ d=(z-my_tm->tm_maxpage)*(my_tm->tm_type==t_relocatable ? 2 : 1);

+ for (i=t_start,j=0;i<t_other;i++)

+ j+=tm_table[i].tm_maxpage;

+ j+=tm_table[t_relocatable].tm_maxpage;

+

+ if (j+d>phys_pages) {

+

+ ufixnum k=0;

+

+ for (i=t_start;i<t_other;i++)

+ if (tm_table+i!=my_tm)

+ k+=(tm_table[i].tm_maxpage-tm_table[i].tm_npage)*(i==t_relocatable ? 2 : 1);

+

+ if (k<(j+d-phys_pages))

+ return 0;

+

+ for (i=t_start;i<t_other;i++)

+ if (tm_table[i].tm_npage) {

+ if (tm_table+i==my_tm) {

+ massert(set_tm_maxpage(tm_table+i,z));

+ } else {

+ massert(set_tm_maxpage(tm_table+i,tm_table[i].tm_npage+(1.0-(double)(j+d-phys_pages)/k)*(tm_table[i].tm_maxpage-tm_table[i].tm_npage)));

+ }

+ }

+

+ /* for (i=t_start;i<t_other;i++) */

+ /* if (tm_table[i].tm_npage && tm_table[i].tm_npage>((double)phys_pages/(j+d))*(tm_table+i==my_tm ? z : tm_table[i].tm_maxpage)) */

+ /* return 0; */

+ /* for (i=t_start;i<t_other;i++) */

+ /* if (tm_table[i].tm_npage) */

+ /* massert(set_tm_maxpage(tm_table+i,((double)phys_pages/(j+d))*(tm_table+i==my_tm ? z : tm_table[i].tm_maxpage))); */

+

+ return 1;

+

+ } else

+

+ return set_tm_maxpage(my_tm,z);

+

+}

+

+

inline long

opt_maxpage(struct typemanager *my_tm) {

@@ -436,7 +484,7 @@ opt_maxpage(struct typemanager *my_tm) {

if (sSAnotify_optimize_maximum_pagesA->s.s_dbind!=sLnil)

printf("[type %u max %lu(%lu) opt %lu y %lu(%lu) gbcrat %f sav %f]\n",

my_tm->tm_type,mmax_page,mro,(long)z,(long)y,tro,(my_tm->tm_adjgbccnt-1)/(1+x-0.9*my_tm->tm_adjgbccnt),r);

- return r<=0.95 && set_tm_maxpage(my_tm,z+mro) ? 1 : 0;

+ return r<=0.95 && rebalance_maxpages(my_tm,z+mro) ? 1 : 0;

}

@@ -604,7 +652,7 @@ add_pages(struct typemanager *tm,fixnum m) {

nrbpage+=m;

rb_end=heap_end+(holepage+nrbpage)*PAGESIZE;

- rb_limit=rb_end-2*RB_GETA;

+ rb_limit=rb_end;/* rb_end-2*RB_GETA>rb_pointer+m*PAGESIZE ? rb_end-2*RB_GETA : rb_end; */

alloc_page(-(nrbpage+holepage));

@@ -842,11 +890,11 @@ DEFUN_NEW("PRINT-FREE-CONTBLOCK-LIST",object,fSprint_free_contblock_list,SI,0,0,

struct contblock *cbp,*cbp1;

for (cbp=cb_pointer;cbp;cbp=cbp->cb_link) {

- printf("%p %d\n",cbp,cbp->cb_size);

+ printf("%p %lu\n",cbp,cbp->cb_size);

for (cbp1=cbp;cbp1;cbp1=cbp1->cb_link)

if ((void *)cbp+cbp->cb_size==(void *)cbp1 ||

(void *)cbp1+cbp1->cb_size==(void *)cbp)

- printf(" adjacent to %p %d\n",cbp1,cbp1->cb_size);

+ printf(" adjacent to %p %lu\n",cbp1,cbp1->cb_size);

}

return Cnil;

@@ -854,7 +902,7 @@ DEFUN_NEW("PRINT-FREE-CONTBLOCK-LIST",object,fSprint_free_contblock_list,SI,0,0,

}

void

-insert_contblock(char *p, int s) {

+insert_contblock(char *p, ufixnum s) {

struct contblock **cbpp, *cbp;

diff --git a/gcl/o/gbc.c b/gcl/o/gbc.c
index b1cea7d18..369811975 100755
--- a/gcl/o/gbc.c
+++ b/gcl/o/gbc.c

@@ -1062,7 +1062,7 @@ contblock_sweep_phase(void) {

#ifdef DEBUG

if (debug) {

for (cbp = cb_pointer; cbp != NULL; cbp = cbp->cb_link)

- printf("%d-byte contblock\n", cbp->cb_size);

+ printf("%lud-byte contblock\n", cbp->cb_size);

fflush(stdout);

}

#endif

@@ -1540,12 +1540,142 @@ mark_contblock(void *p, int s) {

#ifdef SGC

if (!sgc_enabled || (v->sgc_flags&SGC_PAGE_FLAG))

#endif

- set_mark_bits(v,x,y);

+ set_mark_bits(v,x,y);

+ }

+

+DEFUN_NEW("CONTIGUOUS-REPORT",object,fScontiguous_report,SI,1,1,NONE,OO,OO,OO,OO,(void),"") {

+

+ struct contblock **cbpp;

+ struct pageinfo *v;

+ ufixnum i,j;

+ struct typemanager *tm=tm_of(t_cfdata);

+

+ for (i=j=0,cbpp=&cb_pointer;(*cbpp);i+=(*cbpp)->cb_size,j++,cbpp=&(*cbpp)->cb_link)

+ fprintf(stderr,"%lu at %p\n",(unsigned long)(*cbpp)->cb_size,*cbpp);

+ fprintf(stderr,"\nTotal free %lu in %lu pieces\n\n",i,j);

+

+ for (i=j=0,v=contblock_list_head;v;i+=v->in_use,j++,v=v->next)

+ fprintf(stderr,"%lu pages at %p\n",(unsigned long)v->in_use,v);

+ fprintf(stderr,"\nTotal pages %lu in %lu pieces\n\n",i,j);

+

+ for (i=j=0,v=cell_list_head;v;v=v->next)

+ if (tm->tm_type==v->type) {

+ void *p;

+ ufixnum k;

+ for (p=pagetochar(page(v)),k=0;k<tm->tm_nppage;k++,p+=tm->tm_size) {

+ object o=p;

+ if (!is_free(o) && type_of(o)==t_cfdata && (void *)o->cfd.cfd_start>=data_start) {

+ fprintf(stderr,"%lu code bytes at %p\n",(unsigned long)o->cfd.cfd_size,o->cfd.cfd_start);

+ i+=o->cfd.cfd_size;

+ j++;

+ }

+ }

+ }

+ fprintf(stderr,"\nTotal code bytes %lu in %lu pieces\n",i,j);

+

+ for (i=j=0,v=cell_list_head;v;v=v->next) {

+ struct typemanager *tm=tm_of(v->type);

+ void *p;

+ ufixnum k;

+ for (p=pagetochar(page(v)),k=0;k<tm->tm_nppage;k++,p+=tm->tm_size) {

+ object o=p;

+ void *d=NULL;

+ ufixnum s=0;

+ if (!is_free(o)) {

+ switch (type_of(o)) {

+ case t_array:

+ case t_vector:

+ d=o->a.a_self;

+ s=o->a.a_dim*sizeof(object);

+ break;

+ case t_hashtable:

+ d=o->ht.ht_self;

+ s=o->ht.ht_size*sizeof(object)*2;

+ break;

+ case t_string:

+ case t_symbol:

+ case t_bitvector:

+ d=o->a.a_self;

+ s=o->a.a_dim;

+ break;

+ case t_package:

+ d=o->p.p_external;

+ s=(o->p.p_external_size+o->p.p_internal_size)*sizeof(object);

+ break;

+ case t_bignum:

+ d=o->big.big_mpz_t._mp_d;

+ s=o->big.big_mpz_t._mp_alloc*MP_LIMB_SIZE;

+ break;

+ case t_structure:

+ d=o->str.str_self;

+ s=S_DATA(o->str.str_def)->length*sizeof(object);

+ break;

+ case t_random:

+ d=o->rnd.rnd_state._mp_seed->_mp_d;

+ s=o->rnd.rnd_state._mp_seed->_mp_alloc*MP_LIMB_SIZE;

+ break;

+ case t_cclosure:

+ d=o->cc.cc_turbo;

+ s=fix(o->cc.cc_turbo[-1]);

+ break;

+ case t_cfdata:

+ d=o->cfd.cfd_start;

+ s=o->cfd.cfd_size;

+ break;

+ case t_readtable:

+ d=o->rt.rt_self;

+ s=RTABSIZE*(sizeof(struct rtent));/*FIXME*/

+ break;

+ default:

+ break;

+ }

+ if (d>=data_start && d<(void *)heap_end && s) {

+ fprintf(stderr,"%lu %s bytes at %p\n",s,tm_table[type_of(o)].tm_name,d);

+ i+=s;

+ j++;

+ }

+ }

+ }

+ }

+ fprintf(stderr,"\nTotal leaf bytes %lu in %lu pieces\n",i,j);

+

+ return Cnil;

+

}

-DEFUN_NEW("GBC",object,fLgbc,LISP,1,1,NONE,OO,OO,OO,OO,(object x0),"") {

+DEFUN_NEW("SCALE-HEAP-TO",object,fSscale_heap_to,SI,1,1,NONE,II,OO,OO,OO,(fixnum mem),"") {

+

+ fixnum i;

+ enum type t;

+ double scale;

+

+ for (t=i=0;t<t_other;t++)

+ if (tm_table+t==tm_of(t))

+ i+=tm_table[t].tm_maxpage;

+

+ scale=(double)(mem>>PAGEWIDTH)/i;

+

+ for (t=i=0;t<t_other;t++)

+ if (tm_table+t==tm_of(t)) {

+ if (!set_tm_maxpage(tm_table+t,tm_table[t].tm_maxpage*scale))

+ FEerror("Cannot scale heap",0);

+ if (t<t_relocatable)

+ i+=tm_table[t].tm_maxpage;

+ }

+

+ if ((t=sgc_enabled))

+ sgc_quit();

+ holepage=new_holepage=i;

+ GBC(t_relocatable);

+ if (t)

+ sgc_start();

+ add_pages(tm_table+t_contiguous,tm_table[t_contiguous].tm_maxpage-ncbpage);

+ return (object)mem;

+}

- /* 1 args */

+DEFUN_NEW("GBC",object,fLgbc,LISP,1,1,NONE,OO,OO,OO,OO,(object x0),"") {

+

+ /* 1 args */

if (x0 == Ct)

GBC(t_other);

diff --git a/gcl/o/main.c b/gcl/o/main.c
index f797ac9e2..0464810ac 100755
--- a/gcl/o/main.c
+++ b/gcl/o/main.c

@@ -182,21 +182,29 @@ get_phys_pages_no_malloc(void) {

#else

ufixnum

-get_phys_pages_no_malloc(void) {

- int l;

+get_proc_meminfo_value_in_pages(const char *k) {

+ int l,m;

char b[PAGESIZE],*c;

- const char *k="MemTotal:",*f="/proc/meminfo";

- ufixnum res=0,n;

+ ufixnum n;

- if ((l=open(f,O_RDONLY))!=-1) {

- if ((n=read(l,b,sizeof(b)))<sizeof(b) &&

- !(b[n]=0) &&

- (c=strstr(b,k)) &&

- sscanf(c+strlen(k),"%lu",&n)==1)

- res=n;

- close(l);

- }

- return res>>(PAGEWIDTH-10);

+ massert((l=open("/proc/meminfo",O_RDONLY))!=-1);

+ massert((n=read(l,b,sizeof(b)))<sizeof(b));

+ b[n]=0;

+ massert(!close(l));

+ massert((c=strstr(b,k)));

+ c+=strlen(k);

+ massert(sscanf(c,"%lu%n",&n,&m)==1);

+ massert(!strncmp(c+m," kB\n",4));

+ return n>>(PAGEWIDTH-10);

+}

+

+ufixnum

+get_phys_pages_no_malloc(char freep) {

+ return freep ?

+ get_proc_meminfo_value_in_pages("MemFree:")+

+ get_proc_meminfo_value_in_pages("Buffers:")+

+ get_proc_meminfo_value_in_pages("Cached:") :

+ get_proc_meminfo_value_in_pages("MemTotal:");

}

#endif

@@ -228,13 +236,14 @@ update_real_maxpage(void) {

}

massert(!mbrk(cur));

- phys_pages=get_phys_pages_no_malloc();

+ phys_pages=get_phys_pages_no_malloc(0);

#ifdef BRK_DOES_NOT_GUARANTEE_ALLOCATION

if (phys_pages>0 && real_maxpage>phys_pages+page(beg)) real_maxpage=phys_pages+page(beg);

#endif

available_pages=real_maxpage-page(beg);

+

for (i=t_start,j=0;i<t_other;i++) {

k=tm_table[i].tm_maxpage;

if (tm_table[i].tm_type==t_relocatable)

@@ -247,11 +256,40 @@ update_real_maxpage(void) {

available_pages-=resv_pages;

new_holepage=available_pages/starting_hole_div;

- k=available_pages/20;

- j*=starting_relb_heap_mult;

- j=j<k ? j : k;

- if (maxrbpage<j)

- set_tm_maxpage(tm_table+t_relocatable,j);

+

+ if (getenv("GCL_LARGE") && strlen(getenv("GCL_LARGE"))) {

+

+ ufixnum free_phys_pages=get_phys_pages_no_malloc(1);

+

+ fprintf(stderr,"Running large\n");

+ fflush(stderr);

+

+ for (i=t_start,j=0;i<t_relocatable;i++)

+ j+=tm_table[i].tm_npage;

+ j+=tm_table[t_relocatable].tm_npage*2;

+ /* j*=3; */

+

+ if (j<free_phys_pages) {

+ for (i=t_start;i<t_other;i++)/*t_relocatable*/

+ if (tm_table[i].tm_npage)

+ massert(set_tm_maxpage(tm_table+i,((double)free_phys_pages/j)*tm_table[i].tm_npage));

+ /* massert(set_tm_maxpage(tm_table+t_relocatable,((double)free_phys_pages/j)*(j/3))); */

+ }

+

+ new_holepage=0;

+ for (i=t_start;i<t_relocatable;i++)

+ new_holepage+=tm_table[i].tm_maxpage-tm_table[i].tm_npage;

+

+ /* add_pages(tm_table+t_contiguous,4000); */

+

+ }

+

+ /* new_holepage=available_pages/starting_hole_div; */

+ /* k=available_pages/20; */

+ /* j*=starting_relb_heap_mult; */

+ /* j=j<k ? j : k; */

+ /* if (maxrbpage<j) */

+ /* set_tm_maxpage(tm_table+t_relocatable,j); */

return 0;