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;
+}