Description: TODO: Put a short summary on the line above and replace this paragraph with a longer explanation of this change. Complete the meta-information with other relevant fields (see below for details). To make it easier, the information below has been extracted from the changelog. Adjust it or drop it. . gcl (2.6.12-12) unstable; urgency=medium . * Version_2_6_13pre13 Author: Camm Maguire --- The information above should follow the Patch Tagging Guidelines, please checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here are templates for supplementary fields that you might want to add: Origin: , Bug: Bug-Debian: https://bugs.debian.org/ Bug-Ubuntu: https://launchpad.net/bugs/ Forwarded: Reviewed-By: Last-Update: --- gcl-2.6.12.orig/configure +++ gcl-2.6.12/configure @@ -2915,10 +2915,10 @@ case $canonical in use=386-macosx if test "$build_cpu" = "x86_64" ; then CFLAGS="-m64 $CFLAGS"; - LDFLAGS="-m64 -Wl,-headerpad,72 $LDFLAGS"; + LDFLAGS="-m64 -Wl,-headerpad,72 -Wl,-no_pie $LDFLAGS"; else CFLAGS="-m32 $CFLAGS"; - LDFLAGS="-m32 -Wl,-headerpad,56 $LDFLAGS"; + LDFLAGS="-m32 -Wl,-headerpad,56 -Wl,-no_pie $LDFLAGS"; fi;; alpha-dec-osf) @@ -4203,7 +4203,7 @@ if ac_fn_c_try_run "$LINENO"; then : { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } clang="yes" - TCFLAGS="$TCFLAGS -Wno-builtin-requires-header -Wno-empty-body" + TCFLAGS="$TCFLAGS -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign" $as_echo "#define CLANG 1" >>confdefs.h @@ -4246,7 +4246,12 @@ fi if test "$GCC" = "yes" ; then TCFLAGS="$TCFLAGS -pipe" case $use in - *mingw*|*gnuwin*) + *mingw*) +# echo "WARNING: Remove -fno-zero-initialized-in-bss from makedefs if gcc less than 3.3.1." +# echo " It is otherwise needed for the Unexec stuff to work." +# if test "$enable_debug" = "yes" ; then TCFLAGS="$TCFLAGS -gstabs" ; fi + TCFLAGS="$TCFLAGS -fno-zero-initialized-in-bss -mms-bitfields";; + *gnuwin*) # echo "WARNING: Remove -fno-zero-initialized-in-bss from makedefs if gcc less than 3.3.1." # echo " It is otherwise needed for the Unexec stuff to work." # if test "$enable_debug" = "yes" ; then TCFLAGS="$TCFLAGS -gstabs" ; fi @@ -5193,7 +5198,7 @@ $as_echo_n "checking \"for leading under cat>foo.c < #include -int main() {FILE *f;double d=0.0;getc(f);cos(d);return 0;} +int main() {FILE *f;double d=0.0;getc(f);d=cos(d);return 0;} EOFF $CC -c foo.c -o foo.o if nm foo.o |grep " U " | grep "_cos" >/dev/null || nm foo.o |grep " U " | grep " _getc" >/dev/null ; then @@ -6071,7 +6076,50 @@ $as_echo "$ac_cv_lib_tirpc_xdr_double" > if test "x$ac_cv_lib_tirpc_xdr_double" = xyes; then : $as_echo "#define HAVE_XDR 1" >>confdefs.h - TLIBS="$TLIBS -ltirpc" + + TLIBS="$TLIBS -ltirpc" TCFLAGS="$TCFLAGS -I/usr/include/tirpc" +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xdr_double in -lgssrpc" >&5 +$as_echo_n "checking for xdr_double in -lgssrpc... " >&6; } +if ${ac_cv_lib_gssrpc_xdr_double+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lgssrpc $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char xdr_double (); +int +main () +{ +return xdr_double (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_gssrpc_xdr_double=yes +else + ac_cv_lib_gssrpc_xdr_double=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gssrpc_xdr_double" >&5 +$as_echo "$ac_cv_lib_gssrpc_xdr_double" >&6; } +if test "x$ac_cv_lib_gssrpc_xdr_double" = xyes; then : + +$as_echo "#define HAVE_XDR 1" >>confdefs.h + + TLIBS="$TLIBS -lgssrpc" TCFLAGS="$TCFLAGS -I/usr/include/gssrpc" else { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xdr_double in -lrpc" >&5 $as_echo_n "checking for xdr_double in -lrpc... " >&6; } @@ -6112,7 +6160,8 @@ $as_echo "$ac_cv_lib_rpc_xdr_double" >&6 if test "x$ac_cv_lib_rpc_xdr_double" = xyes; then : $as_echo "#define HAVE_XDR 1" >>confdefs.h - TLIBS="$TLIBS -lrpc" + + TLIBS="$TLIBS -lrpc" TCFLAGS="$TCFLAGS -I/usr/include/rpc" else { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xdr_double in -loncrpc" >&5 $as_echo_n "checking for xdr_double in -loncrpc... " >&6; } @@ -6153,7 +6202,10 @@ $as_echo "$ac_cv_lib_oncrpc_xdr_double" if test "x$ac_cv_lib_oncrpc_xdr_double" = xyes; then : $as_echo "#define HAVE_XDR 1" >>confdefs.h - TLIBS="$TLIBS -loncrpc" + + TLIBS="$TLIBS -loncrpc" TCFLAGS="$TCFLAGS -I/usr/include/oncrpc" +fi + fi fi @@ -6870,7 +6922,6 @@ else #include #include - void gprof_cleanup() {}; int main(int argc,char **argv,char **envp) { #include "h/unrandomize.h" return 0;} @@ -6899,7 +6950,6 @@ else /* end confdefs.h. */ #include #include - void gprof_cleanup() {}; int main(int argc,char * argv[],char * envp[]) { FILE *f; #ifdef CAN_UNRANDOMIZE_SBRK @@ -6930,7 +6980,6 @@ else /* end confdefs.h. */ #include #include - void gprof_cleanup() {}; int main(int argc,char * argv[],char * envp[]) { FILE *f; #ifdef CAN_UNRANDOMIZE_SBRK @@ -6997,7 +7046,6 @@ else return (void *)&i; } - void gprof_cleanup() {}; int main(int argc,char **argv,char **envp) { void *v ; FILE *fp = fopen("conftest1","w"); @@ -7055,7 +7103,6 @@ else return (void *)&i; } - void gprof_cleanup() {}; int main(int argc,char **argv,char **envp) { void *v ; FILE *fp = fopen("conftest1","w"); @@ -7108,7 +7155,6 @@ else #include #include - void gprof_cleanup() {}; int main(int argc,char **argv,char **envp) { #ifdef CAN_UNRANDOMIZE_SBRK #include "h/unrandomize.h" @@ -7147,7 +7193,6 @@ else #include #include - void gprof_cleanup() {}; int main(int argc,char **argv,char **envp) { void *b,*c; FILE *fp = fopen("conftest1","w"); @@ -7200,7 +7245,6 @@ else return (void *)&i; } - void gprof_cleanup() {}; int main(int argc,char **argv,char **envp) { char *b; FILE *fp = fopen("conftest1","w"); --- gcl-2.6.12.orig/configure.in +++ gcl-2.6.12/configure.in @@ -195,10 +195,10 @@ case $canonical in use=386-macosx if test "$build_cpu" = "x86_64" ; then CFLAGS="-m64 $CFLAGS"; - LDFLAGS="-m64 -Wl,-headerpad,72 $LDFLAGS"; + LDFLAGS="-m64 -Wl,-headerpad,72 -Wl,-no_pie $LDFLAGS"; else CFLAGS="-m32 $CFLAGS"; - LDFLAGS="-m32 -Wl,-headerpad,56 $LDFLAGS"; + LDFLAGS="-m32 -Wl,-headerpad,56 -Wl,-no_pie $LDFLAGS"; fi;; alpha-dec-osf) @@ -502,7 +502,7 @@ if test "$GCC" = "yes" ; then ;}]])], [AC_MSG_RESULT([yes]) clang="yes" - TCFLAGS="$TCFLAGS -Wno-builtin-requires-header -Wno-empty-body" + TCFLAGS="$TCFLAGS -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign" AC_DEFINE([CLANG],[1],[running clang compiler])], [AC_MSG_RESULT([no]) #FIXME -Wno-unused-but-set-variable when time @@ -517,7 +517,12 @@ fi if test "$GCC" = "yes" ; then TCFLAGS="$TCFLAGS -pipe" case $use in - *mingw*|*gnuwin*) + *mingw*) +# echo "WARNING: Remove -fno-zero-initialized-in-bss from makedefs if gcc less than 3.3.1." +# echo " It is otherwise needed for the Unexec stuff to work." +# if test "$enable_debug" = "yes" ; then TCFLAGS="$TCFLAGS -gstabs" ; fi + TCFLAGS="$TCFLAGS -fno-zero-initialized-in-bss -mms-bitfields";; + *gnuwin*) # echo "WARNING: Remove -fno-zero-initialized-in-bss from makedefs if gcc less than 3.3.1." # echo " It is otherwise needed for the Unexec stuff to work." # if test "$enable_debug" = "yes" ; then TCFLAGS="$TCFLAGS -gstabs" ; fi @@ -889,7 +894,7 @@ AC_MSG_CHECKING("for leading underscore cat>foo.c < #include -int main() {FILE *f;double d=0.0;getc(f);cos(d);return 0;} +int main() {FILE *f;double d=0.0;getc(f);d=cos(d);return 0;} EOFF $CC -c foo.c -o foo.o if nm foo.o |grep " U " | grep "_cos" >/dev/null || nm foo.o |grep " U " | grep " _getc" >/dev/null ; then @@ -1160,9 +1165,14 @@ fi if test "$enable_xdr" = "yes" ; then AC_CHECK_FUNC(xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]), - AC_CHECK_LIB(tirpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) TLIBS="$TLIBS -ltirpc", - AC_CHECK_LIB(rpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) TLIBS="$TLIBS -lrpc", - AC_CHECK_LIB(oncrpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) TLIBS="$TLIBS -loncrpc")))) + AC_CHECK_LIB(tirpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) + TLIBS="$TLIBS -ltirpc" TCFLAGS="$TCFLAGS -I/usr/include/tirpc", + AC_CHECK_LIB(gssrpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) + TLIBS="$TLIBS -lgssrpc" TCFLAGS="$TCFLAGS -I/usr/include/gssrpc", + AC_CHECK_LIB(rpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) + TLIBS="$TLIBS -lrpc" TCFLAGS="$TCFLAGS -I/usr/include/rpc", + AC_CHECK_LIB(oncrpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) + TLIBS="$TLIBS -loncrpc" TCFLAGS="$TCFLAGS -I/usr/include/oncrpc"))))) fi @@ -1442,7 +1452,6 @@ if test "$HAVE_SBRK" = "1" ; then AC_LANG_SOURCE([[ #include #include - void gprof_cleanup() {}; int main(int argc,char **argv,char **envp) { #include "h/unrandomize.h" return 0;}]])], @@ -1453,7 +1462,6 @@ if test "$HAVE_SBRK" = "1" ; then AC_MSG_CHECKING([that sbrk is (now) non-random]) AC_TRY_RUN([#include #include - void gprof_cleanup() {}; int main(int argc,char * argv[],char * envp[]) { FILE *f; #ifdef CAN_UNRANDOMIZE_SBRK @@ -1468,7 +1476,6 @@ if test "$HAVE_SBRK" = "1" ; then fi AC_TRY_RUN([#include #include - void gprof_cleanup() {}; int main(int argc,char * argv[],char * envp[]) { FILE *f; #ifdef CAN_UNRANDOMIZE_SBRK @@ -1552,7 +1559,6 @@ AC_RUN_IFELSE([AC_LANG_SOURCE([[ return (void *)&i; } - void gprof_cleanup() {}; int main(int argc,char **argv,char **envp) { void *v ; FILE *fp = fopen("conftest1","w"); @@ -1586,7 +1592,6 @@ AC_RUN_IFELSE([AC_LANG_SOURCE([[ return (void *)&i; } - void gprof_cleanup() {}; int main(int argc,char **argv,char **envp) { void *v ; FILE *fp = fopen("conftest1","w"); @@ -1615,7 +1620,6 @@ AC_MSG_CHECKING(NEG_CSTACK_ADDRESS) AC_RUN_IFELSE([AC_LANG_SOURCE([[ #include #include - void gprof_cleanup() {}; int main(int argc,char **argv,char **envp) { #ifdef CAN_UNRANDOMIZE_SBRK #include "h/unrandomize.h" @@ -1632,7 +1636,6 @@ AC_MSG_CHECKING([finding CSTACK_ALIGNMEN AC_RUN_IFELSE([AC_LANG_SOURCE([[ #include #include - void gprof_cleanup() {}; int main(int argc,char **argv,char **envp) { void *b,*c; FILE *fp = fopen("conftest1","w"); @@ -1661,7 +1664,6 @@ AC_RUN_IFELSE([AC_LANG_SOURCE([[ return (void *)&i; } - void gprof_cleanup() {}; int main(int argc,char **argv,char **envp) { char *b; FILE *fp = fopen("conftest1","w"); --- gcl-2.6.12.orig/h/mingw.h +++ gcl-2.6.12/h/mingw.h @@ -243,3 +243,6 @@ extern int mingwlisten(FILE *); #include +#define NO_FILE_LOCKING /*FIXME*/ + +#define sleep(n) Sleep(1000*n) --- gcl-2.6.12.orig/h/object.h +++ gcl-2.6.12/h/object.h @@ -340,15 +340,68 @@ EXTER long holepage; /* hole pages * #define maxrbpage tm_table[t_relocatable].tm_maxpage #define rbgbccount tm_table[t_relocatable].tm_gbccount EXTER long new_holepage,starting_hole_div,starting_relb_heap_mult; - + +EXTER ufixnum recent_allocation,wait_on_abort; +EXTER double gc_alloc_min,mem_multiple,gc_page_min,gc_page_max; +EXTER bool multiprocess_memory_pool; EXTER char *new_rb_start; /* desired relblock start after next gc */ EXTER char *rb_start; /* relblock start */ EXTER char *rb_end; /* relblock end */ EXTER char *rb_limit; /* relblock limit */ EXTER char *rb_pointer; /* relblock pointer */ -/* EXTER char *rb_start1; /\* relblock start in copy space *\/ */ -/* EXTER char *rb_pointer1; /\* relblock pointer in copy space *\/ */ + +#ifndef INLINE +#define INLINE +#endif + +INLINE ufixnum +rb_size(void) { + return rb_end-rb_start; +} + +INLINE bool +rb_high(void) { + return rb_pointer>=rb_end&&rb_size(); +} + +INLINE char * +rb_begin(void) { + return rb_high() ? rb_end : rb_start; +} + +INLINE bool +rb_emptyp(void) { + return rb_pointer == rb_begin(); +} + +INLINE ufixnum +ufmin(ufixnum a,ufixnum b) { + return a<=b ? a : b; +} + +INLINE ufixnum +ufmax(ufixnum a,ufixnum b) { + return a>=b ? a : b; +} + +#include +#include +#include +INLINE int +emsg(const char *s,...) { + va_list args; + ufixnum n=0; + void *v=NULL; + va_start(args,s); + n=vsnprintf(v,n,s,args)+1; + va_end(args); + v=alloca(n); + va_start(args,s); + vsnprintf(v,n,s,args); + va_end(args); + return write(2,v,n-1) ? n : -1; +} EXTER char *heap_end; /* heap end */ EXTER char *core_end; /* core end */ --- /dev/null +++ gcl-2.6.12/h/pool.h @@ -0,0 +1,170 @@ +static ufixnum +data_pages(void) { + + return page(2*(rb_end-rb_start)+((void *)heap_end-data_start)); + +} + +#ifndef NO_FILE_LOCKING + +#include +#include +#include +#include +#include + +static int pool=-1; +static struct pool { + ufixnum pid; + ufixnum n; + ufixnum s; +} *Pool; + +static struct flock pl; + +static const char *gcl_pool="/tmp/gcl_pool"; + +static int +set_lock(void) { + + errno=0; + if (fcntl(pool,F_SETLKW,&pl)) { + if (errno==EINTR) + set_lock(); + return -1; + } + return 0; + +} + +static void +lock_pool(void) { + + pl.l_type=F_WRLCK; + massert(!set_lock()); + +} + +static void +unlock_pool(void) { + + pl.l_type=F_UNLCK; + massert(!set_lock()); + +} + +static void +register_pool(int s) { + lock_pool(); + Pool->n+=s; + Pool->s+=s*data_pages(); + unlock_pool(); +} + +static void +open_pool(void) { + + if (pool==-1) { + + struct flock f; + + massert((pool=open(gcl_pool,O_CREAT|O_RDWR,0644))!=-1); + massert(!ftruncate(pool,sizeof(struct pool))); + massert((Pool=mmap(NULL,sizeof(struct pool),PROT_READ|PROT_WRITE,MAP_SHARED,pool,0))!=(void *)-1); + + pl.l_type=F_WRLCK; + pl.l_whence=SEEK_SET; + pl.l_start=sizeof(Pool->pid);; + pl.l_len=0; + + f=pl; + f.l_start=0; + f.l_len=sizeof(Pool->pid); + + if (!fcntl(pool,F_SETLK,&f)) { + + Pool->pid=getpid(); + + lock_pool(); + Pool->n=0; + Pool->s=0; + unlock_pool(); + + f.l_type=F_UNLCK; + massert(!fcntl(pool,F_SETLK,&f)); + + fprintf(stderr,"Initializing pool\n"); + fflush(stderr); + + } + + f.l_type=F_RDLCK; + massert(!fcntl(pool,F_SETLK,&f)); + + register_pool(1); + massert(!atexit(close_pool)); + + } + +} +#endif + +void +close_pool(void) { + +#ifndef NO_FILE_LOCKING + if (pool!=-1) { + register_pool(-1); + massert(!close(pool)); + massert(!munmap(Pool,sizeof(struct pool))); + pool=-1; + } +#endif + +} + +static void +update_pool(fixnum val) { + +#ifndef NO_FILE_LOCKING + if (multiprocess_memory_pool) { + open_pool(); + lock_pool(); + Pool->s+=val; + unlock_pool(); + } +#endif + +} + +static ufixnum +get_pool(void) { + + ufixnum s; + +#ifndef NO_FILE_LOCKING + if (multiprocess_memory_pool) { + + open_pool(); + lock_pool(); + s=Pool->s; + unlock_pool(); + + } else +#endif + + s=data_pages(); + + return s; + +} + + +static void +pool_check(void) { + + /* if (pool!=-1) */ + /* massert(get_pool()==data_pages() */ + /* ||!fprintf(stderr,"%lu %lu %lu\n",get_pool(),page((void *)heap_end-data_start),page(((rb_end-rb_start))))); */ + +} --- gcl-2.6.12.orig/h/protoize.h +++ gcl-2.6.12/h/protoize.h @@ -1951,7 +1951,16 @@ ufixnum sum_maxpages(void); void -resize_hole(ufixnum,enum type); +resize_hole(ufixnum,enum type,bool); void -setup_rb(void); +setup_rb(bool); + +void +close_pool(void); + +void +gcl_cleanup(int); + +void +do_gcl_abort(void); --- gcl-2.6.12.orig/h/unrandomize.h +++ gcl-2.6.12/h/unrandomize.h @@ -49,10 +49,10 @@ } n[k]="GCL_UNRANDOMIZE=t"; n[k+1]=0; -#ifdef GCL_GPROF - gprof_cleanup(); -#endif errno=0; +#ifdef HAVE_GCL_CLEANUP + gcl_cleanup(0); +#endif execve(*a,a,n); printf("execve failure %d\n",errno); exit(-1); --- gcl-2.6.12.orig/lsp/gcl_top.lsp +++ gcl-2.6.12/lsp/gcl_top.lsp @@ -89,7 +89,7 @@ (when (boundp '*system-banner*) (format t *system-banner*) - (format t "Temporary directory for compiler files set to ~a~%" *tmp-dir*)) + (format t "Temporary directory for compiler files:~%~a~%" *tmp-dir*)) (loop (setq +++ ++ ++ + + -) --- gcl-2.6.12.orig/o/alloc.c +++ gcl-2.6.12/o/alloc.c @@ -38,6 +38,8 @@ Foundation, 675 Mass Ave, Cambridge, MA static int t_from_type(object); +#include "pool.h" + DEFVAR("*AFTER-GBC-HOOK*",sSAafter_gbc_hookA,SI,sLnil,""); DEFVAR("*IGNORE-MAXIMUM-PAGES*",sSAignore_maximum_pagesA,SI,sLt,""); @@ -67,7 +69,6 @@ sbrk1(n) long starting_hole_div=10; long starting_relb_heap_mult=2; -long new_holepage; long resv_pages=0; #ifdef BSD @@ -317,7 +318,7 @@ empty_relblock(void) { object o=sSAleaf_collection_thresholdA->s.s_dbind; sSAleaf_collection_thresholdA->s.s_dbind=make_fixnum(0); - for (;rb_pointer!=rb_start&&rb_pointer!=rb_end;) { + for (;!rb_emptyp();) { tm_table[t_relocatable].tm_adjgbccnt--; GBC(t_relocatable); } @@ -326,40 +327,44 @@ empty_relblock(void) { } void -setup_rb(void) { +setup_rb(bool preserve_rb_pointerp) { - int init=new_rb_start!=rb_start || rb_pointer>=rb_end; + int lowp=new_rb_start!=rb_start || rb_high(); + update_pool(2*(nrbpage-page(rb_size()))); rb_start=new_rb_start; rb_end=rb_start+(nrbpage<>PAGEWIDTH))); } void -resize_hole(ufixnum hp,enum type tp) { +resize_hole(ufixnum hp,enum type tp,bool in_placep) { - char *start=rb_pointer=start) || (new_rb_start=start+size)) { - fprintf(stderr,"Toggling relblock when resizing hole to %lu\n",hp); - fflush(stderr); + if (!in_placep && + ((new_start<=start && starttm_adjgbccnt--; GBC(tp); - } else - setup_rb(); + } } @@ -378,11 +383,13 @@ alloc_page(long n) { fixnum d=available_pages-nn; d*=0.2; - d=d<0.01*real_maxpage ? available_pages-n : d; + d=d<0.01*real_maxpage ? available_pages-nn : d; d=d<0 ? 0 : d; - d=new_holepage(void *)core_end) { + update_pool(nn); + pool_check(); + + } else if (v>(void *)core_end) { massert(!mbrk(v)); core_end=v; @@ -510,94 +519,6 @@ grow_linear(fixnum old, fixnum fract, fi 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-(a_)->tm_alt_npage - -static int -rebalance_maxpages(struct typemanager *my_tm,fixnum z) { - - fixnum d; - ufixnum i,j,r=(my_tm->tm_type==t_relocatable ? 2 : 1); - - - d=(z-my_tm->tm_maxpage)*r; - j=sum_maxpages(); - - if (j+d>phys_pages) { - - ufixnum k,e=j+d-phys_pages; - double f; - - for (k=0,i=t_start;ik ? k : e; - if (e+phys_pages<=j) - return 0; - - f=k ? 1.0-(double)e/k : 1.0; - - for (i=t_start;itm_maxpage*r+(phys_pages-sum_maxpages()))/r)); - - return 1; - - } else - - return set_tm_maxpage(my_tm,z); - -} - -long -opt_maxpage(struct typemanager *my_tm) { - - double x=0.0,y=0.0,z,r; - long mmax_page; - struct typemanager *tm,*tme; - long mro=0,tro=0,j; - - if (page(core_end)>0.8*real_maxpage) - return 0; - - for (tm=tm_table,tme=tm+sizeof(tm_table)/sizeof(*tm_table);tmtm_adjgbccnt; - y+=MMAX_PG(tm); - } - mmax_page=MMAX_PG(my_tm); -#if 0 - if (sgc_enabled) { - y-=(tro=sgc_count_read_only_type(-1)); - mmax_page-=(mro=sgc_count_read_only_type(my_tm->tm_type)); - } -#endif - - z=my_tm->tm_adjgbccnt/* -1 */; - z/=(1+x-0.9*my_tm->tm_adjgbccnt); - z*=(y-mmax_page)*mmax_page; - z=sqrt(z); - z=z-mmax_page>available_pages ? mmax_page+available_pages : z; - my_tm->tm_opt_maxpage=(long)(z+my_tm->tm_alt_npage)>my_tm->tm_opt_maxpage ? (long)(z+my_tm->tm_alt_npage) : my_tm->tm_opt_maxpage; - - if (z<=mmax_page) - return 0; - - r=((x-my_tm->tm_adjgbccnt)+ my_tm->tm_adjgbccnt*mmax_page/z)*(y-mmax_page+z); - r/=x*y; - - j=r<=0.95 && rebalance_maxpages(my_tm,z+mro+my_tm->tm_alt_npage); - - if (sSAnotify_optimize_maximum_pagesA->s.s_dbind!=sLnil) - printf("[type %u max %lu(%lu) opt %lu y %lu(%lu) gbcrat %f sav %f new %lu sum %lu phys %lu]\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, - my_tm->tm_maxpage,sum_maxpages(),phys_pages); - - return j ? 1 : 0; - -} static object exhausted_report(enum type t,struct typemanager *tm) { @@ -735,14 +656,12 @@ print_cb(int print) { massert(**cbppp==cbp); for (k=0;cbp && cbp->cb_size==(**cbppp)->cb_size;cbpp=&cbp->cb_link,cbp=cbp->cb_link,k++); if (print) - fprintf(stderr,"%lu %p %p %lu %lu\n",(unsigned long)(cbppp-cbsrch1),*cbppp,**cbppp,(**cbppp)->cb_size,k); + emsg("%lu %p %p %lu %lu\n",(unsigned long)(cbppp-cbsrch1),*cbppp,**cbppp,(**cbppp)->cb_size,k); } massert(cbppp==cbsrche); massert(*cbppp==cbpp); massert(!**cbppp); - fflush(stderr); - } void @@ -808,8 +727,8 @@ alloc_from_freelist(struct typemanager * break; case t_relocatable: - if (rb_pointer>rb_end && rb_pointer+n>rb_limit && rb_pointer+nrb_end && rb_pointer+n>rb_limit && rb_pointer+nn) return ((rb_pointer+=n)-n); break; @@ -847,7 +766,7 @@ too_full_p(struct typemanager *tm) { switch (tm->tm_type) { case t_relocatable: - return 100*(rb_limit-rb_pointer)cb_link) k+=cbp->cb_size; @@ -867,10 +786,31 @@ too_full_p(struct typemanager *tm) { } +static inline bool +do_gc_p(struct typemanager *tm,fixnum n) { + + ufixnum cpool,pp; + + if (!GBC_enable) + return FALSE; + + if (!sSAoptimize_maximum_pagesA || sSAoptimize_maximum_pagesA->s.s_dbind==Cnil) + return tm->tm_npage+tpage(tm,n)>tm->tm_maxpage; + + if ((cpool=get_pool())<=gc_page_min*phys_pages) + return FALSE; + + pp=gc_page_max*phys_pages; + + return page(recent_allocation)>(1.0+gc_alloc_min-(double)ufmin(cpool,pp)/pp)*data_pages(); + +} + + static inline void * alloc_after_gc(struct typemanager *tm,fixnum n) { - if (tm->tm_npage+tpage(tm,n)>tm->tm_maxpage && GBC_enable) { + if (do_gc_p(tm,n)) { switch (jmp_gmp) { case 0: /* not in gmp call*/ @@ -911,21 +851,13 @@ add_pages(struct typemanager *tm,fixnum case t_relocatable: - if (rb_pointer>rb_end && m>((rb_start-heap_end)>>PAGEWIDTH)) { - fprintf(stderr,"Moving relblock low before expanding relblock pages\n"); - fflush(stderr); + if (rb_high() && m>((rb_start-heap_end)>>PAGEWIDTH)) { + emsg("Moving relblock low before expanding relblock pages\n"); tm_table[t_relocatable].tm_adjgbccnt--; GBC(t_relocatable); } nrbpage+=m; - rb_limit+=m*PAGESIZE; - if (rb_pointer>rb_end) - rb_start-=m*PAGESIZE; - else - rb_end+=m*PAGESIZE; - - alloc_page(-(2*nrbpage+((rb_start-heap_end)>>PAGEWIDTH))); - + resize_hole(page(rb_start-heap_end)-(rb_high() ? m : 0),t_relocatable,1); break; default: @@ -1011,6 +943,8 @@ alloc_mem(struct typemanager *tm,fixnum CHECK_INTERRUPT; + recent_allocation+=n; + if ((p=alloc_from_freelist(tm,n))) return p; if ((p=alloc_after_gc(tm,n))) @@ -1135,7 +1069,7 @@ DEFUNM_NEW("ALLOCATED",object,fSallocate { struct typemanager *tm=(&tm_table[t_from_type(typ)]); tm = & tm_table[tm->tm_type]; if (tm->tm_type == t_relocatable) - { tm->tm_npage = (rb_end-rb_start)>>PAGEWIDTH; + { tm->tm_npage = page(rb_size()); tm->tm_nfree = rb_limit -rb_pointer; } else if (tm->tm_type == t_contiguous) @@ -1262,7 +1196,7 @@ object malloc_list=Cnil; void maybe_set_hole_from_maxpages(void) { if (rb_start==heap_end && rb_end==rb_start && rb_limit==rb_start && rb_pointer==rb_start) - resize_hole(new_holepage,t_relocatable); + resize_hole(available_pages/3,t_relocatable,0); } void @@ -1361,10 +1295,10 @@ gcl_init_alloc(void *cs_start) { initial_sbrk=data_start=heap_end; first_data_page=page(data_start); -#ifdef GCL_GPROF - if (new_holepage>PAGEWIDTH)); } @@ -1751,9 +1685,7 @@ DEFUN_NEW("SET-STARTING-RELBLOCK-HEAP-MU DEFUNM_NEW("SET-HOLE-SIZE",object,fSset_hole_size,SI,1,2,NONE,OO,OO,OO,OO,(object onpages,...),"") { - printf("This function is obsolete -- use SET-STARTING-HOLE-DIVISOR instead\n"); - - RETURN2(make_fixnum(new_holepage),make_fixnum(reserve_pages_for_signal_handler)); + RETURN2(make_fixnum((rb_start-heap_end)>>PAGEWIDTH),make_fixnum(reserve_pages_for_signal_handler)); } @@ -1811,7 +1743,7 @@ static char *baby_malloc(n) if ((res +m-baby_malloc_data) > sizeof(baby_malloc_data)) { printf("failed in baby malloc"); - exit(1); + do_gcl_abort(); } last_baby += m; *((int *)res)=n; @@ -1904,18 +1836,16 @@ free(void *ptr) { #endif return; } -#ifdef NOFREE_ERR - return; -#else if (ptr!=initial_monstartup_pointer_echo) { static void *old_ptr; if (old_ptr==ptr) return; old_ptr=ptr; +#ifndef NOFREE_ERR FEerror("free(3) error.",0); +#endif } initial_monstartup_pointer_echo=NULL; return; -#endif } void * --- gcl-2.6.12.orig/o/error.c +++ gcl-2.6.12/o/error.c @@ -40,8 +40,8 @@ assert_error(const char *a,unsigned l,co make_simple_string(a),make_fixnum(l), make_simple_string(f),make_simple_string(n)); else { - fprintf(stderr,"The assertion %s on line %d of %s in function %s failed",a,l,f,n); - exit(-1); + emsg("The assertion %s on line %d of %s in function %s failed",a,l,f,n); + do_gcl_abort(); } } @@ -386,7 +386,7 @@ DEFUN_NEW("UNIVERSAL-ERROR-HANDLER",obje for (i = 0; i < error_fmt_string->st.st_fillp; i++) fputc(error_fmt_string->st.st_self[i],stdout); printf("\nLisp initialization failed.\n"); - exit(0); + do_gcl_abort(); RETURN1(x0); } --- gcl-2.6.12.orig/o/fasldlsym.c +++ gcl-2.6.12/o/fasldlsym.c @@ -84,7 +84,7 @@ fasload(object faslfile) { massert(!psystem(b)); if (!(dlp = dlopen(buf,RTLD_NOW))) { - fputs(dlerror(),stderr); + emsg(dlerror()); FEerror("Cannot open for dynamic link ~a",1,make_simple_string(filename)); } @@ -94,7 +94,7 @@ fasload(object faslfile) { memcpy(b,x->st.st_self,x->st.st_fillp); b[x->st.st_fillp]=0; if (!(fptr=dlsym(dlp,b))) { - fputs(dlerror(),stderr); + emsg(dlerror()); FEerror("Cannot lookup ~a in ~a",2,make_simple_string(b),make_simple_string(filename)); } --- gcl-2.6.12.orig/o/file.d +++ gcl-2.6.12/o/file.d @@ -548,10 +548,8 @@ BEGIN: case smm_socket: - if (SOCKET_STREAM_FD(strm) < 2) { - fprintf(stderr,"tried Clsing %d ! as scoket \n",SOCKET_STREAM_FD(strm)); - fflush(stderr); - } + if (SOCKET_STREAM_FD(strm) < 2) + emsg("tried Closing %d ! as socket \n",SOCKET_STREAM_FD(strm)); else { #ifdef HAVE_NSOCKET if (GET_STREAM_FLAG(strm,gcl_sm_output)) @@ -2180,10 +2178,7 @@ FFN(siLfp_input_stream)() #ifdef HAVE_NSOCKET #ifdef DODEBUG -#define dprintf(s,arg) \ - do {fprintf(stderr,s,arg); \ - fflush(stderr); }\ - while(0) +#define dprintf(s,arg) emsg(s,arg) #else #define dprintf(s,arg) #endif @@ -2457,7 +2452,7 @@ object x=Cnil; exit(0); break; case -1: - abort(); + do_gcl_abort(); break; default: close_stream(y); --- gcl-2.6.12.orig/o/gbc.c +++ gcl-2.6.12/o/gbc.c @@ -85,11 +85,9 @@ cb_print(void) { struct contblock **cbpp; int i; - for (cbpp=&cb_pointer,i=0;*cbpp;cbpp=&((*cbpp)->cb_link),i++) { - fprintf(stderr,"%lu at %p\n",(*cbpp)->cb_size,*cbpp); - fflush(stderr); - } - fprintf(stderr,"%u blocks\n",i); + for (cbpp=&cb_pointer,i=0;*cbpp;cbpp=&((*cbpp)->cb_link),i++) + emsg("%lu at %p\n",(*cbpp)->cb_size,*cbpp); + emsg("%u blocks\n",i); return 0; } @@ -285,7 +283,6 @@ long first_protectable_page =0; static char *copy_relblock(char *p, int s); long real_maxpage; -long new_holepage; struct apage { char apage_self[PAGESIZE]; @@ -1122,7 +1119,8 @@ GBC(enum type t) { } ngc_thresh=fix(sSAleaf_collection_thresholdA->s.s_dbind); - + recent_allocation=0; + if (in_signal_handler && t == t_relocatable) error("cant gc relocatable in signal handler"); @@ -1198,7 +1196,7 @@ GBC(enum type t) { if (COLLECT_RELBLOCK_P) { static_promotion_limit=rb_starts.s_dbind->v.v_self; @@ -1337,7 +1331,7 @@ GBC(enum type t) { tm_table[(int)tm_table[i].tm_type].tm_name); } printf("contblock: %ld blocks %ld pages\n", count_contblocks(), ncbpage); - printf("hole: %ld pages\n", ((rb_start-heap_end)>>PAGEWIDTH)); + printf("hole: %lu pages\n", (ufixnum)page(rb_start-heap_end)); printf("relblock: %ld bytes used %ld bytes free %ld pages\n", (long)(rb_pointer - rb_start), (long)(rb_end - rb_pointer), nrbpage); printf("GBC ended\n"); @@ -1362,34 +1356,6 @@ GBC(enum type t) { } - { - extern long opt_maxpage(struct typemanager *); - -#define IGNORE_MAX_PAGES (sSAignore_maximum_pagesA ==0 || sSAignore_maximum_pagesA->s.s_dbind !=sLnil) -#define OPTIMIZE_MAX_PAGES (sSAoptimize_maximum_pagesA ==0 || sSAoptimize_maximum_pagesA->s.s_dbind !=sLnil) - - if (IGNORE_MAX_PAGES && OPTIMIZE_MAX_PAGES) - opt_maxpage(tm_table+t); - - } - - /* {static int mv; */ - /* if (!mv && COLLECT_RELBLOCK_P) { */ - /* mv=1; */ - /* if (relb_copied) { */ - /* sSAstatic_promotion_areaA->s.s_dbind=(VFUN_NARGS=4,fSmake_vector1(make_fixnum(relb_copied),make_fixnum(aet_char),Ct,make_fixnum(0))); */ - /* fprintf(stderr,"Making static promotion area %lu bytes\n",relb_copied); */ - /* fflush(stderr); */ - /* relb_copied=0; */ - /* } else { */ - /* fprintf(stderr,"Releasing static promotion area\n"); */ - /* fflush(stderr); */ - /* sSAstatic_promotion_areaA->s.s_dbind=Cnil; */ - /* } */ - /* mv=0; */ - /* } */ - /* } */ - collect_both=0; END_NO_INTERRUPT; @@ -1449,8 +1415,8 @@ FFN(siLroom_report)(void) { vs_push(make_fixnum(count_contblocks())); vs_push(make_fixnum(cbgbccount)); vs_push(make_fixnum((rb_start-heap_end)>>PAGEWIDTH)); - vs_push(make_fixnum(rb_pointer - (rb_pointercb_size,p=*cbpp;*cbpp && (*cbpp)->cb_size==s;i+=(*cbpp)->cb_size,j++,k++,cbpp=&(*cbpp)->cb_link); - fprintf(stderr,"%lu %lu starting at %p\n",k,s,p); + emsg("%lu %lu starting at %p\n",k,s,p); } - fprintf(stderr,"\nTotal free %lu in %lu pieces\n\n",i,j); + emsg("\nTotal free %lu in %lu pieces\n\n",i,j); for (i=j=k=0;kv.v_fillp && (v=(void *)contblock_array->v.v_self[k]);k++,i+=v->in_use,j++) - 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); + emsg("%lu pages at %p\n",(unsigned long)v->in_use,v); + emsg("\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) { @@ -1548,13 +1514,13 @@ DEFUN_NEW("CONTIGUOUS-REPORT",object,fSc for (p=pagetochar(page(v)),k=0;ktm_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); + emsg("%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); + emsg("\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); @@ -1616,14 +1582,14 @@ DEFUN_NEW("CONTIGUOUS-REPORT",object,fSc 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); + emsg("%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); + emsg("\nTotal leaf bytes %lu in %lu pieces\n",i,j); return Cnil; --- gcl-2.6.12.orig/o/gcl_readline.d +++ gcl-2.6.12/o/gcl_readline.d @@ -42,6 +42,8 @@ Foundation, 675 Mass Ave, Cambridge, MA #include #include #include +#include +#include #include #include --- gcl-2.6.12.orig/o/gmp.c +++ gcl-2.6.12/o/gmp.c @@ -9,7 +9,7 @@ static void *gcl_gmp_realloc(void *oldme { unsigned int *old,*new; if (!jmp_gmp) { /* No gc in alloc if jmp_gmp */ - if (MP_SELF(big_gcprotect)) abort(); + if (MP_SELF(big_gcprotect)) do_gcl_abort(); MP_SELF(big_gcprotect)=oldmem; MP_ALLOCATED(big_gcprotect)=oldsize/MP_LIMB_SIZE; } --- gcl-2.6.12.orig/o/main.c +++ gcl-2.6.12/o/main.c @@ -204,26 +204,89 @@ get_proc_meminfo_value_in_pages(const ch massert(!strncmp(c+m," kB\n",4)); return n>>(PAGEWIDTH-10); } - + static ufixnum get_phys_pages_no_malloc(char freep) { - ufixnum k=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:"); - const char *e=getenv("GCL_MEM_MULTIPLE"); - if (e) { - double d; - massert(sscanf(e,"%lf",&d)==1); - massert(d>=0.0); - k*=d; - } - return k; + } #endif +static ufixnum +get_phys_pages(char freep) { + + return get_phys_pages_no_malloc(freep); + +} + +static void +get_gc_environ(void) { + + const char *e;; + + mem_multiple=1.0; + if ((e=getenv("GCL_MEM_MULTIPLE"))) { + massert(sscanf(e,"%lf",&mem_multiple)==1); + massert(mem_multiple>=0.0); + } + + gc_alloc_min=0.1; + if ((e=getenv("GCL_GC_ALLOC_MIN"))) { + massert(sscanf(e,"%lf",&gc_alloc_min)==1); + massert(gc_alloc_min>=0.0); + } + + gc_page_min=0.5; + if ((e=getenv("GCL_GC_PAGE_THRESH"))) { + massert(sscanf(e,"%lf",&gc_page_min)==1); + massert(gc_page_min>=0.0); + } + + gc_page_max=0.75; + if ((e=getenv("GCL_GC_PAGE_MAX"))) { + massert(sscanf(e,"%lf",&gc_page_max)==1); + massert(gc_page_max>=0.0); + } + + multiprocess_memory_pool=(e=getenv("GCL_MULTIPROCESS_MEMORY_POOL")) && *e; + + wait_on_abort=0; + if ((e=getenv("GCL_WAIT_ON_ABORT"))) + massert(sscanf(e,"%lu",&wait_on_abort)==1); + +} + +static void +setup_maxpages(double scale) { + + void *beg=data_start ? data_start : sbrk(0); + ufixnum maxpages=real_maxpage-page(beg),npages,i; + + for (npages=0,i=t_start;i=npages); + + maxpages*=scale; + phys_pages*=scale; + real_maxpage=maxpages+page(beg); + + resv_pages=available_pages=0; + available_pages=check_avail_pages(); + + resv_pages=40PAGESIZE;j>>=1) @@ -253,44 +313,11 @@ update_real_maxpage(void) { } massert(!mbrk(cur)); -/* 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 */ + phys_pages=ufmin(get_phys_pages(0)+page(beg),real_maxpage)-page(beg); - maxpages=real_maxpage-page(beg); - - phys_pages=phys_pages>maxpages ? maxpages : phys_pages; - - resv_pages=available_pages=0; - available_pages=check_avail_pages(); + get_gc_environ(); + setup_maxpages(mem_multiple); - for (i=t_start;is.s_dbind!=Cnil) { - - for (i=t_start,j=0;i>1); - } - - new_holepage=0; - for (i=t_start;i= dend) { minimize_image(); - log_maxpage_bound=l; + log_maxpage_bound=l;/*FIXME maybe this should be under mem_multiple, not over*/ update_real_maxpage(); maybe_set_hole_from_maxpages(); } @@ -384,6 +410,43 @@ gcl_mprotect(void *v,unsigned long l,int DEFVAR("*CODE-BLOCK-RESERVE*",sSAcode_block_reserveA,SI,Cnil,""); +#define HAVE_GCL_CLEANUP + +void +gcl_cleanup(int gc) { + + if (getenv("GCL_WAIT")) + sleep(30); + +#ifdef CLEANUP_CODE + CLEANUP_CODE +#elif defined(USE_CLEANUP) + {extern void _cleanup(void);_cleanup();} +#endif + +#ifdef GCL_GPROF + gprof_cleanup(); +#endif + + if (gc) { + + saving_system=TRUE; + GBC(t_other); + saving_system=FALSE; + + minimize_image(); + + raw_image=FALSE; + cs_org=0; + initial_sbrk=core_end; + + } + + close_pool(); + +} + + int main(int argc, char **argv, char **envp) { @@ -497,6 +560,14 @@ void install_segmentation_catcher(void) (void) gcl_signal(SIGBUS,segmentation_catcher); } +void +do_gcl_abort(void) { + if (wait_on_abort) + sleep(wait_on_abort); + gcl_cleanup(0); + abort(); +} + int catch_fatal=1; void error(char *s) @@ -512,7 +583,7 @@ error(char *s) FEerror("Caught fatal error [memory may be damaged]",0); } printf("\nUnrecoverable error: %s.\n", s); fflush(stdout); - abort(); + do_gcl_abort(); } static void @@ -529,7 +600,7 @@ initlisp(void) { || NULL_OR_ON_C_STACK(pagetoinfo(first_data_page)) || NULL_OR_ON_C_STACK(core_end-1)) { /* check person has correct definition of above */ - fprintf(stderr,"%p %d " + emsg("%p %d " #if defined(IM_FIX_BASE) "%p %d %p %d " #endif @@ -941,7 +1012,7 @@ static void FFN(siLinitialization_failure)(void) { check_arg(0); printf("lisp initialization failed\n"); - exit(0); + do_gcl_abort(); } DEFUNO_NEW("IDENTITY",object,fLidentity,LISP @@ -970,7 +1041,6 @@ DEFUN_NEW("LISP-IMPLEMENTATION-VERSION", RETURN1((make_simple_string(LISP_IMPLEMENTATION_VERSION))); } - static void FFN(siLsave_system)(void) { @@ -990,12 +1060,6 @@ FFN(siLsave_system)(void) { DO_BEFORE_SAVE #endif - saving_system = TRUE; - - minimize_image(); - - saving_system = FALSE; - siLsave(); } --- gcl-2.6.12.orig/o/makefile +++ gcl-2.6.12/o/makefile @@ -91,6 +91,9 @@ $(DECL): $(HDIR)/make-decl.h $(INI_FILES grab_defs: grab_defs.c ${CC} $(OFLAGS) -o grab_defs grab_defs.c +wpool: wpool.c + $(CC) $(CFLAGS) $(DEFS) -o $@ $< + $(GCLIB): ${ALIB} rm -f gcllib.a $(AR) gcllib.a ${ALIB} @@ -98,6 +101,6 @@ $(GCLIB): ${ALIB} clean: rm -f $(OBJS) ${ALIB} new_init.o $(LAST_FILE) $(FIRST_FILE) *.a grab_defs$(EXE) *.ini tmpx foo.c - rm -f cmpinclude.h new_init.c $(DECL) def undef udef.h void.h TAGS boot.h + rm -f cmpinclude.h new_init.c $(DECL) def undef udef.h void.h TAGS boot.h wpool .INTERMEDIATE: $(patsubst %.d,%.c,$(shell ls -1 *.d)) --- gcl-2.6.12.orig/o/mingwin.c +++ gcl-2.6.12/o/mingwin.c @@ -8,10 +8,7 @@ #include "stdlib.h" #ifdef DODEBUG -#define dprintf(s,arg) \ - do {fprintf(stderr,s,arg); \ - fflush(stderr); }\ - while(0) +#define dprintf(s,arg) emsg(s,arg) #else #define dprintf(s,arg) #endif @@ -237,8 +234,7 @@ InitSockets() * Initialize the winsock library and check the version number. */ if ((*winSock.WSAStartup)(MAKEWORD(2,2), &wsaData) != 0) { - fprintf(stderr,"unloading"); - fflush(stderr); + emsg("unloading"); goto unloadLibrary; } #ifdef WSA_VERSION_REQD @@ -380,10 +376,8 @@ CreateSocketAddress(sockaddrPtr, host, p #ifdef DEBUG static void myerr(char *s,int d) { - if (0) { - fprintf(stderr,s,d); - fflush(stderr); - } + if (0) + emsg(s,d); } #else @@ -769,8 +763,7 @@ sigint() #if 0 BOOL WINAPI inthandler(DWORD i) { - fprintf(stderr,"in handler %d",i); - fflush(stderr); + emsg("in handler %d",i); terminal_interrupt(1); return TRUE; } @@ -812,14 +805,14 @@ void sigterm() #ifdef SIGABRT void sigabrt() { - exit(SIGABRT); + do_gcl_abort(); } #endif void sigkill() { - exit(SIGKILL); + do_gcl_abort(); } --- gcl-2.6.12.orig/o/nsocket.c +++ gcl-2.6.12/o/nsocket.c @@ -4,10 +4,7 @@ #include #ifdef DODEBUG -#define dprintf(s,arg) \ - do {fprintf(stderr,s,arg); \ - fflush(stderr); }\ - while(0) +#define dprintf(s,arg) emsg(s,arg) #else #define dprintf(s,arg) #endif @@ -65,7 +62,7 @@ #endif #define VOID void -#define ERROR_MESSAGE(msg) do{ fprintf(stderr,msg); exit(1) ; } while(0) +#define ERROR_MESSAGE(msg) do{ emsg(msg); do_gcl_abort() ; } while(0) #ifdef STAND @@ -87,7 +84,7 @@ main(argc,argv) fd = doConnect(argv[1],atoi(argv[2])); if (fd < 0) { perror("cant connect"); - exit(1); + do_gcl_abort(); } while (1) { int high; @@ -512,8 +509,7 @@ getOneChar(FILE *fp) int high; /* fprintf(stderr,"",fp); fflush(stderr); */ - fprintf(stderr,"in getOneChar, fd=%d,fp=%p",fd,fp); - fflush(stderr); + emsg("in getOneChar, fd=%d,fp=%p",fd,fp); if (fd == 0) { joe(fd); return -1; @@ -529,16 +525,14 @@ getOneChar(FILE *fp) if (high > 0) { int ch ; - fprintf(stderr,"in getOneChar, fd=%d,fp=%p",fd,fp); - fflush(stderr); + emsg("in getOneChar, fd=%d,fp=%p",fd,fp); ch = getc(fp); if ( ch != EOF || feof(fp) ) { /* fprintf(stderr,"< 0x%x returning %d,%c>\n",fp,ch,ch); fflush(stderr); */ } - fprintf(stderr,"in getOneChar, ch= %c,%d\n",ch,ch); - fflush(stderr); + emsg("in getOneChar, ch= %c,%d\n",ch,ch); CHECK_INTERRUPT; if (ch != EOF) return ch; if (feof(fp)) return EOF; @@ -548,10 +542,7 @@ getOneChar(FILE *fp) } #ifdef DODEBUG -#define dprintf(s,arg) \ - do {fprintf(stderr,s,arg); \ - fflush(stderr); }\ - while(0) +#define dprintf(s,arg) emsg(s,arg) #else #define dprintf(s,arg) #endif --- gcl-2.6.12.orig/o/prelink.c +++ gcl-2.6.12/o/prelink.c @@ -2,6 +2,7 @@ #include "include.h" +#if !defined(__MINGW32__) && !defined(__CYGWIN__) extern FILE *stdin __attribute__((weak)); extern FILE *stderr __attribute__((weak)); extern FILE *stdout __attribute__((weak)); @@ -13,6 +14,7 @@ extern char *rl_readline_name __attribu extern rl_compentry_func_t *rl_completion_entry_function __attribute__((weak)); extern const char *rl_readline_name __attribute__((weak)); #endif +#endif void prelink_init(void) { --- gcl-2.6.12.orig/o/print.d +++ gcl-2.6.12/o/print.d @@ -390,14 +390,14 @@ edit_double(int n, double d, int *sp, ch truncate_double(b,d,n!=7); - if (isdigit(b[0])) { + if (isdigit((int)b[0])) { b[1]=b[0]; (*ep)++; } if (b[2]=='0') (*ep)++; b[2] = b[1]; p = b + 2; - for (i=0;i sizeof(buf)) - { fprintf(stderr,"wow that is badly defined regexp.."); - exit(1);} + { emsg("wow that is badly defined regexp.."); + do_gcl_abort();} regcp --; { char *p=buf; @@ -567,8 +567,8 @@ regatom(int *flagp) while (p < regcp) { result[*(unsigned char *)p] = matches; if (case_fold_search) - {result[tolower(*p)] = matches; - result[toupper(*p)] = matches; p++;} + {result[tolower((int)*p)] = matches; + result[toupper((int)*p)] = matches; p++;} else result[*(unsigned char *)p++] = matches; @@ -912,9 +912,9 @@ regexec(register regexp *prog, register if (prog->regstart != '\0') /* We know what char it must start with. */ { if (case_fold_search) - {char ch = tolower(prog->regstart); + {char ch = tolower((int)prog->regstart); while (*s) - { if (tolower(*s)==ch) + { if (tolower((int)*s)==ch) {if (regtry(prog, s)) RETURN_VAL(1);} s++;}} @@ -1025,12 +1025,12 @@ regmatch(char *prog) scan = prog; #ifdef DEBUG if (scan != NULL && regnarrate) - fprintf(stderr, "%s(\n", regprop(scan)); + emsg("%s(\n", regprop(scan)); #endif while (scan != NULL) { #ifdef DEBUG if (regnarrate) - fprintf(stderr, "%s...\n", regprop(scan)); + emsg("%s...\n", regprop(scan)); #endif next = regnext(scan); @@ -1055,7 +1055,7 @@ regmatch(char *prog) opnd = OPERAND(scan); if (case_fold_search) while (*opnd ) - { if (tolower(*opnd) != tolower(*ch)) + { if (tolower((int)*opnd) != tolower((int)*ch)) return 0; else { ch++; opnd++;}} else @@ -1175,7 +1175,7 @@ regmatch(char *prog) if (OP(next) == EXACTLY) nextch = *OPERAND(next); if (case_fold_search) - nextch = tolower(nextch); + nextch = tolower((int)nextch); min = (OP(scan) == STAR) ? 0 : 1; save = reginput; no = regrepeat(OPERAND(scan)); @@ -1184,7 +1184,7 @@ regmatch(char *prog) if (nextch == '\0' || *reginput == nextch || (case_fold_search && - tolower(*reginput) == nextch)) + tolower((int)*reginput) == nextch)) if (regmatch(next)) return(1); /* Couldn't or didn't -- back up. */ @@ -1237,8 +1237,8 @@ regrepeat(char *p) case EXACTLY: { char ch = *opnd; if (case_fold_search) - { ch = tolower(*opnd); - while (ch == tolower(*scan)) + { ch = tolower((int)*opnd); + while (ch == tolower((int)*scan)) { count++; scan++;}} @@ -1488,7 +1488,7 @@ min_initial_branch_length(regexp *x, uns { op = OP(s); next = (s) + NEXT(s); if (op != END && op != BRANCH) - abort(); + do_gcl_abort(); s = s+3; { int this = 0; int anythis =0; @@ -1509,8 +1509,8 @@ min_initial_branch_length(regexp *x, uns n--; while(1) { if (case_fold_search) - {MINIMIZE(buf[tolower(*ss)],n); - MINIMIZE(buf[toupper(*ss)],n); + {MINIMIZE(buf[tolower((int)*ss)],n); + MINIMIZE(buf[toupper((int)*ss)],n); } else { MINIMIZE(buf[*(unsigned char *)ss],n);} @@ -1575,7 +1575,7 @@ min_initial_branch_length(regexp *x, uns void regerror(char *s) { - fprintf(stderr, "regexp error %s\n", s); + emsg("regexp error %s\n", s); } #endif --- gcl-2.6.12.orig/o/run_process.c +++ gcl-2.6.12/o/run_process.c @@ -140,19 +140,19 @@ void run_process ( char *name ) if ( ! CloseHandle ( hChildStderrWrite ) ) DisplayError ( "CloseHandle: Error write" ); #if 0 - fprintf ( stderr, "Before write\n" ); + emsg("Before write\n" ); WriteFile ( hChildStdinWrite, chBuf, strlen ( chBuf ), &dwWritten, NULL); FlushFileBuffers ( hChildStdinWrite ); FlushFileBuffers ( hChildStdoutRead ); - fprintf ( stderr, "Before read\n" ); + emsg("Before read\n" ); if ( ! ReadFile( hChildStdoutRead, chBuf, 2, &dwRead, NULL ) || dwRead == 0 ) { DisplayError ( "Nothing read\n" ); } else { - fprintf ( stderr, "Got Back: %s\n", chBuf ); + emsg("Got Back: %s\n", chBuf ); } - fprintf ( stderr, "After read\n" ); + emsg("After read\n" ); #endif @@ -168,8 +168,7 @@ void run_process ( char *name ) fprintf ( ifp, "button .wibble\n" ); fflush (ifp); fgets ( buf, 2, ofp ); - fprintf ( stderr, - "run_process: ofd = %x, ofp = %x, ifd = %x, ifp = %x, buf[0] = %x, buf[1] = %x, buf = %s\n", + emsg("run_process: ofd = %x, ofp = %x, ifd = %x, ifp = %x, buf[0] = %x, buf[1] = %x, buf = %s\n", ofd, ofp, ifd, ifp, buf[0], buf[1], buf ); } #endif @@ -276,7 +275,7 @@ void siLrun_process() strcat ( cmdline, " "); } strcat ( cmdline, vs_base[i]->st.st_self ); - fprintf ( stderr, "siLrun_process: cmdline=%s\n", cmdline ); + emsg("siLrun_process: cmdline=%s\n", cmdline ); argc++; } signals_allowed = sig_at_read; @@ -540,12 +539,11 @@ char **argv; massert(dup(fdin)>=0); close(1); massert(dup(fdout)>=0); - fprintf(stderr, "\n***** Spawning process %s ", pname); + emsg("\n***** Spawning process %s ", pname); if (execvp(pname, argv) == -1) { - fprintf(stderr, "\n***** Error in process spawning *******"); - fflush(stderr); - exit(1); + emsg("\n***** Error in process spawning *******"); + do_gcl_abort(); } } @@ -604,7 +602,7 @@ getpagesize() } dlclose() -{fprintf(stderr,"calling 'dl' function sun did not supply..exitting") ;exit(1);} +{emsg("calling 'dl' function sun did not supply..exitting") ;do_gcl_abort();} dgettext() {dlclose();} dlopen() --- gcl-2.6.12.orig/o/save.c +++ gcl-2.6.12/o/save.c @@ -20,21 +20,12 @@ LFD(siLsave)(void) { char filename[256]; extern char *kcl_self; - extern void *initial_sbrk; check_arg(1); check_type_or_pathname_string_symbol_stream(&vs_base[0]); coerce_to_filename(vs_base[0], filename); -#ifdef CLEANUP_CODE - CLEANUP_CODE -#elif defined(USE_CLEANUP) - _cleanup(); -#endif - - raw_image=FALSE; - cs_org=0; - initial_sbrk=core_end; + gcl_cleanup(1); #ifdef MEMORY_SAVE MEMORY_SAVE(kcl_self,filename); --- gcl-2.6.12.orig/o/sfaslcoff.c +++ gcl-2.6.12/o/sfaslcoff.c @@ -175,7 +175,7 @@ relocate_symbols(struct syment *sym,stru if ((answ=find_sym_ptable(s))) sym->n_value=answ->address; else - massert(!fprintf(stderr,"Unrelocated non-local symbol: %s\n",s)); + massert(!emsg("Unrelocated non-local symbol: %s\n",s)); if (c) sym->n.n_name[8]=c; --- gcl-2.6.12.orig/o/sfaslelf.c +++ gcl-2.6.12/o/sfaslelf.c @@ -181,7 +181,7 @@ relocate(Sym *sym1,void *v,ul a,ul start #include RELOC_H default: - fprintf(stderr, "Unknown reloc type %lu\n", tp); + emsg("Unknown reloc type %lu\n", tp); massert(tp&~tp); } @@ -234,7 +234,7 @@ relocate_symbols(Sym *sym,Sym *syme,Shdr sym->st_value=a->address; else if (ELF_ST_BIND(sym->st_info)!=STB_LOCAL) - massert(!fprintf(stderr,"Unrelocated non-local symbol: %s\n",st1+sym->st_name)); + massert(!emsg("Unrelocated non-local symbol: %s\n",st1+sym->st_name)); } --- gcl-2.6.12.orig/o/sfasli.c +++ gcl-2.6.12/o/sfasli.c @@ -146,6 +146,15 @@ use_symbols(double d,...) { } #endif +#else +int +use_symbols(double d,...) { + + d=sin(d)+cos(d); + + return (int)d; + +} #endif void --- gcl-2.6.12.orig/o/sfaslmacho.c +++ gcl-2.6.12/o/sfaslmacho.c @@ -144,7 +144,7 @@ relocate_symbols(struct nlist *n1,struct else if ((nd=find_sym_ptable(st1+n->n_un.n_strx))) n->n_value=nd->address; else if (n->n_type&(N_PEXT|N_EXT)) - massert(!fprintf(stderr,"Unrelocated non-local symbol: %s\n",st1+n->n_un.n_strx)); + massert(!emsg("Unrelocated non-local symbol: %s\n",st1+n->n_un.n_strx)); return 0; --- gcl-2.6.12.orig/o/sfaslmacosx.c +++ gcl-2.6.12/o/sfaslmacosx.c @@ -37,17 +37,7 @@ typedef int (*func) (); /* Externalize the command line used to build loadable object files (a.k.a. bundles). */ object sSAmacosx_ldcmdA = 0L; -static void sfasl_error (char *format, ...) -{ - va_list ap; - - va_start (ap, format); - fprintf (stderr, "fasload: "); - vfprintf (stderr, format, ap); - fprintf (stderr, "\n"); - va_end (ap); - exit (1); -} +#define sfasl_error(a,b...) {emsg(a,b);do_gcl_abort();} /* static void get_init_name (object faslfile, char *init_fun) */ /* { */ --- gcl-2.6.12.orig/o/sgbc.c +++ gcl-2.6.12/o/sgbc.c @@ -266,32 +266,32 @@ overlap_check(struct contblock *t1,struc if (!inheap(t1)) { fprintf(stderr,"%p not in heap\n",t1); - exit(1); + do_gcl_abort(); } for (p=t2;p;p=p->cb_link) { if (!inheap(p)) { fprintf(stderr,"%p not in heap\n",t1); - exit(1); + do_gcl_abort(); } 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); + do_gcl_abort(); } if (p==p->cb_link) { fprintf(stderr,"circle detected at %p\n",p); - exit(1); + do_gcl_abort(); } } if (t1==t1->cb_link) { fprintf(stderr,"circle detected at %p\n",t1); - exit(1); + do_gcl_abort(); } } @@ -365,7 +365,7 @@ memprotect_handler_test(int sig, long co if (memprotect_handler_invocations) { memprotect_result=memprotect_multiple_invocations; - exit(-1); + do_gcl_abort(); } memprotect_handler_invocations=1; if (faddr!=memprotect_test_address) @@ -387,7 +387,7 @@ memprotect_test(void) { return memprotect_result!=memprotect_success; if (atexit(memprotect_print)) { fprintf(stderr,"Cannot setup memprotect_print on exit\n"); - exit(-1); + do_gcl_abort(); } if (!(b1=alloca(2*p))) { --- gcl-2.6.12.orig/o/sockets.c +++ gcl-2.6.12/o/sockets.c @@ -70,7 +70,7 @@ int w32_socket_init(void) } else { if (WSAStartup(0x0101, &WSAData)) { w32_socket_initialisations = 0; - fprintf ( stderr, "WSAStartup failed\n" ); + emsg("WSAStartup failed\n" ); WSACleanup(); rv = -1; } @@ -158,13 +158,9 @@ the socket. If PORT is zero do automati #endif (cRetry < BIND_MAX_RETRY)); if (0) - { - fprintf(stderr, - "\nAssigned automatic address to socket : port(%d), errno(%d), bind_rc(%d), iLastAddressUsed(%d), retries(%d)\n" + emsg("\nAssigned automatic address to socket : port(%d), errno(%d), bind_rc(%d), iLastAddressUsed(%d), retries(%d)\n" , addr.sin_port, errno, rc, iLastAddressUsed, cRetry ); - fflush(stderr); - } } else { @@ -221,8 +217,7 @@ and returns (list* named_socket fd name1 fd = accept(fix(car(named_socket)) , (struct sockaddr *)&addr, &n); if (fd < 0) { - perror("ERROR ! accept on socket failed in sock_accept_connection"); - fflush(stderr); + emsg("ERROR ! accept on socket failed in sock_accept_connection"); return Cnil; } x = alloc_simple_string(sizeof(struct connection_state)); @@ -432,7 +427,7 @@ fill pointer, and this will be advanced. break; - default: abort(); + default: do_gcl_abort(); } switch (t) { @@ -446,7 +441,7 @@ fill pointer, and this will be advanced. if (downcase) while (--len>=0) { char c = *p++; - c=tolower(c); + c=tolower((int)c); if(needs_quoting[(unsigned char)c]) PUSH('\\'); PUSH(c);} --- gcl-2.6.12.orig/o/unexelf.c +++ gcl-2.6.12/o/unexelf.c @@ -401,7 +401,7 @@ Filesz Memsz Flags Alig Instead we read the whole file, modify it, and write it out. */ #ifndef emacs -#define fatal(a, b...) fprintf (stderr, a, ##b), exit (1) +#define fatal(a, b...) emsg(a,##b),do_gcl_abort() #else #include "config.h" extern void fatal (char *, ...); @@ -604,7 +604,7 @@ find_section (char *name, char *section_ for (idx = 1; idx < old_file_h->e_shnum; idx++) { #ifdef DEBUG - fprintf (stderr, "Looking for %s - found %s\n", name, + emsg("Looking for %s - found %s\n", name, section_names + OLD_SECTION_H (idx).sh_name); #endif if (!strcmp (section_names + OLD_SECTION_H (idx).sh_name, @@ -752,13 +752,13 @@ unexec (char *new_name, char *old_name, (new_data2_addr - OLD_SECTION_H (old_data_index).sh_addr); #ifdef DEBUG - fprintf (stderr, "old_bss_index %d\n", old_bss_index); - fprintf (stderr, "old_bss_addr %x\n", old_bss_addr); - fprintf (stderr, "old_bss_size %x\n", old_bss_size); - fprintf (stderr, "new_bss_addr %x\n", new_bss_addr); - fprintf (stderr, "new_data2_addr %x\n", new_data2_addr); - fprintf (stderr, "new_data2_size %x\n", new_data2_size); - fprintf (stderr, "new_data2_offset %x\n", new_data2_offset); + emsg("old_bss_index %d\n", old_bss_index); + emsg("old_bss_addr %x\n", old_bss_addr); + emsg("old_bss_size %x\n", old_bss_size); + emsg("new_bss_addr %x\n", new_bss_addr); + emsg("new_data2_addr %x\n", new_data2_addr); + emsg("new_data2_size %x\n", new_data2_size); + emsg("new_data2_offset %x\n", new_data2_offset); #endif if ((unsigned) new_bss_addr < (unsigned) old_bss_addr + old_bss_size) @@ -806,10 +806,10 @@ unexec (char *new_name, char *old_name, new_file_h->e_shnum += 1; #ifdef DEBUG - fprintf (stderr, "Old section offset %x\n", old_file_h->e_shoff); - fprintf (stderr, "Old section count %d\n", old_file_h->e_shnum); - fprintf (stderr, "New section offset %x\n", new_file_h->e_shoff); - fprintf (stderr, "New section count %d\n", new_file_h->e_shnum); + emsg("Old section offset %x\n", old_file_h->e_shoff); + emsg("Old section count %d\n", old_file_h->e_shnum); + emsg("New section offset %x\n", new_file_h->e_shoff); + emsg("New section count %d\n", new_file_h->e_shnum); #endif /* Fix up a new program header. Extend the writable data segment so --- gcl-2.6.12.orig/o/unexmacosx.c +++ gcl-2.6.12/o/unexmacosx.c @@ -299,18 +299,7 @@ unexec_copy (off_t dest, off_t src, ssiz /* Debugging and informational messages routines. */ -static void -unexec_error (char *format, ...) -{ - va_list ap; - - va_start (ap, format); - fprintf (stderr, "unexec: "); - vfprintf (stderr, format, ap); - fprintf (stderr, "\n"); - va_end (ap); - exit (1); -} +#define unexec_error(a,b...) emsg(a,##b),do_gcl_abort() /* More informational messages routines. */ --- gcl-2.6.12.orig/o/unexnt.c +++ gcl-2.6.12/o/unexnt.c @@ -108,7 +108,7 @@ void recreate_heap1() if (GetModuleFileName (NULL, executable_path, MAX_PATH) == 0) { printf ("Failed to find path for executable.\n"); - exit (1); + do_gcl_abort(); } recreate_heap (executable_path); } @@ -156,7 +156,7 @@ _start (void) if (GetModuleFileName (NULL, executable_path, MAX_PATH) == 0) { printf ("Failed to find path for executable.\n"); - exit (1); + do_gcl_abort(); } #if 1 @@ -214,7 +214,7 @@ unexec (char *new_name, char *old_name, void *entry_address) { #ifdef __CYGWIN32__ - file_data in_file, out_file; + static file_data in_file, out_file; char out_filename[MAX_PATH], in_filename[MAX_PATH]; char filename[MAX_PATH]; unsigned long size; @@ -244,7 +244,7 @@ unexec (char *new_name, char *old_name, strcat(filename, (strcmp (ptr, ".exe") && strcmp (ptr, ".EXE"))?".exe":""); cygwin_conv_to_full_win32_path(filename,out_filename); #else - file_data in_file, out_file; + static file_data in_file, out_file; char out_filename[MAX_PATH], in_filename[MAX_PATH]; unsigned long size; char *ptr; @@ -284,7 +284,7 @@ unexec (char *new_name, char *old_name, { printf ("Failed to open %s (%ld)...bailing.\n", in_filename, GetLastError ()); - exit (1); + do_gcl_abort(); } /* Get the interesting section info, like start and size of .bss... */ @@ -305,7 +305,7 @@ unexec (char *new_name, char *old_name, { printf ("Failed to open %s (%ld)...bailing.\n", out_filename, GetLastError ()); - exit (1); + do_gcl_abort(); } /* Set the flag (before dumping). */ @@ -452,7 +452,7 @@ get_bss_info_from_map_file (file_data *p { printf ("Failed to open map file %s, error %d...bailing out.\n", map_filename, GetLastError ()); - exit (-1); + do_gcl_abort(); } while (fgets (buffer, sizeof (buffer), map)) @@ -463,7 +463,7 @@ get_bss_info_from_map_file (file_data *p if (n != 2) { printf ("Failed to scan the .bss section line:\n%s", buffer); - exit (-1); + do_gcl_abort(); } break; } @@ -534,7 +534,7 @@ get_section_info (file_data *p_infile) if (dos_header->e_magic != IMAGE_DOS_SIGNATURE) { printf ("Unknown EXE header in %s...bailing.\n", p_infile->name); - exit (1); + do_gcl_abort(); } nt_header = (PIMAGE_NT_HEADERS) (((unsigned long) dos_header) + dos_header->e_lfanew); @@ -542,7 +542,7 @@ get_section_info (file_data *p_infile) { printf ("Failed to find IMAGE_NT_HEADER in %s...bailing.\n", p_infile->name); - exit (1); + do_gcl_abort(); } /* Check the NT header signature ... */ @@ -729,7 +729,7 @@ read_in_bss (char *filename) if (file == INVALID_HANDLE_VALUE) { i = GetLastError (); - exit (1); + do_gcl_abort(); } /* Seek to where the .bss section is tucked away after the heap... */ @@ -737,7 +737,7 @@ read_in_bss (char *filename) if (SetFilePointer (file, index, NULL, FILE_BEGIN) == 0xFFFFFFFF) { i = GetLastError (); - exit (1); + do_gcl_abort(); } @@ -746,7 +746,7 @@ read_in_bss (char *filename) if (!ReadFile (file, bss_start, bss_size, &n_read, (void *)NULL)) { i = GetLastError (); - exit (1); + do_gcl_abort(); } CloseHandle (file); @@ -767,7 +767,7 @@ map_in_heap (char *filename) if (file == INVALID_HANDLE_VALUE) { i = GetLastError (); - exit (1); + do_gcl_abort(); } size = GetFileSize (file, &upper_size); @@ -776,7 +776,7 @@ map_in_heap (char *filename) if (!file_mapping) { i = GetLastError (); - exit (1); + do_gcl_abort(); } size = get_committed_heap_size (); @@ -797,7 +797,7 @@ map_in_heap (char *filename) MEM_RESERVE | MEM_COMMIT, PAGE_READWRITE) == NULL) { i = GetLastError (); - exit (1); + do_gcl_abort(); } /* Seek to the location of the heap data in the executable. */ @@ -805,7 +805,7 @@ map_in_heap (char *filename) if (SetFilePointer (file, i, NULL, FILE_BEGIN) == 0xFFFFFFFF) { i = GetLastError (); - exit (1); + do_gcl_abort(); } /* Read in the data. */ @@ -813,7 +813,7 @@ map_in_heap (char *filename) get_committed_heap_size (), &n_read, (void *)NULL)) { i = GetLastError (); - exit (1); + do_gcl_abort(); } CloseHandle (file); @@ -1009,7 +1009,7 @@ sbrk (ptrdiff_t increment) if (((unsigned long) data_region_base & ~VALMASK) != 0) { printf ("Error: The heap was allocated in upper memory.\n"); - exit (1); + do_gcl_abort(); } data_region_end = data_region_base; @@ -1090,7 +1090,7 @@ recreate_heap (char *executable_path) { MEM_RESERVE, PAGE_NOACCESS); if (!tmp) - exit (1); + do_gcl_abort(); /* We read in the data for the .bss section from the executable first and map in the heap from the executable second to prevent --- gcl-2.6.12.orig/o/unixsave.c +++ gcl-2.6.12/o/unixsave.c @@ -105,16 +105,16 @@ char *original_file, *save_file; */ if (stdin != original || original->_file != 0) { - fprintf(stderr, "Can't open the original file.\n"); - exit(1); + emsg("Can't open the original file.\n"); + do_gcl_abort(); } setbuf(original, stdin_buf); fclose(stdout); unlink(save_file); n = open(save_file, O_CREAT|O_WRONLY, 0777); if (n != 1 || (save = fdopen(n, "w")) != stdout) { - fprintf(stderr, "Can't open the save file.\n"); - exit(1); + emsg("Can't open the save file.\n"); + do_gcl_abort(); } setbuf(save, stdout_buf); --- gcl-2.6.12.orig/o/unixsys.c +++ gcl-2.6.12/o/unixsys.c @@ -28,11 +28,6 @@ Foundation, 675 Mass Ave, Cambridge, MA #include "include.h" -#ifdef _WIN32 -#include -#define sleep(n) Sleep(1000 * n) -#endif - #ifdef ATT3B2 #include int --- gcl-2.6.12.orig/o/usig.c +++ gcl-2.6.12/o/usig.c @@ -295,12 +295,18 @@ sigio(void) {ifuncall1(sSsigio_interrupt,Cnil);} +static void +sigterm(void) +{do_gcl_abort();} + + void install_default_signals(void) { gcl_signal(SIGFPE, sigfpe3); gcl_signal(SIGPIPE, sigpipe); gcl_signal(SIGINT, sigint); + gcl_signal(SIGTERM, sigterm); gcl_signal(SIGUSR1, sigusr1); gcl_signal(SIGIO, sigio); gcl_signal(SIGALRM, sigalrm); --- gcl-2.6.12.orig/o/usig2.c +++ gcl-2.6.12/o/usig2.c @@ -259,7 +259,7 @@ before_interrupt(struct save_for_interru /* #define XS(a) *pp++ = * (void **) (&a); */ #include "usig2_aux.c" if ((pp - (&(p->save_objects)[0])) >= (sizeof(p->save_objects)/sizeof(void *))) - abort(); + do_gcl_abort(); } #define MINN(a,b) (atoken_st_dim = MINN(token->st.st_dim,tok_leng+1); --- /dev/null +++ gcl-2.6.12/o/wpool.c @@ -0,0 +1,35 @@ +#include + +#define NO_PRELINK_UNEXEC_DIVERSION +char *rb_end=NULL,*rb_start=NULL,*heap_end=NULL; +void *data_start=NULL; +int use_pool=1; + +#include "include.h" +#include "page.h" +#include "pool.h" + +/*lintian*/ +void +assert_error(const char *a,unsigned l,const char *f,const char *n) { + update_pool(0); + get_pool(); + pool_check(); +} + +int +main(int argc,char * argv[],char * envp[]) { + + int s; + + sscanf(argv[1],"%d",&s); + open_pool(); + for (;;) { + lock_pool(); + fprintf(stderr,"master pid %lu %lu processess %lu pages\n",Pool->pid,Pool->n,Pool->s); + fflush(stderr); + unlock_pool(); + sleep(s); + } + return 0; +}