From: Camm Maguire Date: Thu, 11 Aug 2022 17:16:42 +0000 (+0100) Subject: X-Git-Tag: archive/raspbian/2.7.1-4+rpi1~1^2~1^2~126 X-Git-Url: https://dgit.raspbian.org/?a=commitdiff_plain;h=56e1e044e8bca4cb1afb5b836d55081dbeada58e;p=gcl27.git 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 Gbp-Pq: Name Version_2_6_13pre12 --- diff --git a/bin/dpp.c b/bin/dpp.c index 242709b..6d3f657 100755 --- a/bin/dpp.c +++ b/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) { diff --git a/cmpnew/gcl_cmpfun.lsp b/cmpnew/gcl_cmpfun.lsp index 50144a3..11c6db4 100755 --- a/cmpnew/gcl_cmpfun.lsp +++ b/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))))) diff --git a/cmpnew/gcl_cmptag.lsp b/cmpnew/gcl_cmptag.lsp index d206f5d..031d379 100755 --- a/cmpnew/gcl_cmptag.lsp +++ b/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))))) diff --git a/configure b/configure index 00a24b6..c6064ad 100755 --- a/configure +++ b/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.out bb.out conftest$ac_exeext \ 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 diff --git a/configure.in b/configure.in index 3c2a2b3..49318ca 100644 --- a/configure.in +++ b/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 diff --git a/gcl-tk/comm.c b/gcl-tk/comm.c index e29d231..7ac93a6 100755 --- a/gcl-tk/comm.c +++ b/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, diff --git a/gcl-tk/guis.c b/gcl-tk/guis.c index 74e6bbd..f162047 100755 --- a/gcl-tk/guis.c +++ b/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;}} diff --git a/h/compbas.h b/h/compbas.h index 4abad80..9ee6f69 100755 --- a/h/compbas.h +++ b/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 diff --git a/h/fixnum.h b/h/fixnum.h index cd08bd5..81c1c5f 100644 --- a/h/fixnum.h +++ b/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) diff --git a/h/gclincl.h.in b/h/gclincl.h.in index cfc0bd6..75fa9fe 100644 --- a/h/gclincl.h.in +++ b/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. */ diff --git a/h/object.h b/h/object.h index d2bda44..b1b3afc 100755 --- a/h/object.h +++ b/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 */ diff --git a/h/protoize.h b/h/protoize.h index b5057e6..6664f89 100644 --- a/h/protoize.h +++ b/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); diff --git a/o/alloc.c b/o/alloc.c index 720571a..5d6fd8c 100644 --- a/o/alloc.c +++ b/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))); + +} + +void resize_hole(ufixnum hp,enum type tp) { - char *new_start=heap_end+hp*PAGESIZE; char *start=rb_pointer=start) || (new_start=start+size)) { + new_rb_start=heap_end+hp*PAGESIZE; + + if ((new_rb_start=start) || (new_rb_start=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 *my_tm,fixnum z) { 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 m) { 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,fSallocated,SI,1,1,NONE,OO,OO,OO,OO,(object typ)," { 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<= (void*)baby_malloc_data && ptr - (void*)baby_malloc_data 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); } } diff --git a/o/assignment.c b/o/assignment.c index f4d0483..30c032d 100755 --- a/o/assignment.c +++ b/o/assignment.c @@ -259,7 +259,7 @@ DEFUNO_NEW("FMAKUNBOUND",object,fLfmakunbound,LISP 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; diff --git a/o/cfun.c b/o/cfun.c index 0b19926..b7dc62d 100755 --- a/o/cfun.c +++ b/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); diff --git a/o/format.c b/o/format.c index 08544b4..892603b 100755 --- a/o/format.c +++ b/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, bool atsign) { 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, bool atsign) ; 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, bool atsign) 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; diff --git a/o/gbc.c b/o/gbc.c index d19f151..eb56687 100755 --- a/o/gbc.c +++ b/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 *x) { 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_BYTES_CONTBLOCK,i=off>>LOG_BITS_CHAR,s=off&~(~0UL<>s)&0x1) #define bit_set(v,i,s) (v[i]|=(1UL<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>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<>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_pointerc.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; diff --git a/o/main.c b/o/main.c index 2f95b49..cc90668 100755 --- a/o/main.c +++ b/o/main.c @@ -207,11 +207,19 @@ get_proc_meminfo_value_in_pages(const char *k) { 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>1); + if (j>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)); } diff --git a/o/nfunlink.c b/o/nfunlink.c index a6e9a39..6ec37f2 100755 --- a/o/nfunlink.c +++ b/o/nfunlink.c @@ -212,19 +212,24 @@ IapplyVector(object fun, int nargs, object *base) 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);} } diff --git a/o/nsocket.c b/o/nsocket.c index 506f0ab..4eff907 100644 --- a/o/nsocket.c +++ b/o/nsocket.c @@ -204,7 +204,7 @@ CreateSocket(int port, char *host, int server, char *myaddr, int myport, int asy * 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 server, char *myaddr, int myport, int asy fcntl(sock, F_SETFD, FD_CLOEXEC); - asyncConnect = 0; + /* asyncConnect = 0; */ status = 0; if (server) { @@ -285,7 +285,7 @@ CreateSocket(int port, char *host, int server, char *myaddr, int myport, int asy sizeof(sockaddr)); if (status < 0) { if (errno == EINPROGRESS) { - asyncConnect = 1; + /* asyncConnect = 1; */ status = 0; } } diff --git a/o/prelink.c b/o/prelink.c index b6fcb47..737df65 100644 --- a/o/prelink.c +++ b/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) { diff --git a/o/print.d b/o/print.d index f3b8039..b4ec71e 100755 --- a/o/print.d +++ b/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); diff --git a/o/read.d b/o/read.d index b9bf2b6..baae4d6 100755 --- a/o/read.d +++ b/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; diff --git a/o/run_process.c b/o/run_process.c index 0cfcfc2..c260ae2 100755 --- a/o/run_process.c +++ b/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); } diff --git a/o/sockets.c b/o/sockets.c index 0a49480..9118f0b 100755 --- a/o/sockets.c +++ b/o/sockets.c @@ -338,7 +338,7 @@ DEFUN_NEW("OUR-READ-WITH-OFFSET",object,fSour_read_with_offset,SI,5,5,NONE, 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)); } diff --git a/o/unexelf.c b/o/unexelf.c index 8a1ced7..15c1220 100755 --- a/o/unexelf.c +++ b/o/unexelf.c @@ -660,7 +660,7 @@ unexec (char *new_name, char *old_name, unsigned int data_start, unsigned int bs 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, unsigned int data_start, unsigned int bs /* 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. diff --git a/xgcl-2/gcl_general.lsp b/xgcl-2/gcl_general.lsp index 8a6be1f..ae30642 100644 --- a/xgcl-2/gcl_general.lsp +++ b/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;"