Blob Blame Raw
Description: <short summary of the patch>
 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 <camm@debian.org>

---
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: <vendor|upstream|other>, <url of original patch>
Bug: <url in upstream bugtracker>
Bug-Debian: https://bugs.debian.org/<bugnumber>
Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
Forwarded: <no|not-needed|url proving that it has been forwarded>
Reviewed-By: <name and email of someone who approved the patch>
Last-Update: <YYYY-MM-DD>

--- 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 <<EOFF
 #include <math.h>
 #include <stdio.h>
-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 <stdio.h>
 	        #include <stdlib.h>
-		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 <stdio.h>
 	            #include <stdlib.h>
-		    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 <stdio.h>
 	            #include <stdlib.h>
-		    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 <stdio.h>
 	#include <stdlib.h>
-	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 <stdio.h>
 	#include <stdlib.h>
-	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 <<EOFF
 #include <math.h>
 #include <stdio.h>
-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 <stdio.h>
 	        #include <stdlib.h>
-		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 <stdio.h>
 	            #include <stdlib.h>
-		    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 <stdio.h>
 	            #include <stdlib.h>
-		    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 <stdio.h>
 	#include <stdlib.h>
-	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 <stdio.h>
 	#include <stdlib.h>
-	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 <limits.h>
 
 
+#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 <unistd.h>
+#include <stdio.h>
+#include <stdarg.h>
+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 <sys/types.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+#include <sys/mman.h>
+#include <errno.h>
+
+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);
-  rb_pointer=init ? rb_start : rb_end;
-  rb_limit=rb_pointer+(nrbpage<<PAGEWIDTH);
-
+  if (!preserve_rb_pointerp)
+    rb_pointer=lowp ? rb_start : rb_end;
+  rb_limit=rb_begin()+(nrbpage<<PAGEWIDTH);
+  pool_check();
+  
   alloc_page(-(2*nrbpage+((new_rb_start-heap_end)>>PAGEWIDTH)));
  
 }
   
 void
-resize_hole(ufixnum hp,enum type tp) {
+resize_hole(ufixnum hp,enum type tp,bool in_placep) {
   
-  char *start=rb_pointer<rb_end ? rb_start : rb_end;
+  char *start=rb_begin(),*new_start=heap_end+hp*PAGESIZE;
   ufixnum size=rb_pointer-start;
 
-  new_rb_start=heap_end+hp*PAGESIZE;
-  
-  if ((new_rb_start<start && new_rb_start+size>=start) || (new_rb_start<start+size && new_rb_start+size>=start+size)) {
-    fprintf(stderr,"Toggling relblock when resizing hole to %lu\n",hp);
-    fflush(stderr);
+  if (!in_placep &&
+      ((new_start<=start && start<new_start+size) || (new_start<start+size && start+size<=new_start+size))) {
+    emsg("Toggling relblock when resizing hole to %lu\n",hp);
     tm_table[t_relocatable].tm_adjgbccnt--;
     GBC(t_relocatable);
-    return resize_hole(hp,tp);
+    return resize_hole(hp,tp,in_placep);
   }
 
-  if (size) {
+  new_rb_start=new_start;
+
+  if (!size || in_placep)
+    setup_rb(in_placep);
+  else {
     tm_of(tp)->tm_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<d ? new_holepage : d;
+      d=(available_pages/3)<d ? (available_pages/3) : d;
       
-      resize_hole(d+nn,t_relocatable);
+      emsg("Hole overrun\n");
+
+      resize_hole(d+nn,t_relocatable,0);
 
     }
   }
@@ -390,11 +397,13 @@ alloc_page(long n) {
   e=heap_end;
   v=e+nn*PAGESIZE;
 
-  if (!s)
+  if (!s) {
 
     heap_end=v;
-
-  else if (v>(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;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);
-
-    e=e>k ? k : e;
-    if (e+phys_pages<=j)
-      return 0;
-
-    f=k ? 1.0-(double)e/k : 1.0;
-
-    for (i=t_start;i<t_other;i++)
-      if (tm_table[i].tm_npage && tm_table+i!=my_tm) {
-	  massert(set_tm_maxpage(tm_table+i,tm_table[i].tm_npage+f*(tm_table[i].tm_maxpage-tm_table[i].tm_npage)));
-	}
-    
-    massert(set_tm_maxpage(my_tm,(my_tm->tm_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);tm<tme;tm++) {
-    x+=tm->tm_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+n<rb_end+nrbpage*PAGESIZE)
-      rb_limit=rb_pointer+n;
+    /* if (rb_pointer>rb_end && rb_pointer+n>rb_limit && rb_pointer+n<rb_end+nrbpage*PAGESIZE)/\**\/ */
+    /*   rb_limit=rb_pointer+n; */
     if (rb_limit-rb_pointer>n)
       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)<pf*(rb_end-rb_start);
+    return 100*(rb_limit-rb_pointer)<pf*rb_size();
     break;
   case t_contiguous:
     for (cbp=cb_pointer,k=0;cbp;cbp=cbp->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<textpage)
-     new_holepage=textpage;
-#endif
+/* #ifdef GCL_GPROF */
+/*   if (new_holepage<textpage) */
+/*      new_holepage=textpage; */
+/* #endif */
 
   /* Unused (at present) tm_distinct flag added.  Note that if cons
      and fixnum share page types, errors will be introduced.
@@ -1416,7 +1350,7 @@ gcl_init_alloc(void *cs_start) {
   set_tm_maxpage(tm_table+t_relocatable,1);
   nrbpage=0;
   
-  resize_hole(new_holepage,t_relocatable);
+  resize_hole(ufmin(phys_pages,available_pages/3),t_relocatable,0);
 #ifdef SGC	
   tm_table[(int)t_relocatable].tm_sgc = 50;
 #endif
@@ -1620,7 +1554,7 @@ DEFUN_NEW("ALLOCATED-RELOCATABLE-PAGES",
 
 DEFUN_NEW("GET-HOLE-SIZE",object,fSget_hole_size,SI,0,0,NONE,OO,OO,OO,OO,(void),"") {
   /* 0 args */
-  RETURN1((make_fixnum(new_holepage)));
+  RETURN1(make_fixnum((rb_start-heap_end)>>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_start<new_rb_start ? rb_start : new_rb_start;/*do not allow static promotion to go past this point*/
-    setup_rb();
+    setup_rb(0);
   }
   
 #ifdef DEBUG
@@ -1243,10 +1241,6 @@ GBC(enum type t) {
   
   if (COLLECT_RELBLOCK_P) {
 
-    /* rb_start = new_rb_start; */
-    /* rb_end = rb_start + nrbpage*PAGESIZE; */
-    
-
 #ifdef SGC
     if (sgc_enabled)
       wrimap=(void *)sSAwritableA->s.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_pointer<rb_end ? rb_start : rb_end)));
-  vs_push(make_fixnum((rb_pointer<rb_end ? rb_end : (rb_end+(rb_end-rb_start))) - rb_pointer));
+  vs_push(make_fixnum(rb_pointer - rb_begin()));
+  vs_push(make_fixnum((rb_begin()+rb_size()) - rb_pointer));
   vs_push(make_fixnum(nrbpage));
   vs_push(make_fixnum(maxrbpage));
   vs_push(make_fixnum(rbgbccount));
@@ -1533,13 +1499,13 @@ DEFUN_NEW("CONTIGUOUS-REPORT",object,fSc
   
   for (i=j=0,cbpp=&cb_pointer;(*cbpp);) {
     for (k=0,s=(*cbpp)->cb_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;k<contblock_array->v.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;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);
+ 	  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 <stdio.h>
 #include <stdlib.h>
 #include <unistd.h>
+#include <sys/time.h>
+#include <sys/types.h>
 #include <string.h>
 #include <readline/history.h>
 
--- 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<t_other;i++)
+    npages+=tm_table[i].tm_maxpage=tm_table[i].tm_npage;
+
+  massert(scale*maxpages>=npages);
+
+  maxpages*=scale;
+  phys_pages*=scale;
+  real_maxpage=maxpages+page(beg);
+  
+  resv_pages=available_pages=0;
+  available_pages=check_avail_pages();
+  
+  resv_pages=40<available_pages ? 40 : available_pages;
+  available_pages-=resv_pages;
+  
+  recent_allocation=0;
+
+}
+
 void *initial_sbrk=NULL;
 
 int
@@ -231,7 +294,6 @@ update_real_maxpage(void) {
 
   ufixnum i,j;
   void *end,*cur,*beg;
-  ufixnum maxpages;
 #ifdef __MINGW32__
   static fixnum n;
 
@@ -241,8 +303,6 @@ update_real_maxpage(void) {
   }
 #endif
 
-  phys_pages=get_phys_pages_no_malloc(0);
-
   massert(cur=sbrk(0));
   beg=data_start ? data_start : cur;
   for (i=0,j=(1L<<log_maxpage_bound);j>PAGESIZE;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;i<t_other;i++)
-    massert(set_tm_maxpage(tm_table+i,tm_table[i].tm_npage));
-
-  resv_pages=40<available_pages ? 40 : available_pages;
-  available_pages-=resv_pages;
-  
-  if (sSAoptimize_maximum_pagesA && sSAoptimize_maximum_pagesA->s.s_dbind!=Cnil) {
-
-    for (i=t_start,j=0;i<t_relocatable;i++)
-      j+=tm_table[i].tm_maxpage;
-    
-    if (j<phys_pages) {
-      for (i=t_start;i<t_relocatable;i++)
-	if (tm_table[i].tm_maxpage)
-	  massert(set_tm_maxpage(tm_table+i,((double)0.7*phys_pages/j)*tm_table[i].tm_maxpage));
-      set_tm_maxpage(tm_table+t_relocatable,(phys_pages+(tm_table[t_relocatable].tm_maxpage<<1)-sum_maxpages())>>1);
-    }
-    
-    new_holepage=0;
-    for (i=t_start;i<t_relocatable;i++)
-      new_holepage+=tm_table[i].tm_maxpage-tm_table[i].tm_npage;
-    
-  } else
-    new_holepage=available_pages/starting_hole_div;
-
   return 0;
 
 }
@@ -298,12 +325,11 @@ update_real_maxpage(void) {
 static int
 minimize_image(void) {
 
-  extern long new_holepage;
   fixnum i;
   
   empty_relblock();
   nrbpage=0;
-  resize_hole(0,t_relocatable);
+  resize_hole(0,t_relocatable,0);
 
 #ifdef GCL_GPROF
   gprof_cleanup();
@@ -330,10 +356,10 @@ DEFUN_NEW("SET-LOG-MAXPAGE-BOUND",object
   l=l<def ? l : def;
   end=data_start+(1L<<l)-PAGESIZE;
   GBC(t_relocatable);
-  dend=heap_end+PAGESIZE+CEI(rb_pointer-(rb_pointer<rb_end ? rb_start : rb_end),PAGESIZE);
+  dend=heap_end+PAGESIZE+CEI(rb_pointer-rb_begin(),PAGESIZE);
   if (end >= 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 <string.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     
@@ -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,"<socket 0x%x>",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<n && i<FPRC+1 && isdigit(p[i]);i++)
+  for (i=0;i<n && i<FPRC+1 && isdigit((int)p[i]);i++)
       s[i] = p[i];
   for (;i<n;i++)
     s[i] = '0';
--- gcl-2.6.12.orig/o/regexp.c
+++ gcl-2.6.12/o/regexp.c
@@ -553,8 +553,8 @@ regatom(int *flagp)
 			*flagp |= HASWIDTH|SIMPLE;
 		}
 		 if (regcp - buf > 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 <windows.h>
-#define sleep(n) Sleep(1000 * n)
-#endif
-
 #ifdef ATT3B2
 #include <signal.h>
 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) (a<b?a :b)
  p->token_st_dim = MINN(token->st.st_dim,tok_leng+1);
--- /dev/null
+++ gcl-2.6.12/o/wpool.c
@@ -0,0 +1,35 @@
+#include <stdio.h>
+
+#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;
+}