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-10) unstable; urgency=medium
.
* rebuild in clean sid environment
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/bin/dpp.c
+++ gcl-2.6.12/bin/dpp.c
@@ -430,7 +430,8 @@ put_declaration()
{
int i;
- fprintf(out, "\tint narg;\n");
+ if (nopt || rest_flag || key_flag)
+ fprintf(out, "\tint narg;\n");
fprintf(out, "\tregister object *DPPbase=vs_base;\n");
for (i = 0; i < nopt; i++)
@@ -453,12 +454,12 @@ put_declaration()
fprintf(out, "#define\t%s\tDPPbase[%d+%d+2*%d+%d]\n",
aux[i].a_var, nreq, nopt, nkey, i);
fprintf(out, "\n");
- fprintf(out, "\tnarg = vs_top - vs_base;\n");
if (nopt == 0 && !rest_flag && !key_flag)
fprintf(out, "\tcheck_arg(%d);\n", nreq);
else {
- fprintf(out, "\tif (narg < %d)\n", nreq);
- fprintf(out, "\t\ttoo_few_arguments();\n");
+ fprintf(out, "\tnarg = vs_top - vs_base;\n");
+ fprintf(out, "\tif (narg < %d)\n", nreq);
+ fprintf(out, "\t\ttoo_few_arguments();\n");
}
for (i = 0; i < nopt; i++)
if (optional[i].o_svar != NULL) {
--- gcl-2.6.12.orig/cmpnew/gcl_cmpfun.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmpfun.lsp
@@ -976,9 +976,13 @@
(wt-nl "}}")
(wt-nl "vs_top=(vs_base=base+" base ")+" (- *vs* base) ";")
(unwind-exit 'fun-val nil (cons 'values 2))))
- ((unwind-exit (get-inline-loc `((t t) t #.(flags rfa)
- ,(concatenate 'string
- "({struct htent *_z=gethash"
- (if *safe-compile* "_with_check" "")
- "(#0,#1);_z->hte_key==OBJNULL ? (#2) : _z->hte_value;})"))
- args)))))
+ ((let ((*inline-blocks* 0)
+ (*restore-avma* *restore-avma*)
+ (fd `((t t) t #.(flags rfa)
+ ,(concatenate 'string
+ "({struct htent *_z=gethash"
+ (if *safe-compile* "_with_check" "")
+ "(#0,#1);_z->hte_key==OBJNULL ? (#2) : _z->hte_value;})"))))
+ (save-avma fd)
+ (unwind-exit (get-inline-loc fd args))
+ (close-inline-blocks)))))
--- gcl-2.6.12.orig/cmpnew/gcl_cmptag.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmptag.lsp
@@ -62,6 +62,7 @@
((and (eq (car clause) 'go)
(tag-p (setq tem (cadddr (cdr clause))))
(eq (tag-name tem) tag-name)))
+ ((eq (car clause) 'location) nil)
(t (or (jumps-to-p (car clause) tag-name)
(jumps-to-p (cdr clause) tag-name)))))
--- gcl-2.6.12.orig/configure
+++ gcl-2.6.12/configure
@@ -4171,18 +4171,52 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
#fi
# subst GCC not only under 386-linux, but where available -- CM
+TCFLAGS="-fsigned-char"
+
if test "$GCC" = "yes" ; then
- TCFLAGS="-Wall -fsigned-char"
+ TCFLAGS="$TCFLAGS -Wall"
- #FIXME -Wno-unused-but-set-variable when time
- TMPF=-Wno-unused-but-set-variable
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for CFLAG $TMPF" >&5
-$as_echo_n "checking for CFLAG $TMPF... " >&6; }
- CFLAGS_ORI=$CFLAGS
- CFLAGS="$CFLAGS $TMPF"
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for clang" >&5
+$as_echo_n "checking for clang... " >&6; }
if test "$cross_compiling" = yes; then :
+ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "cannot run test program while cross compiling
+See \`config.log' for more details" "$LINENO" 5; }
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+
+ int main() {
+ return
+ #ifdef __clang__
+ 0
+ #else
+ 1
+ #endif
+ ;}
+_ACEOF
+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"
+
+$as_echo "#define CLANG 1" >>confdefs.h
+
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+ #FIXME -Wno-unused-but-set-variable when time
+ TMPF=-Wno-unused-but-set-variable
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for CFLAG $TMPF" >&5
+$as_echo_n "checking for CFLAG $TMPF... " >&6; }
+ CFLAGS_ORI=$CFLAGS
+ CFLAGS="$CFLAGS $TMPF"
+ if test "$cross_compiling" = yes; then :
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
else
@@ -4201,11 +4235,14 @@ rm -f core *.core core.conftest.* gmon.o
conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
- CFLAGS=$CFLAGS_ORI
+ CFLAGS=$CFLAGS_ORI
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
-else
- TCFLAGS="-fsigned-char"
fi
+
if test "$GCC" = "yes" ; then
TCFLAGS="$TCFLAGS -pipe"
case $use in
--- gcl-2.6.12.orig/configure.in
+++ gcl-2.6.12/configure.in
@@ -483,21 +483,37 @@ AC_SUBST(CC)
#fi
# subst GCC not only under 386-linux, but where available -- CM
-if test "$GCC" = "yes" ; then
+TCFLAGS="-fsigned-char"
- TCFLAGS="-Wall -fsigned-char"
+if test "$GCC" = "yes" ; then
- #FIXME -Wno-unused-but-set-variable when time
- TMPF=-Wno-unused-but-set-variable
- AC_MSG_CHECKING([for CFLAG $TMPF])
- CFLAGS_ORI=$CFLAGS
- CFLAGS="$CFLAGS $TMPF"
- AC_TRY_RUN([int main() {return 0;}],TCFLAGS="$TCFLAGS $TMPF";AC_MSG_RESULT(yes),AC_MSG_RESULT(no),AC_MSG_RESULT(no))
- CFLAGS=$CFLAGS_ORI
+ TCFLAGS="$TCFLAGS -Wall"
-else
- TCFLAGS="-fsigned-char"
+ AC_MSG_CHECKING([for clang])
+ AC_RUN_IFELSE([
+ AC_LANG_SOURCE([[
+ int main() {
+ return
+ #ifdef __clang__
+ 0
+ #else
+ 1
+ #endif
+ ;}]])],
+ [AC_MSG_RESULT([yes])
+ clang="yes"
+ TCFLAGS="$TCFLAGS -Wno-builtin-requires-header -Wno-empty-body"
+ AC_DEFINE([CLANG],[1],[running clang compiler])],
+ [AC_MSG_RESULT([no])
+ #FIXME -Wno-unused-but-set-variable when time
+ TMPF=-Wno-unused-but-set-variable
+ AC_MSG_CHECKING([for CFLAG $TMPF])
+ CFLAGS_ORI=$CFLAGS
+ CFLAGS="$CFLAGS $TMPF"
+ AC_TRY_RUN([int main() {return 0;}],TCFLAGS="$TCFLAGS $TMPF";AC_MSG_RESULT(yes),AC_MSG_RESULT(no),AC_MSG_RESULT(no))
+ CFLAGS=$CFLAGS_ORI])
fi
+
if test "$GCC" = "yes" ; then
TCFLAGS="$TCFLAGS -pipe"
case $use in
--- gcl-2.6.12.orig/gcl-tk/comm.c
+++ gcl-2.6.12/gcl-tk/comm.c
@@ -183,7 +183,7 @@ int m;
{ bcopy(sfd->valid_data,sfd->read_buffer,sfd->valid_data_size);
sfd->valid_data=sfd->read_buffer;}
/* there is at least a packet size of space available */
- if ((fix(FFN(fScheck_fd_for_input)(sfd->fd,sfd->write_timeout))>0));
+ if ((fix(FFN(fScheck_fd_for_input)(sfd->fd,sfd->write_timeout))>0))
again:
{char *start = sfd->valid_data+sfd->valid_data_size;
nread = SAFE_READ(sfd->fd,start,
--- gcl-2.6.12.orig/gcl-tk/guis.c
+++ gcl-2.6.12/gcl-tk/guis.c
@@ -455,7 +455,7 @@ struct connection_state *sfd;
int tot;
struct message_header *msg;
msg = (struct message_header *) buf;
- m= read1(sfd,msg,MESSAGE_HEADER_SIZE,DEFAULT_TIMEOUT_FOR_TK_READ);
+ m= read1(sfd,(void *)msg,MESSAGE_HEADER_SIZE,DEFAULT_TIMEOUT_FOR_TK_READ);
if (m == MESSAGE_HEADER_SIZE)
{
if ( msg->magic1!=MAGIC1
@@ -468,7 +468,7 @@ struct connection_state *sfd;
if (tot >= bufleng)
{msg = (void *)malloc(tot+1);
bcopy(buf,msg,MESSAGE_HEADER_SIZE);}
- m = read1(sfd,&(msg->body),
+ m = read1(sfd,(void *)&(msg->body),
body_length,DEFAULT_TIMEOUT_FOR_TK_READ);
if (m == body_length)
{ return msg;}}
--- gcl-2.6.12.orig/h/compbas.h
+++ gcl-2.6.12/h/compbas.h
@@ -4,7 +4,7 @@
#define EXTER extern
#endif
#ifndef INLINE
-#if defined(__GNUC__) && __GNUC__ <= 4
+#if (defined(__GNUC__) && __GNUC__ <= 4) && !defined __clang__
#define INLINE extern inline
#else
#define INLINE inline
--- gcl-2.6.12.orig/h/fixnum.h
+++ gcl-2.6.12/h/fixnum.h
@@ -13,7 +13,7 @@
#define is_imm_fix(a_) INT_IN_BITS(a_,LOW_SHFT-1)
#elif defined (IM_FIX_BASE) && defined(IM_FIX_LIM)
#define make_imm_fixnum(a_) ((object)((a_)+(IM_FIX_BASE+(IM_FIX_LIM>>1))))
-#define fix_imm_fixnum(a_) (((fixnum)(a_))-(IM_FIX_BASE+(IM_FIX_LIM>>1)))
+#define fix_imm_fixnum(a_) ((fixnum)(((fixnum)(a_))-(IM_FIX_BASE+(IM_FIX_LIM>>1))))
#define mark_imm_fixnum(a_) ((a_)=((object)(((fixnum)(a_)) | IM_FIX_LIM)))
#define unmark_imm_fixnum(a_) ((a_)=((object)(((fixnum)(a_)) &~ IM_FIX_LIM)))
#define is_imm_fixnum(a_) (((ufixnum)(a_))>=IM_FIX_BASE)
--- gcl-2.6.12.orig/h/gclincl.h.in
+++ gcl-2.6.12/h/gclincl.h.in
@@ -9,9 +9,6 @@
/* punt guess for no randomize value */
#undef ADDR_NO_RANDOMIZE
-/* compile ansi compliant image */
-#undef ANSI_COMMON_LISP
-
/* binding stack size */
#undef BDSSIZE
@@ -21,6 +18,9 @@
/* can prevent sbrk from returning random values */
#undef CAN_UNRANDOMIZE_SBRK
+/* running clang compiler */
+#undef CLANG
+
/* Define to one of `_getb67', `GETB67', `getb67' for Cray-2 and Cray-YMP
systems. This function is required for `alloca.c' support on those systems.
*/
--- gcl-2.6.12.orig/h/object.h
+++ gcl-2.6.12/h/object.h
@@ -342,7 +342,8 @@ EXTER long holepage; /* hole pages *
EXTER long new_holepage,starting_hole_div,starting_relb_heap_mult;
-EXTER char *rb_start; /* relblock start */
+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 */
--- gcl-2.6.12.orig/h/protoize.h
+++ gcl-2.6.12/h/protoize.h
@@ -1946,3 +1946,12 @@ get_pageinfo(void *);
void
add_page_to_freelist(char *, struct typemanager *);
+
+ufixnum
+sum_maxpages(void);
+
+void
+resize_hole(ufixnum,enum type);
+
+void
+setup_rb(void);
--- gcl-2.6.12.orig/o/alloc.c
+++ gcl-2.6.12/o/alloc.c
@@ -325,14 +325,29 @@ empty_relblock(void) {
}
-static inline void
+void
+setup_rb(void) {
+
+ int init=new_rb_start!=rb_start || rb_pointer>=rb_end;
+
+ rb_start=new_rb_start;
+ rb_end=rb_start+(nrbpage<<PAGEWIDTH);
+ rb_pointer=init ? rb_start : rb_end;
+ rb_limit=rb_pointer+(nrbpage<<PAGEWIDTH);
+
+ alloc_page(-(2*nrbpage+((new_rb_start-heap_end)>>PAGEWIDTH)));
+
+}
+
+void
resize_hole(ufixnum hp,enum type tp) {
- char *new_start=heap_end+hp*PAGESIZE;
char *start=rb_pointer<rb_end ? rb_start : rb_end;
ufixnum size=rb_pointer-start;
- if ((new_start<start && new_start+size>=start) || (new_start<start+size && new_start+size>=start+size)) {
+ 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);
tm_table[t_relocatable].tm_adjgbccnt--;
@@ -340,9 +355,11 @@ resize_hole(ufixnum hp,enum type tp) {
return resize_hole(hp,tp);
}
- holepage=hp;
- tm_of(tp)->tm_adjgbccnt--;
- GBC(tp);
+ if (size) {
+ tm_of(tp)->tm_adjgbccnt--;
+ GBC(tp);
+ } else
+ setup_rb();
}
@@ -355,7 +372,7 @@ alloc_page(long n) {
if (!s) {
- if (nn>holepage) {
+ if (nn>((rb_start-heap_end)>>PAGEWIDTH)) {
fixnum d=available_pages-nn;
@@ -373,12 +390,11 @@ alloc_page(long n) {
e=heap_end;
v=e+nn*PAGESIZE;
- if (!s) {
+ if (!s)
- holepage -= nn;
heap_end=v;
- } else if (v>(void *)core_end) {
+ else if (v>(void *)core_end) {
massert(!mbrk(v));
core_end=v;
@@ -395,7 +411,7 @@ alloc_page(long n) {
struct pageinfo *cell_list_head=NULL,*cell_list_tail=NULL;;
-static inline ufixnum
+ufixnum
sum_maxpages(void) {
ufixnum i,j;
@@ -516,7 +532,7 @@ rebalance_maxpages(struct typemanager *m
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<=0)
+ if (e+phys_pages<=j)
return 0;
f=k ? 1.0-(double)e/k : 1.0;
@@ -895,17 +911,20 @@ add_pages(struct typemanager *tm,fixnum
case t_relocatable:
- if (rb_pointer>rb_end) {
+ if (rb_pointer>rb_end && m>((rb_start-heap_end)>>PAGEWIDTH)) {
fprintf(stderr,"Moving relblock low before expanding relblock pages\n");
fflush(stderr);
tm_table[t_relocatable].tm_adjgbccnt--;
GBC(t_relocatable);
}
nrbpage+=m;
- rb_end+=m*PAGESIZE;
rb_limit+=m*PAGESIZE;
+ if (rb_pointer>rb_end)
+ rb_start-=m*PAGESIZE;
+ else
+ rb_end+=m*PAGESIZE;
- alloc_page(-(2*nrbpage+holepage));
+ alloc_page(-(2*nrbpage+((rb_start-heap_end)>>PAGEWIDTH)));
break;
@@ -1116,7 +1135,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)/PAGESIZE;
+ { tm->tm_npage = (rb_end-rb_start)>>PAGEWIDTH;
tm->tm_nfree = rb_limit -rb_pointer;
}
else if (tm->tm_type == t_contiguous)
@@ -1242,11 +1261,8 @@ 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) {
- holepage=new_holepage;
- alloc_page(-holepage);
- rb_start=rb_end=rb_limit=rb_pointer=heap_end+(holepage<<PAGEWIDTH);
- }
+ if (rb_start==heap_end && rb_end==rb_start && rb_limit==rb_start && rb_pointer==rb_start)
+ resize_hole(new_holepage,t_relocatable);
}
void
@@ -1345,11 +1361,9 @@ gcl_init_alloc(void *cs_start) {
initial_sbrk=data_start=heap_end;
first_data_page=page(data_start);
- holepage=new_holepage;
-
#ifdef GCL_GPROF
- if (holepage<textpage)
- holepage=textpage;
+ if (new_holepage<textpage)
+ new_holepage=textpage;
#endif
/* Unused (at present) tm_distinct flag added. Note that if cons
@@ -1401,12 +1415,8 @@ gcl_init_alloc(void *cs_start) {
set_tm_maxpage(tm_table+t_relocatable,1);
nrbpage=0;
-
- alloc_page(-(holepage + 2*nrbpage));
- rb_start = rb_pointer = heap_end + PAGESIZE*holepage;
- rb_end = rb_start + PAGESIZE*nrbpage;
- rb_limit = rb_end - 2*RB_GETA;
+ resize_hole(new_holepage,t_relocatable);
#ifdef SGC
tm_table[(int)t_relocatable].tm_sgc = 50;
#endif
@@ -1912,7 +1922,7 @@ void *
realloc(void *ptr, size_t size) {
object x;
- int i, j;
+ int i;
/* was allocated by baby_malloc */
#ifdef BABY_MALLOC_SIZE
if (ptr >= (void*)baby_malloc_data && ptr - (void*)baby_malloc_data <BABY_MALLOC_SIZE)
@@ -1938,17 +1948,10 @@ realloc(void *ptr, size_t size) {
x->st.st_fillp = size;
return(ptr);
} else {
- j = x->st.st_dim;
x->st.st_self = alloc_contblock(size);
x->st.st_fillp = x->st.st_dim = size;
for (i = 0; i < size; i++)
x->st.st_self[i] = ((char *)ptr)[i];
-/* SGC contblock pages: Its possible this is on an old page CM 20030827 */
-/* #ifdef SGC */
-/* insert_maybe_sgc_contblock(ptr, j); */
-/* #else */
-/* insert_contblock(ptr, j); */
-/* #endif */
return(x->st.st_self);
}
}
--- gcl-2.6.12.orig/o/assignment.c
+++ gcl-2.6.12/o/assignment.c
@@ -259,7 +259,7 @@ DEFUNO_NEW("FMAKUNBOUND",object,fLfmakun
static void
FFN(Fsetf)(object form)
{
- object result,*t,*t1;
+ object *t,*t1;
if (endp(form)) {
vs_base = vs_top;
vs_push(Cnil);
@@ -269,7 +269,7 @@ FFN(Fsetf)(object form)
vs_top = top;
if (endp(MMcdr(form)))
FEinvalid_form("No value for ~S.", form->c.c_car);
- result = setf(MMcar(form), MMcadr(form));
+ setf(MMcar(form), MMcadr(form));
form = MMcddr(form);
} while (!endp(form));
t=vs_base;
--- gcl-2.6.12.orig/o/cfun.c
+++ gcl-2.6.12/o/cfun.c
@@ -343,7 +343,8 @@ turbo_closure(object fun)
if(1)/*(fun->cc.cc_turbo==NULL)*/
{BEGIN_NO_INTERRUPT;
- for (n = 0, l = fun->cc.cc_env; !endp(l); n++, l = l->c.c_cdr);
+ for (n = 0, l = fun->cc.cc_env; !endp(l); n++, l = l->c.c_cdr)
+ ;
{
block= AR_ALLOC(alloc_relblock,(1+n),object);
*block=make_fixnum(n);
--- gcl-2.6.12.orig/o/format.c
+++ gcl-2.6.12/o/format.c
@@ -170,6 +170,22 @@ object sSAindent_formatted_outputA;
fmt_string = old_fmt_string ; \
fmt_paramp = old_fmt_paramp
+#define fmt_old1 VOL object old_fmt_stream; \
+ VOL int old_ctl_origin; \
+ VOL int old_ctl_index; \
+ VOL int old_ctl_end; \
+ jmp_bufp VOL old_fmt_jmp_bufp; \
+ VOL int old_fmt_indents; \
+ VOL object old_fmt_string ; \
+ VOL format_parameter *old_fmt_paramp
+#define fmt_save1 old_fmt_stream = fmt_stream; \
+ old_ctl_origin = ctl_origin; \
+ old_ctl_index = ctl_index; \
+ old_ctl_end = ctl_end; \
+ old_fmt_jmp_bufp = fmt_jmp_bufp; \
+ old_fmt_indents = fmt_indents; \
+ old_fmt_string = fmt_string ; \
+ old_fmt_paramp = fmt_paramp
#define fmt_restore1 fmt_stream = old_fmt_stream; \
ctl_origin = old_ctl_origin; \
ctl_index = old_ctl_index; \
@@ -1776,7 +1792,7 @@ fmt_case(bool colon, bool atsign)
{
VOL object x;
VOL int i, j;
- fmt_old;
+ fmt_old1;
jmp_buf fmt_jmp_buf0;
int up_colon;
bool b;
@@ -1787,7 +1803,7 @@ fmt_case(bool colon, bool atsign)
j = fmt_skip();
if (ctl_string[--j] != ')' || ctl_string[--j] != '~')
fmt_error("~) expected");
- fmt_save;
+ fmt_save1;
fmt_jmp_bufp = &fmt_jmp_buf0;
if ((up_colon = setjmp(*fmt_jmp_bufp)))
;
@@ -1850,7 +1866,7 @@ fmt_conditional(bool colon, bool atsign)
object x;
int n=0;
bool done;
- fmt_old;
+ fmt_old1;
fmt_not_colon_atsign(colon, atsign);
if (colon) {
@@ -1863,11 +1879,11 @@ fmt_conditional(bool colon, bool atsign)
if (ctl_string[--k] != ']' || ctl_string[--k] != '~')
fmt_error("~] expected");
if (fmt_advance() == Cnil) {
- fmt_save;
+ fmt_save1;
format(fmt_stream, ctl_origin + i, j - i);
fmt_restore1;
} else {
- fmt_save;
+ fmt_save1;
format(fmt_stream, ctl_origin + j + 2, k - (j + 2));
fmt_restore1;
}
@@ -1880,7 +1896,7 @@ fmt_conditional(bool colon, bool atsign)
;
else {
--fmt_index;
- fmt_save;
+ fmt_save1;
format(fmt_stream, ctl_origin + i, j - i);
fmt_restore1;
}
@@ -1899,7 +1915,7 @@ fmt_conditional(bool colon, bool atsign)
for (k = j; ctl_string[--k] != '~';)
;
if (n == 0) {
- fmt_save;
+ fmt_save1;
format(fmt_stream, ctl_origin + i, k - i);
fmt_restore1;
done = TRUE;
@@ -1925,7 +1941,7 @@ fmt_conditional(bool colon, bool atsign)
if (ctl_string[--j] != ']' || ctl_string[--j] != '~')
fmt_error("~] expected");
if (!done) {
- fmt_save;
+ fmt_save1;
format(fmt_stream, ctl_origin + i, j - i);
fmt_restore1;
}
@@ -2062,7 +2078,7 @@ fmt_justification(volatile bool colon, b
{
int mincol=0, colinc=0, minpad=0, padchar=0;
object fields[FORMAT_DIRECTIVE_LIMIT];
- fmt_old;
+ fmt_old1;
jmp_buf fmt_jmp_buf0;
VOL int i,j,n,j0;
int k,l,m,l0;
@@ -2089,7 +2105,7 @@ fmt_justification(volatile bool colon, b
;
fields[n] = make_string_output_stream(64);
vs_push(fields[n]);
- fmt_save;
+ fmt_save1;
fmt_jmp_bufp = &fmt_jmp_buf0;
if ((up_colon = setjmp(*fmt_jmp_bufp))) {
--n;
@@ -2116,7 +2132,7 @@ fmt_justification(volatile bool colon, b
special = 1;
for (j = j0; ctl_string[j] != '~'; --j)
;
- fmt_save;
+ fmt_save1;
format(fmt_stream, ctl_origin + j, j0 - j + 2);
fmt_restore1;
spare_spaces = fmt_spare_spaces;
--- gcl-2.6.12.orig/o/gbc.c
+++ gcl-2.6.12/o/gbc.c
@@ -24,7 +24,7 @@
IMPLEMENTATION-DEPENDENT
*/
-/* #define DEBUG */
+#define DEBUG
#define IN_GBC
#define NEED_MP_H
@@ -149,15 +149,6 @@ pageinfo_p(void *v) {
}
-static inline bool
-in_contblock_stack_list(void *p,void ***ap) {
- void **a;
- for (a=*ap;a && a[0]>p;a=a[1]);
- *ap=a;
- /* if (a && a[0]==p) fprintf(stderr,"Skipping %p\n",p); */
- return a && a[0]==p;
-}
-
static inline char
get_bit(char *v,struct pageinfo *pi,void *x) {
void *ve=CB_DATA_START(pi);
@@ -168,15 +159,15 @@ get_bit(char *v,struct pageinfo *pi,void
return (v[i]>>s)&0x1;
}
-static inline void
-set_bit(char *v,struct pageinfo *pi,void *x) {
- void *ve=CB_DATA_START(pi);
- fixnum off=(x-ve)>>LOG_BYTES_CONTBLOCK,i=off>>LOG_BITS_CHAR,s=off&~(~0UL<<LOG_BITS_CHAR);
-#ifdef CONTBLOCK_MARK_DEBUG
- off_check(v,ve,i,pi);
-#endif
- v[i]|=(1UL<<s);
-}
+/* static inline void */
+/* set_bit(char *v,struct pageinfo *pi,void *x) { */
+/* void *ve=CB_DATA_START(pi); */
+/* fixnum off=(x-ve)>>LOG_BYTES_CONTBLOCK,i=off>>LOG_BITS_CHAR,s=off&~(~0UL<<LOG_BITS_CHAR); */
+/* #ifdef CONTBLOCK_MARK_DEBUG */
+/* off_check(v,ve,i,pi); */
+/* #endif */
+/* v[i]|=(1UL<<s); */
+/* } */
#define bit_get(v,i,s) ((v[i]>>s)&0x1)
#define bit_set(v,i,s) (v[i]|=(1UL<<s))
@@ -237,10 +228,10 @@ get_mark_bit(struct pageinfo *pi,void *x
return get_bit(CB_MARK_START(pi),pi,x);
}
-static inline void
-set_mark_bit(struct pageinfo *pi,void *x) {
- set_bit(CB_MARK_START(pi),pi,x);
-}
+/* static inline void */
+/* set_mark_bit(struct pageinfo *pi,void *x) { */
+/* set_bit(CB_MARK_START(pi),pi,x); */
+/* } */
static inline void *
get_mark_bits(struct pageinfo *pi,void *x) {
@@ -252,15 +243,17 @@ set_mark_bits(struct pageinfo *pi,void *
set_bits(CB_MARK_START(pi),pi,x1,x2);
}
+#ifdef SGC
+
static inline char
get_sgc_bit(struct pageinfo *pi,void *x) {
return get_bit(CB_SGCF_START(pi),pi,x);
}
-static inline void
-set_sgc_bit(struct pageinfo *pi,void *x) {
- set_bit(CB_SGCF_START(pi),pi,x);
-}
+/* static inline void */
+/* set_sgc_bit(struct pageinfo *pi,void *x) { */
+/* set_bit(CB_SGCF_START(pi),pi,x); */
+/* } */
static inline void *
get_sgc_bits(struct pageinfo *pi,void *x) {
@@ -272,6 +265,8 @@ set_sgc_bits(struct pageinfo *pi,void *x
set_bits(CB_SGCF_START(pi),pi,x1,x2);
}
+#endif
+
#ifdef KCLOVM
void mark_all_stacks();
bool ovm_process_created;
@@ -1067,7 +1062,7 @@ contblock_sweep_phase(void) {
z=get_mark_bit(v,s);
for (p=s;p<e;) {
- q=get_bits(CB_MARK_START(v),v,p);
+ q=get_mark_bits(v,p);
if (!z)
insert_contblock(p,q-p);
z=1-z;
@@ -1107,6 +1102,19 @@ int (*GBC_exit_hook)() = NULL;
fixnum fault_pages=0;
+static ufixnum
+count_contblocks(void) {
+
+ ufixnum ncb;
+ struct contblock *cbp;
+
+ for (ncb=0,cbp=cb_pointer;cbp;cbp=cbp->cb_link,ncb++);
+
+ return ncb;
+
+}
+
+
void
GBC(enum type t) {
@@ -1196,21 +1204,8 @@ GBC(enum type t) {
if (gc_time >=0 && !gc_recursive++) {gc_start=runtime();}
- if (COLLECT_RELBLOCK_P) {
-
- char *new_start=heap_end+holepage*PAGESIZE,*new_end=new_start+nrbpage*PAGESIZE;
-
- if (new_start!=rb_start) {
- rb_pointer=new_start;
- rb_limit=new_end;
- } else {
- rb_pointer=(rb_pointer<rb_end) ? rb_end : rb_start;
- rb_limit=rb_pointer+(new_end-new_start);
- }
-
- alloc_page(-(holepage+2*nrbpage));
-
- }
+ if (COLLECT_RELBLOCK_P)
+ setup_rb();
#ifdef DEBUG
if (debug) {
@@ -1254,8 +1249,8 @@ GBC(enum type t) {
if (COLLECT_RELBLOCK_P) {
- rb_start = heap_end + PAGESIZE*holepage;
- rb_end = heap_end + (holepage + nrbpage) *PAGESIZE;
+ /* rb_start = new_rb_start; */
+ /* rb_end = rb_start + nrbpage*PAGESIZE; */
#ifdef SGC
@@ -1332,6 +1327,7 @@ GBC(enum type t) {
#ifdef DEBUG
if (debug) {
+ int i,j;
for (i = 0, j = 0; i < (int)t_end; i++) {
if (tm_table[i].tm_type == (enum type)i) {
printf("%13s: %8ld used %8ld free %4ld/%ld pages\n",
@@ -1346,8 +1342,8 @@ GBC(enum type t) {
tm_table[i].tm_name,
tm_table[(int)tm_table[i].tm_type].tm_name);
}
- printf("contblock: %ld blocks %ld pages\n", ncb, ncbpage);
- printf("hole: %ld pages\n", holepage);
+ printf("contblock: %ld blocks %ld pages\n", count_contblocks(), ncbpage);
+ printf("hole: %ld pages\n", ((rb_start-heap_end)>>PAGEWIDTH));
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");
@@ -1425,10 +1421,10 @@ FFN(siLheap_report)(void) {
i=sizeof(fixnum)*CHAR_SIZE-2;
i=1<<i;
vs_push(make_fixnum(((unsigned long)cs_base+i-1)&-i));
- vs_push(make_fixnum(abs(cs_base-cs_org)));
+ vs_push(make_fixnum(labs(cs_base-cs_org)));
vs_push(make_fixnum((CSTACK_DIRECTION+1)>>1));
vs_push(make_fixnum(CSTACK_ALIGNMENT));
- vs_push(make_fixnum(abs(cs_limit-cs_org)));/*CSSIZE*/
+ vs_push(make_fixnum(labs(cs_limit-cs_org)));/*CSSIZE*/
#if defined(IM_FIX_BASE) && defined(IM_FIX_LIM)
#ifdef LOW_IM_FIX
vs_push(make_fixnum(-LOW_IM_FIX));
@@ -1456,14 +1452,9 @@ FFN(siLroom_report)(void) {
vs_push(make_fixnum(available_pages));
vs_push(make_fixnum(ncbpage));
vs_push(make_fixnum(maxcbpage));
- {
- ufixnum ncb;
- struct contblock *cbp;
- for (ncb=0,cbp=cb_pointer;cbp;cbp=cbp->cb_link,ncb++);
- vs_push(make_fixnum(ncb));
- }
+ vs_push(make_fixnum(count_contblocks()));
vs_push(make_fixnum(cbgbccount));
- vs_push(make_fixnum(holepage));
+ 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(nrbpage));
--- gcl-2.6.12.orig/o/hash.d
+++ gcl-2.6.12/o/hash.d
@@ -152,7 +152,7 @@ BEGIN:
if (depth++ <=3)
switch ((tx=type_of(x))) {
case t_cons:
- h^=ihash_equal(x->c.c_car,depth)^rtb[abs(depth%(sizeof(rtb)/sizeof(*rtb)))];
+ h^=ihash_equal(x->c.c_car,depth)^rtb[abs((int)(depth%(sizeof(rtb)/sizeof(*rtb))))];/*FIXME: clang faulty warning*/
x = x->c.c_cdr;
goto BEGIN;
break;
--- gcl-2.6.12.orig/o/main.c
+++ gcl-2.6.12/o/main.c
@@ -207,11 +207,19 @@ get_proc_meminfo_value_in_pages(const ch
static ufixnum
get_phys_pages_no_malloc(char freep) {
- return freep ?
+ ufixnum k=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
@@ -221,9 +229,9 @@ void *initial_sbrk=NULL;
int
update_real_maxpage(void) {
- ufixnum i,j,k;
+ ufixnum i,j;
void *end,*cur,*beg;
- ufixnum free_phys_pages=get_phys_pages_no_malloc(1),maxpages;
+ ufixnum maxpages;
#ifdef __MINGW32__
static fixnum n;
@@ -233,7 +241,7 @@ update_real_maxpage(void) {
}
#endif
- phys_pages=get_phys_pages_no_malloc(1);
+ phys_pages=get_phys_pages_no_malloc(0);
massert(cur=sbrk(0));
beg=data_start ? data_start : cur;
@@ -253,15 +261,14 @@ update_real_maxpage(void) {
maxpages=real_maxpage-page(beg);
- free_phys_pages=free_phys_pages>maxpages ? maxpages : free_phys_pages;
+ phys_pages=phys_pages>maxpages ? maxpages : phys_pages;
resv_pages=available_pages=0;
available_pages=check_avail_pages();
- for (i=t_start,j=0;i<t_other;i++) {
+ for (i=t_start;i<t_other;i++)
massert(set_tm_maxpage(tm_table+i,tm_table[i].tm_npage));
- j+=tm_table[i].tm_maxpage;
- }
+
resv_pages=40<available_pages ? 40 : available_pages;
available_pages-=resv_pages;
@@ -270,13 +277,11 @@ update_real_maxpage(void) {
for (i=t_start,j=0;i<t_relocatable;i++)
j+=tm_table[i].tm_maxpage;
- if (j<free_phys_pages) {
- for (i=t_start,k=0;i<t_relocatable;i++)
- if (tm_table[i].tm_maxpage) {
- massert(set_tm_maxpage(tm_table+i,((double)0.7*free_phys_pages/j)*tm_table[i].tm_maxpage));
- k+=tm_table[i].tm_maxpage;
- }
- set_tm_maxpage(tm_table+t_relocatable,(free_phys_pages-k)>>1);
+ 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;
@@ -297,15 +302,15 @@ minimize_image(void) {
fixnum i;
empty_relblock();
- holepage=nrbpage=0;
- core_end=rb_start=rb_end=rb_limit=rb_pointer=heap_end;
+ nrbpage=0;
+ resize_hole(0,t_relocatable);
#ifdef GCL_GPROF
gprof_cleanup();
#endif
#if defined(BSD) || defined(ATT)
- mbrk(core_end);
+ mbrk(core_end=heap_end);
#endif
cbgbccount = tm_table[t_contiguous].tm_adjgbccnt = tm_table[t_contiguous].tm_opt_maxpage = 0;
@@ -992,7 +997,6 @@ FFN(siLsave_system)(void) {
saving_system = FALSE;
siLsave();
- alloc_page(-(holepage+2*nrbpage));
}
--- gcl-2.6.12.orig/o/nfunlink.c
+++ gcl-2.6.12/o/nfunlink.c
@@ -212,19 +212,24 @@ IapplyVector(object fun, int nargs, obje
else { abase = vs_top;
for (i=0; i < nargs ; i++, atypes >>= F_TYPE_WIDTH)
{ object next = base[i];
- int atyp = atypes & MASK_RANGE(0,F_TYPE_WIDTH);
- if (atyp == F_object)
- next = next;
- else if (atyp == F_int)
- { ASSURE_TYPE(next,t_fixnum);
- next = COERCE_F_TYPE(next,F_object,F_int);}
- else if (atyp == F_shortfloat)
- { ASSURE_TYPE(next,t_shortfloat);
- next = COERCE_F_TYPE(next,F_object,F_shortfloat);}
- else if (atyp == F_double_ptr)
- { ASSURE_TYPE(next,t_longfloat);
- next = COERCE_F_TYPE(next,F_object,F_double_ptr);}
- else {FEerror("cant get here!",0);}
+ switch (atypes & MASK_RANGE(0,F_TYPE_WIDTH)) {
+ case F_object:
+ break;
+ case F_int:
+ ASSURE_TYPE(next,t_fixnum);
+ next = COERCE_F_TYPE(next,F_object,F_int);
+ break;
+ case F_shortfloat:
+ ASSURE_TYPE(next,t_shortfloat);
+ next = COERCE_F_TYPE(next,F_object,F_shortfloat);
+ break;
+ case F_double_ptr:
+ ASSURE_TYPE(next,t_longfloat);
+ next = COERCE_F_TYPE(next,F_object,F_double_ptr);
+ break;
+ default:
+ FEerror("cant get here!",0);
+ }
vs_push(next);}
}
--- gcl-2.6.12.orig/o/nsocket.c
+++ gcl-2.6.12/o/nsocket.c
@@ -204,7 +204,7 @@ CreateSocket(int port, char *host, int s
* attempt to do an async connect. Otherwise
* do a synchronous connect or bind. */
{
- int status, sock, asyncConnect, curState, origState;
+ int status, sock, /* asyncConnect, */curState, origState;
struct sockaddr_in sockaddr; /* socket address */
struct sockaddr_in mysockaddr; /* Socket address for client */
@@ -230,7 +230,7 @@ CreateSocket(int port, char *host, int s
fcntl(sock, F_SETFD, FD_CLOEXEC);
- asyncConnect = 0;
+ /* asyncConnect = 0; */
status = 0;
if (server) {
@@ -285,7 +285,7 @@ CreateSocket(int port, char *host, int s
sizeof(sockaddr));
if (status < 0) {
if (errno == EINPROGRESS) {
- asyncConnect = 1;
+ /* asyncConnect = 1; */
status = 0;
}
}
--- gcl-2.6.12.orig/o/prelink.c
+++ gcl-2.6.12/o/prelink.c
@@ -5,8 +5,14 @@
extern FILE *stdin __attribute__((weak));
extern FILE *stderr __attribute__((weak));
extern FILE *stdout __attribute__((weak));
+
+#if RL_READLINE_VERSION < 0x0600
+extern Function *rl_completion_entry_function __attribute__((weak));
+extern char *rl_readline_name __attribute__((weak));
+#else
extern rl_compentry_func_t *rl_completion_entry_function __attribute__((weak));
extern const char *rl_readline_name __attribute__((weak));
+#endif
void
prelink_init(void) {
--- gcl-2.6.12.orig/o/print.d
+++ gcl-2.6.12/o/print.d
@@ -341,7 +341,7 @@ truncate_double(char *b,double d,int dp)
for (p=c1;*p && *p!='e';p++);
pp=p>c1 && p[-1]!='.' ? p-1 : p;
for (;pp>c1 && pp[-1]=='0';pp--);
- strcpy(pp,p);
+ memmove(pp,p,1+strlen(p));
if (pp!=p && COMP(c1,&pp,d,dp))
k=truncate_double(n=c1,d,dp);
--- gcl-2.6.12.orig/o/read.d
+++ gcl-2.6.12/o/read.d
@@ -2476,6 +2476,7 @@ object in;
/* to prevent longjmp clobber */
i=(long)&vsp;
+ i+=i;
vsp=&vspo;
old_READtable = READtable;
old_READdefault_float_format = READdefault_float_format;
--- gcl-2.6.12.orig/o/run_process.c
+++ gcl-2.6.12/o/run_process.c
@@ -354,7 +354,6 @@ static int open_connection(host,server)
char *host;
int server;
{
- int res;
int pid;
int sock;
struct hostent *hp;
@@ -396,9 +395,9 @@ int server;
}
#ifdef OVM_IO
- res = fcntl(sock,F_SETFL,FASYNC | FNDELAY);
+ fcntl(sock,F_SETFL,FASYNC | FNDELAY);
#else
- res = fcntl(sock,F_SETFL,FASYNC);
+ fcntl(sock,F_SETFL,FASYNC);
#endif
return(sock);
}
--- gcl-2.6.12.orig/o/sockets.c
+++ gcl-2.6.12/o/sockets.c
@@ -338,7 +338,7 @@ DEFUN_NEW("OUR-READ-WITH-OFFSET",object,
OO,OI,II,OO,(object fd,object buffer,fixnum offset,fixnum nbytes,fixnum timeout),
"Read from STATE-FD into string BUFFER putting data at OFFSET and reading NBYTES, waiting for TIMEOUT before failing")
-{ return make_fixnum(read1(OBJ_TO_CONNECTION_STATE(fd),&((buffer)->ust.ust_self[offset]),nbytes,timeout));
+{ return make_fixnum(read1(OBJ_TO_CONNECTION_STATE(fd),&((buffer)->st.st_self[offset]),nbytes,timeout));
}
--- gcl-2.6.12.orig/o/unexelf.c
+++ gcl-2.6.12/o/unexelf.c
@@ -660,7 +660,7 @@ unexec (char *new_name, char *old_name,
int n, nn;
int old_bss_index, old_sbss_index;
int old_data_index, new_data2_index;
- int old_mdebug_index;
+ /* int old_mdebug_index; */
struct stat stat_buf;
/* Open the old file, allocate a buffer of the right size, and read
@@ -703,8 +703,8 @@ unexec (char *new_name, char *old_name,
/* Find the mdebug section, if any. */
- old_mdebug_index = find_section (".mdebug", old_section_names,
- old_name, old_file_h, old_section_h, 1);
+ /* old_mdebug_index = find_section (".mdebug", old_section_names, */
+ /* old_name, old_file_h, old_section_h, 1); */
/* Find the old .bss section. Figure out parameters of the new
* data2 and bss sections.
--- gcl-2.6.12.orig/xgcl-2/gcl_general.lsp
+++ gcl-2.6.12/xgcl-2/gcl_general.lsp
@@ -61,7 +61,7 @@
;; General routines.
(defCfun "object lisp_string(object a_string, fixnum c_string) " 0
- "extern long strlen(const char *);"
+ "extern unsigned long strlen(const char *);"
"fixnum len = strlen((void *)c_string);"
"a_string->st.st_dim = len;"
"a_string->st.st_fillp = len;"