{
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++)
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) {
(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)))))
((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)))))
#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
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
#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
{ 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,
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
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;}}
#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
#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)
/* punt guess for no randomize value */
#undef ADDR_NO_RANDOMIZE
-/* compile ansi compliant image */
-#undef ANSI_COMMON_LISP
-
/* binding stack size */
#undef BDSSIZE
/* 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.
*/
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 */
void
add_page_to_freelist(char *, struct typemanager *);
+
+ufixnum
+sum_maxpages(void);
+
+void
+resize_hole(ufixnum,enum type);
+
+void
+setup_rb(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--;
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();
}
if (!s) {
- if (nn>holepage) {
+ if (nn>((rb_start-heap_end)>>PAGEWIDTH)) {
fixnum d=available_pages-nn;
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;
struct pageinfo *cell_list_head=NULL,*cell_list_tail=NULL;;
-static inline ufixnum
+ufixnum
sum_maxpages(void) {
ufixnum i,j;
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;
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;
{ 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)
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
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
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
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)
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);
}
}
static void
FFN(Fsetf)(object form)
{
- object result,*t,*t1;
+ object *t,*t1;
if (endp(form)) {
vs_base = vs_top;
vs_push(Cnil);
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;
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);
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; \
{
VOL object x;
VOL int i, j;
- fmt_old;
+ fmt_old1;
jmp_buf fmt_jmp_buf0;
int up_colon;
bool b;
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)))
;
object x;
int n=0;
bool done;
- fmt_old;
+ fmt_old1;
fmt_not_colon_atsign(colon, atsign);
if (colon) {
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;
}
;
else {
--fmt_index;
- fmt_save;
+ fmt_save1;
format(fmt_stream, ctl_origin + i, j - i);
fmt_restore1;
}
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;
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;
}
{
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;
;
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;
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;
IMPLEMENTATION-DEPENDENT
*/
-/* #define DEBUG */
+#define DEBUG
#define IN_GBC
#define NEED_MP_H
}
-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);
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))
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) {
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) {
set_bits(CB_SGCF_START(pi),pi,x1,x2);
}
+#endif
+
#ifdef KCLOVM
void mark_all_stacks();
bool ovm_process_created;
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;
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) {
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) {
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
#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",
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");
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));
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));
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;
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
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;
}
#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;
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;
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;
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;
saving_system = FALSE;
siLsave();
- alloc_page(-(holepage+2*nrbpage));
}
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);}
}
* 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 */
fcntl(sock, F_SETFD, FD_CLOEXEC);
- asyncConnect = 0;
+ /* asyncConnect = 0; */
status = 0;
if (server) {
sizeof(sockaddr));
if (status < 0) {
if (errno == EINPROGRESS) {
- asyncConnect = 1;
+ /* asyncConnect = 1; */
status = 0;
}
}
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) {
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);
/* to prevent longjmp clobber */
i=(long)&vsp;
+ i+=i;
vsp=&vspo;
old_READtable = READtable;
old_READdefault_float_format = READdefault_float_format;
char *host;
int server;
{
- int res;
int pid;
int sock;
struct hostent *hp;
}
#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);
}
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));
}
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
/* 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.
;; 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;"
projects / gcl27.git / commitdiff