clang changes from 2.6 - gcl.git - GNU Common Lisp

diff --git a/gcl/configure b/gcl/configure
index 439f7637b..0e983d9e0 100755
--- a/gcl/configure
+++ b/gcl/configure

@@ -7471,6 +7471,12 @@ rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \

fi

+if test "$use" = "386-macosx" ; then

+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: emulating sbrk for mac" >&5

+$as_echo "emulating sbrk for mac" >&6; };

+ HAVE_SBRK=0

+fi

+

if test "$HAVE_SBRK" = "1" ; then

{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ADDR_COMPAT_LAYOUT constant" >&5

@@ -8550,9 +8556,8 @@ main ()

FILE *fp = fopen("conftest1","w");

for (i=2,k=1;i;k=i,i<<=1);

- l=$cstack_address + ($cstack_direction==1 ? $enable_cssize : 0);

- m=$dbegin + ((unsigned long)$enable_maxpage << $PAGEWIDTH);

- l=l<m ? m : l;

+ l=$cstack_address;

+ l=$cstack_direction==1 ? (l<k ? k-1 : -1) : l;

for (i=j=k;j && i<l;j>>=1,i|=j);

if (j<(k>>3)) i=0;

j=1;

@@ -8572,7 +8577,7 @@ _ACEOF

if ac_fn_c_try_run "$LINENO"; then :

mem_top=`cat conftest1`

else

- mem_top=0

+ mem_top="0x0"

fi

rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \

conftest.$ac_objext conftest.beam conftest.$ac_ext

@@ -8580,7 +8585,7 @@ fi

{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $mem_top" >&5

$as_echo "$mem_top" >&6; }

-if test "$mem_top" != "0" ; then

+if test "$mem_top" != "0x0" ; then

{ $as_echo "$as_me:${as_lineno-$LINENO}: checking finding upper mem half range" >&5

$as_echo_n "checking finding upper mem half range... " >&6; }

if test "$cross_compiling" = yes; then :

@@ -8613,7 +8618,7 @@ _ACEOF

if ac_fn_c_try_run "$LINENO"; then :

mem_range=`cat conftest1`

else

- mem_range=0

+ mem_range="0x0"

fi

rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \

conftest.$ac_objext conftest.beam conftest.$ac_ext

@@ -8621,7 +8626,7 @@ fi

{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $mem_range" >&5

$as_echo "$mem_range" >&6; }

- if test "$mem_range" != "0" ; then

+ if test "$mem_range" != "0x0" ; then

cat >>confdefs.h <<_ACEOF

#define MEM_TOP $mem_top

diff --git a/gcl/configure.in b/gcl/configure.in
index da328150a..92b2ee27a 100644
--- a/gcl/configure.in
+++ b/gcl/configure.in

@@ -1333,6 +1333,11 @@ AC_RUN_IFELSE([

AC_MSG_RESULT(yes)],

[AC_MSG_RESULT([no: WARNING you must be able to emulate sbrk: as on mingw or macosx])])

+if test "$use" = "386-macosx" ; then

+ AC_MSG_RESULT(emulating sbrk for mac);

+ HAVE_SBRK=0

+fi

+

if test "$HAVE_SBRK" = "1" ; then

AC_MSG_CHECKING([for ADDR_COMPAT_LAYOUT constant])

@@ -1906,9 +1911,8 @@ AC_RUN_IFELSE([AC_LANG_PROGRAM([[

FILE *fp = fopen("conftest1","w");

for (i=2,k=1;i;k=i,i<<=1);

- l=$cstack_address + ($cstack_direction==1 ? $enable_cssize : 0);

- m=$dbegin + ((unsigned long)$enable_maxpage << $PAGEWIDTH);

- l=l<m ? m : l;

+ l=$cstack_address;

+ l=$cstack_direction==1 ? (l<k ? k-1 : -1) : l;

for (i=j=k;j && i<l;j>>=1,i|=j);

if (j<(k>>3)) i=0;

j=1;

@@ -1920,9 +1924,9 @@ AC_RUN_IFELSE([AC_LANG_PROGRAM([[

fprintf(fp,"0x%lx",i);

fclose(fp);

return 0;

-]])],[mem_top=`cat conftest1`],[mem_top=0])

+]])],[mem_top=`cat conftest1`],[mem_top="0x0"])

AC_MSG_RESULT($mem_top)

-if test "$mem_top" != "0" ; then

+if test "$mem_top" != "0x0" ; then

AC_MSG_CHECKING(finding upper mem half range)

AC_RUN_IFELSE([AC_LANG_PROGRAM([[

#include <stdio.h>

@@ -1934,9 +1938,9 @@ if test "$mem_top" != "0" ; then

fprintf(fp,"0x%lx",j>>1);

fclose(fp);

return 0;

- ]])],[mem_range=`cat conftest1`],[mem_range=0])

+ ]])],[mem_range=`cat conftest1`],[mem_range="0x0"])

AC_MSG_RESULT($mem_range)

- if test "$mem_range" != "0" ; then

+ if test "$mem_range" != "0x0" ; then

AC_DEFINE_UNQUOTED(MEM_TOP,$mem_top,[beginning address for immediate fixnum range])

AC_DEFINE_UNQUOTED(MEM_RANGE,$mem_range,[size of immediate fixnum address space])

fi

@@ -1951,7 +1955,6 @@ if test "$enable_immfix" = "yes" ; then

fi

fi

-

AC_MSG_CHECKING([sizeof long long int])

AC_RUN_IFELSE([AC_LANG_PROGRAM([[

#include <stdio.h>

diff --git a/gcl/h/386-macosx.h b/gcl/h/386-macosx.h
index d6447f45d..67416998c 100644
--- a/gcl/h/386-macosx.h
+++ b/gcl/h/386-macosx.h

@@ -170,7 +170,7 @@ int main(void)

#undef LISTEN_FOR_INPUT

#define LISTEN_FOR_INPUT(fp) \

do {int c=0; \

- if ((fp)->_r <=0 && (c=0, ioctl((fp)->_file, FIONREAD, &c), c<=0)) \

+ if (((FILE *)fp)->_r <=0 && (c=0, ioctl(((FILE *)fp)->_file, FIONREAD, &c), c<=0)) \

return(FALSE); \

} while (0)

@@ -196,3 +196,27 @@ if (realpath (buf, fub) == 0) { \

#else

#define RELOC_H "mach32_i386_reloc.h"

#endif

+

+#define UC(a_) ((ucontext_t *)a_)

+#define SF(a_) ((siginfo_t *)a_)

+

+#define FPE_CODE(i_,v_) make_fixnum(FFN(fSfpe_code)(*(fixnum *)&UC(v_)->uc_mcontext->__fs.__fpu_fsw,UC(v_)->uc_mcontext->__fs.__fpu_mxcsr))

+#define FPE_ADDR(i_,v_) make_fixnum(UC(v_)->uc_mcontext->__fs.__fpu_fop ? UC(v_)->uc_mcontext->__fs.__fpu_ip : (fixnum)SF(i_)->si_addr)

+#define FPE_CTXT(v_) list(3,make_fixnum((fixnum)&UC(v_)->uc_mcontext->__ss), \

+ make_fixnum((fixnum)&UC(v_)->uc_mcontext->__fs.__fpu_stmm0), \

+ make_fixnum((fixnum)&UC(v_)->uc_mcontext->__fs.__fpu_xmm0))

+

+

+#define MC(b_) v.uc_mcontext->b_

+#define REG_LIST(a_,b_) MMcons(make_fixnum(a_*sizeof(b_)),make_fixnum(sizeof(b_)))

+#define MCF(b_) ((MC(__fs)).b_)

+

+#ifdef __x86_64__

+#define FPE_RLST "RAX RBX RCX RDX RDI RSI RBP RSP R8 R9 R10 R11 R12 R13 R14 R15 RIP RFLAGS CS FS GS"

+#else

+#error Missing reg list

+#endif

+

+#define FPE_INIT ({ucontext_t v;list(3,MMcons(make_simple_string(({const char *s=FPE_RLST;s;})),REG_LIST(21,MC(__ss))), \

+ REG_LIST(8,MCF(__fpu_stmm0)),REG_LIST(16,MCF(__fpu_xmm0)));})

+

diff --git a/gcl/h/att_ext.h b/gcl/h/att_ext.h
index 8d2d46ca7..40458e08a 100755
--- a/gcl/h/att_ext.h
+++ b/gcl/h/att_ext.h

@@ -23,7 +23,6 @@ Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

#endif

/* alloc.c */

-void *alloc_page();

object alloc_object();

void *malloc(size_t);

void *realloc(void *,size_t);

diff --git a/gcl/h/compbas.h b/gcl/h/compbas.h
index f55400e22..12d55c7f1 100755
--- a/gcl/h/compbas.h
+++ b/gcl/h/compbas.h

@@ -3,3 +3,10 @@

#include <setjmp.h>

+#ifndef INLINE

+#if (defined(__GNUC__) && __GNUC__ <= 4) && !defined __clang__

+#define INLINE extern inline

+#else

+#define INLINE inline

+#endif

+#endif

diff --git a/gcl/h/error.h b/gcl/h/error.h
new file mode 100644
index 000000000..66cd3808e
--- /dev/null
+++ b/gcl/h/error.h

@@ -0,0 +1,199 @@

+#define Icall_error_handler(a_,b_,c_,d_...) \

+ Icall_gen_error_handler(Cnil,null_string,a_,b_,c_,##d_)

+#define Icall_continue_error_handler(a_,b_,c_,d_,e_...) \

+ Icall_gen_error_handler(Ct,a_,b_,c_,d_,##e_)

+

+

+extern enum type t_vtype;

+extern int vtypep_fn(object);

+extern void Check_type(object *,int (*)(object),object);

+

+#define PFN(a_) INLINE int Join(a_,_fn)(object x) {return a_(x);}

+

+PFN(integerp)

+PFN(non_negative_integerp)

+PFN(rationalp)

+PFN(floatp)

+PFN(realp)

+PFN(numberp)

+PFN(characterp)

+PFN(symbolp)

+PFN(stringp)

+PFN(string_symbolp)

+PFN(packagep)

+PFN(consp)

+PFN(listp)

+PFN(streamp)

+PFN(pathname_string_symbolp)

+PFN(pathname_string_symbol_streamp)

+PFN(randomp)

+PFN(hashtablep)

+PFN(arrayp)

+PFN(vectorp)

+PFN(readtablep)

+PFN(functionp)

+

+#define TPE(a_,b_,c_) if (!(b_)(*(a_))) FEwrong_type_argument((c_),*(a_))

+

+#define check_type(a_,b_) ({t_vtype=(b_);TPE(&a_,vtypep_fn,type_name(t_vtype));})

+#define check_type_function(a_) TPE(a_,functionp_fn,sLfunction)

+#define check_type_integer(a_) TPE(a_,integerp_fn,sLinteger)

+#define check_type_non_negative_integer(a_) TPE(a_,non_negative_integerp_fn,TSnon_negative_integer)

+#define check_type_rational(a_) TPE(a_,rationalp_fn,sLrational)

+#define check_type_float(a_) TPE(a_,floatp_fn,sLfloat)

+#define check_type_real(a_) TPE(a_,realp_fn,sLreal)

+#define check_type_or_rational_float(a_) TPE(a_,realp_fn,sLreal)

+#define check_type_number(a_) TPE(a_,numberp_fn,sLnumber)

+#define check_type_stream(a_) TPE(a_,streamp_fn,sLstream)

+#define check_type_hash_table(a_) TPE(a_,hashtablep_fn,sLhash_table)

+#define check_type_character(a_) TPE(a_,characterp_fn,sLcharacter)

+#define check_type_sym(a_) TPE(a_,symbolp_fn,sLsymbol)

+#define check_type_string(a_) TPE(a_,stringp_fn,sLstring)

+#define check_type_or_string_symbol(a_) TPE(a_,string_symbolp_fn,TSor_symbol_string)

+#define check_type_or_symbol_string(a_) TPE(a_,string_symbolp_fn,TSor_symbol_string)

+#define check_type_or_pathname_string_symbol_stream(a_) TPE(a_,pathname_string_symbol_streamp_fn,TSor_pathname_string_symbol_stream)

+#define check_type_or_Pathname_string_symbol(a_) TPE(a_,pathname_string_symbolp_fn,TSor_pathname_string_symbol)

+#define check_type_package(a_) TPE(a_,packagep_fn,sLpackage)

+#define check_type_cons(a_) TPE(a_,consp_fn,sLcons)

+#define check_type_list(a_) TPE(a_,listp_fn,sLlist)

+#define check_type_stream(a_) TPE(a_,streamp_fn,sLstream)

+#define check_type_array(a_) TPE(a_,arrayp_fn,sLarray)

+#define check_type_vector(a_) TPE(a_,vectorp_fn,sLvector)

+#define check_type_readtable_no_default(a_) TPE(a_,readtablep_fn,sLreadtable)

+#define check_type_readtable(a_) ({if (*(a_)==Cnil) *(a_)=standard_readtable;TPE(a_,readtablep_fn,sLreadtable);})

+#define check_type_random_state(a_) TPE(a_,randomp_fn,sLrandom_state)

+

+#define stack_string(a_,b_) struct string _s={0};\

+ object a_=(object)&_s;\

+ set_type_of((a_),t_string);\

+ (a_)->st.st_self=(void *)(b_);\

+ (a_)->st.st_dim=(a_)->st.st_fillp=strlen(b_)

+

+#define stack_fixnum(a_,b_) struct fixnum_struct _s={0};\

+ object a_;\

+ if (is_imm_fix(b_)) (a_)=make_fixnum(b_); else {\

+ (a_)=(object)&_s;\

+ set_type_of((a_),t_fixnum);\

+ (a_)->FIX.FIXVAL=(b_);}

+

+/*FIXME the stack stuff is dangerous It works for error handling, but

+ simple errors may evan pass the format tring up the stack as a slot

+ in ansi*/

+/* #define TYPE_ERROR(a_,b_) {stack_string(tp_err,"~S is not of type ~S.");\ */

+/* Icall_error_handler(sKwrong_type_argument,tp_err,2,(a_),(b_));} */

+

+object ihs_top_function_name(ihs_ptr h);

+#define FEerror(a_,b_...) Icall_error_handler(sLerror,null_string,\

+ 4,sKformat_control,make_simple_string(a_),sKformat_arguments,list(b_))

+#define CEerror(a_,b_,c_...) Icall_continue_error_handler(make_simple_string(a_),sLerror,null_string,\

+ 4,sKformat_control,make_simple_string(b_),sKformat_arguments,list(c_))

+

+#define TYPE_ERROR(a_,b_) Icall_error_handler(sLtype_error,null_string,\

+ 4,sKdatum,(a_),sKexpected_type,(b_))

+#define FEwrong_type_argument(a_,b_) TYPE_ERROR(b_,a_)

+#define FEcannot_coerce(a_,b_) TYPE_ERROR(b_,a_)

+#define FEinvalid_function(a_) TYPE_ERROR(a_,sLfunction)

+

+#define CONTROL_ERROR(a_) Icall_error_handler(sLcontrol_error,null_string,4,sKformat_control,make_simple_string(a_),sKformat_arguments,Cnil)

+

+#define PROGRAM_ERROR(a_,b_) Icall_error_handler(sLprogram_error,null_string,4,\

+ sKformat_control,make_simple_string(a_),sKformat_arguments,list(1,(b_)))

+#define FEtoo_few_arguments(a_,b_) \

+ Icall_error_handler(sLprogram_error,null_string,4,\

+ sKformat_control,make_simple_string("~S [or a callee] requires more than ~R argument~:p."),\

+ sKformat_arguments,list(2,ihs_top_function_name(ihs_top),make_fixnum((b_)-(a_))))

+#define FEwrong_no_args(a_,b_) \

+ Icall_error_handler(sLprogram_error,null_string,4,\

+ sKformat_control,make_simple_string(a_),\

+ sKformat_arguments,list(2,ihs_top_function_name(ihs_top),(b_)))

+#define FEtoo_few_argumentsF(a_) \

+ Icall_error_handler(sLprogram_error,null_string,4,\

+ sKformat_control,make_simple_string("Too few arguments."),\

+ sKformat_arguments,list(2,ihs_top_function_name(ihs_top),(a_)))

+

+#define FEtoo_many_arguments(a_,b_) \

+ Icall_error_handler(sLprogram_error,null_string,4,\

+ sKformat_control,make_simple_string("~S [or a callee] requires less than ~R argument~:p."),\

+ sKformat_arguments,list(2,ihs_top_function_name(ihs_top),make_fixnum((b_)-(a_))))

+#define FEtoo_many_argumentsF(a_) \

+ Icall_error_handler(sLprogram_error,null_string,4,\

+ sKformat_control,make_simple_string("Too many arguments."),\

+ sKformat_arguments,list(2,ihs_top_function_name(ihs_top),(a_)))

+#define FEinvalid_macro_call() \

+ Icall_error_handler(sLprogram_error,null_string,4,\

+ sKformat_control,make_simple_string("Invalid macro call to ~S."),\

+ sKformat_arguments,list(1,ihs_top_function_name(ihs_top)))

+#define FEunexpected_keyword(a_) \

+ Icall_error_handler(sLprogram_error,null_string,4,\

+ sKformat_control,make_simple_string("~S does not allow the keyword ~S."),\

+ sKformat_arguments,list(2,ihs_top_function_name(ihs_top),(a_)))

+#define FEinvalid_form(a_,b_) \

+ Icall_error_handler(sLprogram_error,null_string,4,\

+ sKformat_control,make_simple_string(a_),\

+ sKformat_arguments,list(1,(b_)))

+#define FEinvalid_variable(a_,b_) FEinvalid_form(a_,b_)

+

+#define PARSE_ERROR(a_) Icall_error_handler(sLparse_error,null_string,4,\

+ sKformat_control,make_simple_string(a_),sKformat_arguments,Cnil)

+#define STREAM_ERROR(a_,b_) Icall_error_handler(sLstream_error,null_string,6,\

+ sKstream,a_,\

+ sKformat_control,make_simple_string(b_),sKformat_arguments,Cnil)

+#define READER_ERROR(a_,b_) Icall_error_handler(sLreader_error,null_string,6,\

+ sKstream,a_,\

+ sKformat_control,make_simple_string(b_),sKformat_arguments,Cnil)

+#define FILE_ERROR(a_,b_) Icall_error_handler(sLfile_error,null_string,6,\

+ sKpathname,a_,\

+ sKformat_control,make_simple_string(b_),sKformat_arguments,Cnil)

+#define END_OF_FILE(a_) Icall_error_handler(sLend_of_file,null_string,2,sKstream,a_)

+#define PACKAGE_ERROR(a_,b_) Icall_error_handler(sLpackage_error,null_string,6,\

+ sKpackage,a_,\

+ sKformat_control,make_simple_string(b_),sKformat_arguments,Cnil)

+#define FEpackage_error(a_,b_) PACKAGE_ERROR(a_,b_)

+#define PACKAGE_CERROR(a_,b_,c_,d_...) \

+ Icall_continue_error_handler(make_simple_string(b_),\

+ sLpackage_error,null_string,6,\

+ sKpackage,a_,\

+ sKformat_control,make_simple_string(c_),sKformat_arguments,list(d_))

+#define NEW_INPUT(a_) (a_)=Ieval1(read_object(sLAstandard_inputA->s.s_dbind))

+

+

+#define CELL_ERROR(a_,b_) Icall_error_handler(sLcell_error,null_string,6,\

+ sKname,a_,\

+ sKformat_control,make_simple_string(b_),sKformat_arguments,Cnil)

+#define UNBOUND_VARIABLE(a_) Icall_error_handler(sLunbound_variable,null_string,2,sKname,a_)

+#define FEunbound_variable(a_) UNBOUND_VARIABLE(a_)

+

+#define UNBOUND_SLOT(a_,b_) Icall_error_handler(sLunbound_slot,null_string,4,sKname,a_,sKinstance,b_)

+#define UNDEFINED_FUNCTION(a_) Icall_error_handler(sLundefined_function,null_string,2,sKname,a_)

+#define FEundefined_function(a_) UNDEFINED_FUNCTION(a_)

+

+#define ARITHMETIC_ERROR(a_,b_) Icall_error_handler(sLarithmetic_error,null_string,4,sKoperation,a_,sKoperands,b_)

+#define DIVISION_BY_ZERO(a_,b_) Icall_error_handler(sLdivision_by_zero,null_string,4,sKoperation,a_,sKoperands,b_)

+#define FLOATING_POINT_OVERFLOW(a_,b_) Icall_error_handler(sLfloating_point_overflow,null_string,4,sKoperation,a_,sKoperands,b_)

+#define FLOATING_POINT_UNDERFLOW(a_,b_) Icall_error_handler(sLfloating_point_underflow,null_string,4,sKoperation,a_,sKoperands,b_)

+#define FLOATING_POINT_INEXACT(a_,b_) Icall_error_handler(sLfloating_point_inexact,null_string,4,sKoperation,a_,sKoperands,b_)

+#define FLOATING_POINT_INVALID_OPERATION(a_,b_) Icall_error_handler(sLfloating_point_invalid_operation,null_string,4,sKoperation,a_,sKoperands,b_)

+

+#define PATHNAME_ERROR(a_,b_,c_...) Icall_error_handler(sLfile_error,null_string,6,\

+ sKpathname,(a_),\

+ sKformat_control,make_simple_string(b_),\

+ sKformat_arguments,list(c_))

+#define WILD_PATH(a_) ({object _a=(a_);PATHNAME_ERROR(_a,"File ~s is wild",1,_a);})

+

+

+#define NERROR(a_) ({object fmt=make_simple_string(a_ ": line ~a, file ~a, function ~a");\

+ {object line=make_fixnum(__LINE__);\

+ {object file=make_simple_string(__FILE__);\

+ {object function=make_simple_string(__FUNCTION__);\

+ Icall_error_handler(sKerror,fmt,3,line,file,function);}}}})

+

+#define ASSERT(a_) do {if (!(a_)) NERROR("The assertion " #a_ " failed");} while (0)

+

+#define gcl_abort() ({\

+ frame_ptr fr=frs_sch_catch(sSPtop_abort_tagP->s.s_dbind);\

+ vs_base[0]=sSPtop_abort_tagP->s.s_dbind;\

+ vs_top=vs_base+1;\

+ if (fr) unwind(fr,sSPtop_abort_tagP->s.s_dbind);\

+ abort();\

+ })

+

diff --git a/gcl/h/fixnum.h b/gcl/h/fixnum.h
index 091c3c485..9f08d1582 100644
--- a/gcl/h/fixnum.h
+++ b/gcl/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/gcl/h/gmp_wrappers.h b/gcl/h/gmp_wrappers.h
index 6fb8db98b..6de28b6b8 100644
--- a/gcl/h/gmp_wrappers.h
+++ b/gcl/h/gmp_wrappers.h

@@ -1,12 +1,5 @@

-#ifndef GMP_EXTERN

-#define GMP_EXTERN extern

-#endif

-#ifndef GMP_EXTERN_INLINE

-#define GMP_EXTERN_INLINE GMP_EXTERN __inline__

-#endif

-

-GMP_EXTERN jmp_buf gmp_jmp;

-GMP_EXTERN int jmp_gmp,gmp_relocatable;

+EXTER jmp_buf gmp_jmp;

+EXTER int jmp_gmp,gmp_relocatable;

#define join(a_,b_) a_ ## b_

#define Join(a_,b_) join(a_,b_)

@@ -179,7 +172,7 @@ GMP_EXTERN int jmp_gmp,gmp_relocatable;

set to -1 otherwise. 20040815 CM*/

#define MEM_GMP_CALL(n_,rt_,a_,s_,b_...) \

- GMP_EXTERN_INLINE Join(RF_,rt_) Join(m,a_)(Join(P,n_)(b_)) { \

+ INLINE Join(RF_,rt_) Join(m,a_)(Join(P,n_)(b_)) { \

int j;\

Join(RD_,rt_);\

if (gmp_relocatable) {\

diff --git a/gcl/h/immnum.h b/gcl/h/immnum.h
index 0a7034f85..dd89cb7c9 100644
--- a/gcl/h/immnum.h
+++ b/gcl/h/immnum.h

@@ -19,10 +19,10 @@

#define iif2(x,y) is_imm_fixnum2(x,y)

-EXTER inline fixnum

+INLINE fixnum

lnabs(fixnum x) {return x<0 ? ~x : x;}

-EXTER inline char

+INLINE char

clz(ufixnum x) {

#ifdef HAVE_CLZL

return x ? __builtin_clzl(x) : sizeof(x)*8;

@@ -31,7 +31,7 @@ clz(ufixnum x) {

#endif

}

-EXTER inline char

+INLINE char

ctz(ufixnum x) {

#ifdef HAVE_CTZL

return __builtin_ctzl(x);/*x ? __builtin_clzl(x) : sizeof(x)*8;*/

@@ -40,11 +40,11 @@ ctz(ufixnum x) {

#endif

}

-EXTER inline char

+INLINE char

fixnum_length(fixnum x) {return sizeof(x)*8-clz(lnabs(x));}

-EXTER inline object

-immnum_length(object x) {return iif(x) ? mif(fixnum_length(fif(x))) : integer_length(x);}

+INLINE object

+immnum_length(object x) {return iif(x) ? mif((fixnum)fixnum_length(fif(x))) : integer_length(x);}

#if SIZEOF_LONG == 8

@@ -59,7 +59,7 @@ immnum_length(object x) {return iif(x) ? mif(fixnum_length(fif(x))) : integer_le

#define POPD 0x3F

#endif

-EXTER inline char

+INLINE char

fixnum_popcount(ufixnum x) {

x-=POPA&(x>>1);

x=(x&POPB)+((x>>2)&POPB);

@@ -72,34 +72,34 @@ fixnum_popcount(ufixnum x) {

return x&POPD;

}

-EXTER inline char

+INLINE char

/* fixnum_count(fixnum x) {return __builtin_popcountl(lnabs(x));} */

fixnum_count(fixnum x) {return fixnum_popcount(lnabs(x));}

-EXTER inline object

-immnum_count(object x) {return iif(x) ? mif(fixnum_count(fif(x))) : integer_count(x);}

+INLINE object

+immnum_count(object x) {return iif(x) ? mif((fixnum)fixnum_count(fif(x))) : integer_count(x);}

/*bs=sizeof(long)*8;

lb=bs-clz(labs(x));|x*y|=|x|*|y|<2^(lbx+lby)<2^(bs-1);

0 bounded by 2^0, +-1 by 2^1,mpf by 2^(bs-1), which is sign bit

protect labs from most negative fix, here all immfix ok*/

long int labs(long int j);

-EXTER inline bool

+INLINE bool

fixnum_mul_safe_abs(fixnum x,fixnum y) {return clz(x)+clz(y)>sizeof(x)*8+1;}

-EXTER inline object

+INLINE object

safe_mul_abs(fixnum x,fixnum y) {return fixnum_mul_safe_abs(x,y) ? make_fixnum(x*y) : fixnum_times(x,y);}

-EXTER inline bool

+INLINE bool

fixnum_mul_safe(fixnum x,fixnum y) {return fixnum_mul_safe_abs(labs(x),labs(y));}

-EXTER inline object

+INLINE object

safe_mul(fixnum x,fixnum y) {return fixnum_mul_safe(x,y) ? make_fixnum(x*y) : fixnum_times(x,y);}

-EXTER inline object

+INLINE object

immnum_times(object x,object y) {return iif2(x,y) ? safe_mul(fif(x),fif(y)) : number_times(x,y);}

-EXTER inline object

+INLINE object

immnum_plus(object x,object y) {return iif2(x,y) ? make_fixnum(fif(x)+fif(y)) : number_plus(x,y);}

-EXTER inline object

+INLINE object

immnum_minus(object x,object y) {return iif2(x,y) ? make_fixnum(fif(x)-fif(y)) : number_minus(x,y);}

-EXTER inline object

+INLINE object

immnum_negate(object x) {return iif(x) ? make_fixnum(-fif(x)) : number_negate(x);}

#define BOOLCLR 0

@@ -119,7 +119,7 @@ immnum_negate(object x) {return iif(x) ? make_fixnum(-fif(x)) : number_negate(x)

#define BOOLORC1 015

#define BOOLORC2 013

-EXTER inline fixnum

+INLINE fixnum

fixnum_boole(fixnum op,fixnum x,fixnum y) {

switch(op) {

case BOOLCLR: return 0;

@@ -142,7 +142,7 @@ fixnum_boole(fixnum op,fixnum x,fixnum y) {

return 0;/*FIXME error*/

}

-EXTER inline object

+INLINE object

immnum_boole(fixnum o,object x,object y) {return iif2(x,y) ? mif(fixnum_boole(o,fif(x),fif(y))) : log_op2(o,x,y);}

#define immnum_bool(o,x,y) immnum_boole(fixint(o),x,y)

@@ -159,93 +159,93 @@ immnum_boole(fixnum o,object x,object y) {return iif2(x,y) ? mif(fixnum_boole(o,

#define immnum_orc1(x,y) immnum_boole(BOOLORC1,x,y)

#define immnum_orc2(x,y) immnum_boole(BOOLORC2,x,y)

-EXTER inline fixnum

+INLINE fixnum

fixnum_div(fixnum x,fixnum y,fixnum d) {

fixnum z=x/y;

if (d && x!=y*z && (x*d>0 ? y>0 : y<0))

z+=d;

return z;

}

-EXTER inline fixnum

+INLINE fixnum

fixnum_rem(fixnum x,fixnum y,fixnum d) {

fixnum z=x%y;

if (d && z && (x*d>0 ? y>0 : y<0))

z+=y;

return z;

}

-EXTER inline object

+INLINE object

immnum_truncate(object x,object y) {return iif2(x,y)&&y!=make_fixnum(0) ? mif(fixnum_div(fif(x),fif(y),0)) : (intdivrem(x,y,0,&x,0),x);}

-EXTER inline object

+INLINE object

immnum_floor(object x,object y) {return iif2(x,y)&&y!=make_fixnum(0) ? mif(fixnum_div(fif(x),fif(y),-1)) : (intdivrem(x,y,-1,&x,0),x);}

-EXTER inline object

+INLINE object

immnum_ceiling(object x,object y) {return iif2(x,y)&&y!=make_fixnum(0) ? mif(fixnum_div(fif(x),fif(y),1)) : (intdivrem(x,y,1,&x,0),x);}

-EXTER inline object

+INLINE object

immnum_mod(object x,object y) {return iif2(x,y)&&y!=make_fixnum(0) ? mif(fixnum_rem(fif(x),fif(y),-1)) : (intdivrem(x,y,-1,0,&y),y);}

-EXTER inline object

+INLINE object

immnum_rem(object x,object y) {return iif2(x,y)&&y!=make_fixnum(0) ? mif(fixnum_rem(fif(x),fif(y),0)) : (intdivrem(x,y,0,0,&y),y);}

-EXTER inline fixnum

+INLINE fixnum

fixnum_rshft(fixnum x,fixnum y) {

return y>=sizeof(x)*8 ? (x<0 ? -1 : 0) : x>>y;

}

-EXTER inline object

+INLINE object

fixnum_lshft(fixnum x,fixnum y) {

return clz(labs(x))>y ? make_fixnum(x<<y) : (x ? fixnum_big_shift(x,y) : make_fixnum(0));

}

-EXTER inline object

+INLINE object

fixnum_shft(fixnum x,fixnum y) {

return y<0 ? make_fixnum(fixnum_rshft(x,-y)) : fixnum_lshft(x,y);

}

-EXTER inline object

+INLINE object

immnum_shft(object x,object y) {return iif2(x,y) ? fixnum_shft(fif(x),fif(y)) : integer_shift(x,y);}

-EXTER inline bool

+INLINE bool

fixnum_bitp(fixnum p,fixnum x) {return fixnum_rshft(x,p)&0x1;}

-EXTER inline bool

+INLINE bool

immnum_bitp(object x,object y) {return iif2(x,y) ? fixnum_bitp(fif(x),fif(y)) : integer_bitp(x,y);}

#define immnum_comp(x,y,c) iif2(x,y) ? (x c y) : (number_compare(x,y) c 0)

-EXTER inline bool

+INLINE bool

immnum_lt(object x,object y) {return immnum_comp(x,y,<);}

-EXTER inline bool

+INLINE bool

immnum_le(object x,object y) {return immnum_comp(x,y,<=);}

-EXTER inline bool

+INLINE bool

immnum_eq(object x,object y) {return immnum_comp(x,y,==);}

-EXTER inline bool

+INLINE bool

immnum_ne(object x,object y) {return immnum_comp(x,y,!=);}

-EXTER inline bool

+INLINE bool

immnum_gt(object x,object y) {return immnum_comp(x,y,>);}

-EXTER inline bool

+INLINE bool

immnum_ge(object x,object y) {return immnum_comp(x,y,>=);}

-EXTER inline bool

+INLINE bool

immnum_minusp(object x) {return iif(x) ? ((ufixnum)x)<((ufixnum)make_fixnum(0)) : number_minusp(x);}

-EXTER inline bool

+INLINE bool

immnum_plusp(object x) {return iif(x) ? ((ufixnum)x)>((ufixnum)make_fixnum(0)) : number_plusp(x);}

-EXTER inline bool

+INLINE bool

immnum_zerop(object x) {return iif(x) ? ((ufixnum)x)==((ufixnum)make_fixnum(0)) : number_zerop(x);}

-EXTER inline bool

+INLINE bool

immnum_evenp(object x) {return iif(x) ? !(((ufixnum)x)&0x1) : number_evenp(x);}

-EXTER inline bool

+INLINE bool

immnum_oddp(object x) {return iif(x) ? (((ufixnum)x)&0x1) : number_oddp(x);}

-EXTER inline object

+INLINE object

immnum_signum(object x) {

ufixnum ux=(ufixnum)x,uz=((ufixnum)make_fixnum(0));

return iif(x) ? (ux<uz ? mif(-1) : (ux==uz ? mif(0) : mif(1))) : number_signum(x);

}

-EXTER inline object

+INLINE object

immnum_abs(object x) {return iif(x) ? make_fixnum(labs(fif(x))) : number_abs(x);}

-EXTER inline fixnum

+INLINE fixnum

fixnum_ldb(fixnum s,fixnum p,fixnum i) {

return ((1UL<<s)-1)&fixnum_rshft(i,p);

}

-EXTER inline object

+INLINE object

immnum_ldb(object x,object i) {

if (iif(i))

if (consp(x)) {

@@ -259,7 +259,7 @@ immnum_ldb(object x,object i) {

return number_ldb(x,i);

}

-EXTER inline bool

+INLINE bool

immnum_ldbt(object x,object i) {

if (iif(i))

if (consp(x)) {

@@ -273,13 +273,13 @@ immnum_ldbt(object x,object i) {

return number_ldbt(x,i)!=Cnil;

}

-EXTER inline fixnum

+INLINE fixnum

fixnum_dpb(fixnum s,fixnum p,fixnum n,fixnum i) {

fixnum z=(1UL<<s)-1;

return (i&~(z<<p))|((n&z)<<p);

}

-EXTER inline object

+INLINE object

immnum_dpb(object n,object x,object i) {

if (iif2(n,i))

if (consp(x)) {

@@ -293,13 +293,13 @@ immnum_dpb(object n,object x,object i) {

return number_dpb(n,x,i);

}

-EXTER inline fixnum

+INLINE fixnum

fixnum_dpf(fixnum s,fixnum p,fixnum n,fixnum i) {

fixnum z=((1UL<<s)-1)<<p;

return (i&~z)|(n&z);

}

-EXTER inline object

+INLINE object

immnum_dpf(object n,object x,object i) {

if (iif2(n,i))

if (consp(x)) {

@@ -313,15 +313,15 @@ immnum_dpf(object n,object x,object i) {

return number_dpf(n,x,i);

}

-EXTER inline object

+INLINE object

immnum_max(object x,object y) {return iif2(x,y) ? ((ufixnum)x>=(ufixnum)y ? x : y) : (number_compare(x,y)>=0?x:y);}

-EXTER inline object

+INLINE object

immnum_min(object x,object y) {return iif2(x,y) ? ((ufixnum)x<=(ufixnum)y ? x : y) : (number_compare(x,y)<=0?x:y);}

-EXTER inline bool

+INLINE bool

immnum_logt(object x,object y) {return iif2(x,y) ? fixnum_boole(BOOLAND,fif(x),fif(y))!=0 : !number_zerop(log_op2(BOOLAND,x,y));}

-EXTER inline fixnum

+INLINE fixnum

fixnum_gcd(fixnum x,fixnum y) {

fixnum t;

@@ -346,16 +346,16 @@ fixnum_gcd(fixnum x,fixnum y) {

}

-EXTER inline object

+INLINE object

immnum_gcd(object x,object y) {return iif2(x,y) ? mif(fixnum_gcd(labs(fif(x)),labs(fif(y)))) : get_gcd(x,y);}

-EXTER inline object

+INLINE object

fixnum_lcm(fixnum x,fixnum y) {

fixnum g=fixnum_gcd(x,y);

return g ? safe_mul_abs(x,fixnum_div(y,g,0)) : make_fixnum(0);

}

-EXTER inline object

+INLINE object

immnum_lcm(object x,object y) {return iif2(x,y) ? fixnum_lcm(labs(fif(x)),labs(fif(y))) : get_lcm(x,y);}

#endif

diff --git a/gcl/h/pool.h b/gcl/h/pool.h
new file mode 100644
index 000000000..05434cecb
--- /dev/null
+++ b/gcl/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))))); */

+

+}

diff --git a/gcl/h/prelink.h b/gcl/h/prelink.h
new file mode 100644
index 000000000..0e2949493
--- /dev/null
+++ b/gcl/h/prelink.h

@@ -0,0 +1,33 @@

+/* prelink support for gcl images:

+ if GCL references variables (as opposed to functions) defined in

+ external shared libraries, ld will place COPY relocations in

+ .rela.dyn pointing to a location in .bss for these references.

+ Unexec will later incorporate this into a second .data section,

+ causing prelink to fail. While one might prelink the raw images,

+ which would then be inherited by the saved images, this is not

+ convenient as part of the build process, so here we isolate the

+ problematic references and compile as position independent code,

+ changing the COPY reloc to some form of GOT.

+ */

+#ifdef NO_PRELINK_UNEXEC_DIVERSION

+#define PRELINK_EXTER

+#else

+#define PRELINK_EXTER extern

+

+#undef stdin

+#define stdin my_stdin

+#undef stdout

+#define stdout my_stdout

+#undef stderr

+#define stderr my_stderr

+

+#endif

+

+PRELINK_EXTER FILE *my_stdin;

+PRELINK_EXTER FILE *my_stdout;

+PRELINK_EXTER FILE *my_stderr;

+

+#ifdef HAVE_READLINE

+PRELINK_EXTER rl_compentry_func_t **my_rl_completion_entry_function_ptr;

+PRELINK_EXTER const char **my_rl_readline_name_ptr;

+#endif

diff --git a/gcl/h/protoize.h b/gcl/h/protoize.h
index c1dc05083..5925612ab 100644
--- a/gcl/h/protoize.h
+++ b/gcl/h/protoize.h

@@ -1,9 +1,9 @@

/* alloc.c:89:OF */ extern void *alloc_page (long n); /* (n) int n; */

-/* alloc.c:149:OF */ inline void add_page_to_freelist (char *p, struct typemanager *tm); /* (p, tm) char *p; struct typemanager *tm; */

+/* alloc.c:149:OF */ void add_page_to_freelist (char *p, struct typemanager *tm); /* (p, tm) char *p; struct typemanager *tm; */

/* alloc.c:196:OF */ extern object type_name (int t); /* (t) int t; */

-/* alloc.c:213:OF */ inline object alloc_object (enum type t); /* (t) enum type t; */

-/* alloc.c:213:OF */ inline void add_pages(struct typemanager *,fixnum);

-/* alloc.c:296:OF */ extern inline object make_cons (object a, object d); /* (a, d) object a; object d; */

+/* alloc.c:213:OF */ object alloc_object (enum type t); /* (t) enum type t; */

+/* alloc.c:213:OF */ void add_pages(struct typemanager *,fixnum);

+/* alloc.c:296:OF */ extern object make_cons (object a, object d); /* (a, d) object a; object d; */

/* alloc.c:364:OF */ extern object on_stack_cons (object x, object y); /* (x, y) object x; object y; */

/* alloc.c:480:OF */ extern void insert_contblock (char *p, int s); /* (p, s) char *p; int s; */

/* alloc.c:480:OF */ extern void insert_maybe_sgc_contblock (char *p, int s); /* (p, s) char *p; int s; */

@@ -1466,27 +1466,27 @@ fixnum elt_size(fixnum);

void init_gmp_rnd_state(__gmp_randstate_struct *);

-inline void set_sgc_bit(struct pageinfo *,void *);

+/* void set_sgc_bit(struct pageinfo *,void *); */

void reinit_gmp(void);

object mod(object,object);

-inline void intdivrem(object,object,fixnum,object *,object *);

+void intdivrem(object,object,fixnum,object *,object *);

-inline object integer_count(object);

+object integer_count(object);

-inline object integer_length(object);

+object integer_length(object);

-inline bool integer_bitp(object,object);

+bool integer_bitp(object,object);

-inline object fixnum_times(fixnum,fixnum);

+object fixnum_times(fixnum,fixnum);

-inline object log_op2(fixnum,object,object);

+object log_op2(fixnum,object,object);

-inline object fixnum_big_shift(fixnum,fixnum);

+object fixnum_big_shift(fixnum,fixnum);

-inline object integer_shift(object,object);

+object integer_shift(object,object);

object number_abs(object);

diff --git a/gcl/h/writable.h b/gcl/h/writable.h
index 42c68996b..0497e5b80 100644
--- a/gcl/h/writable.h
+++ b/gcl/h/writable.h

@@ -1,4 +1,4 @@

-EXTER inline int

+INLINE int

set_writable(fixnum i,fixnum m) {

fixnum j;

@@ -27,7 +27,7 @@ set_writable(fixnum i,fixnum m) {

}

-EXTER inline int

+INLINE int

is_writable(fixnum i) {

fixnum j;

diff --git a/gcl/lsp/gcl_dl.lsp b/gcl/lsp/gcl_dl.lsp
index 0c108cb69..068c84d09 100644
--- a/gcl/lsp/gcl_dl.lsp
+++ b/gcl/lsp/gcl_dl.lsp

@@ -4,7 +4,7 @@

(defun lib-name (p)

(if (or (string= p "") (string= p "libc") (string= p "libm")) ""

- (string-concatenate p ".so")))

+ (string-concatenate p ".dylib")));FIXME

(defun mdl (n p vad)

(let* ((sym (mdlsym n (lib-name p)))

@@ -17,7 +17,7 @@

(let* ((pk (or (find-package "LIB") (make-package "LIB")))

(k (if np (dlopen n) 0))

(ad (dlsym k str))

- (p (or (pathname-name (dladdr ad)) ""))

+ (p (or (pathname-name (dladdr ad)) ""));FIXME work around dladdr here, not posix

(psym (intern p pk))

(npk (or (find-package psym) (make-package psym :use '(:cl))))

(sym (and (shadow str npk) (intern str npk))))

diff --git a/gcl/lsp/gcl_mnum.lsp b/gcl/lsp/gcl_mnum.lsp
index 95b418c9f..a3a8dfb62 100644
--- a/gcl/lsp/gcl_mnum.lsp
+++ b/gcl/lsp/gcl_mnum.lsp

@@ -227,7 +227,7 @@

(if (minusp z) (- z) z))

-(defdlfun (:fixnum "__gmpz_cmp") :fixnum :fixnum)

-#.(let ((x (truncate fixnum-length char-length)))

- `(defun mpz_cmp (x y) (|libgmp|:|__gmpz_cmp| (+ ,x (address x)) (+ ,x (address y)))));FIXME

-(setf (get 'mpz_cmp 'compiler::cmp-inline) t)

+;; (defdlfun (:fixnum "__gmpz_cmp") :fixnum :fixnum)

+;; #.(let ((x (truncate fixnum-length char-length)))

+;; `(defun mpz_cmp (x y) (|libgmp|:|__gmpz_cmp| (+ ,x (address x)) (+ ,x (address y)))));FIXME

+;; (setf (get 'mpz_cmp 'compiler::cmp-inline) t)

diff --git a/gcl/o/alloc.c b/gcl/o/alloc.c
index f9a1f3b05..ae94b0e4f 100644
--- a/gcl/o/alloc.c
+++ b/gcl/o/alloc.c

@@ -72,7 +72,7 @@ struct rlimit data_rlimit;

#endif

#endif

-inline void

+static inline void

add_page_to_contblock_list(void *p,fixnum m) {

struct pageinfo *pp=pageinfo(p);

@@ -109,7 +109,10 @@ icomp(const void *v1,const void *v2) {

return *f1<*f2 ? -1 : *f1==*f2 ? 0 : +1;

}

-inline void

+void

+add_page_to_freelist(char *, struct typemanager *);

+

+static inline void

maybe_reallocate_page(struct typemanager *ntm,ufixnum count) {

void **y,**n;

@@ -180,7 +183,7 @@ int reserve_pages_for_signal_handler=30;

If not in_signal_handler then try to keep a minimum of

reserve_pages_for_signal_handler pages on hand in the hole

*/

-inline void *

+void *

alloc_page(long n) {

void *e=heap_end;

@@ -266,7 +269,7 @@ eg to add 20 more do (si::set-hole-size %ld %d)\n...start over ",

struct pageinfo *cell_list_head=NULL,*cell_list_tail=NULL;;

-inline fixnum

+fixnum

set_tm_maxpage(struct typemanager *tm,fixnum n) {

fixnum r=tm->tm_type==t_relocatable,j=tm->tm_maxpage,z=(n-j)*(r ? 2 : 1);

@@ -279,7 +282,7 @@ set_tm_maxpage(struct typemanager *tm,fixnum n) {

}

-inline void

+void

add_page_to_freelist(char *p, struct typemanager *tm) {

short t,size;

@@ -397,7 +400,7 @@ 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

-inline long

+long

opt_maxpage(struct typemanager *my_tm) {

double x=0.0,y=0.0,z,r;

@@ -471,7 +474,7 @@ Use ALLOCATE to expand the space.",

#endif

bool prefer_low_mem_contblock=FALSE;

-inline void *

+static inline void *

alloc_from_freelist(struct typemanager *tm,fixnum n) {

void *p,*v,*vp;

@@ -558,7 +561,7 @@ too_full_p(struct typemanager *tm) {

}

-inline void *

+static inline void *

alloc_after_gc(struct typemanager *tm,fixnum n) {

if (tm->tm_npage+tpage(tm,n)>=tm->tm_maxpage && GBC_enable) {

@@ -590,7 +593,7 @@ alloc_after_gc(struct typemanager *tm,fixnum n) {

struct pageinfo *contblock_list_head=NULL,*contblock_list_tail=NULL;

-inline void

+void

add_pages(struct typemanager *tm,fixnum m) {

switch (tm->tm_type) {

@@ -624,7 +627,7 @@ add_pages(struct typemanager *tm,fixnum m) {

}

-inline void *

+static inline void *

alloc_after_adding_pages(struct typemanager *tm,fixnum n) {

fixnum m=tpage(tm,n);

@@ -647,7 +650,7 @@ alloc_after_adding_pages(struct typemanager *tm,fixnum n) {

}

-inline void *

+static inline void *

alloc_after_reclaiming_pages(struct typemanager *tm,fixnum n) {

fixnum m=tpage(tm,n),reloc_min;

@@ -674,10 +677,10 @@ alloc_after_reclaiming_pages(struct typemanager *tm,fixnum n) {

}

-inline void *alloc_mem(struct typemanager *,fixnum);

+static inline void *alloc_mem(struct typemanager *,fixnum);

#ifdef SGC

-inline void *

+static inline void *

alloc_after_turning_off_sgc(struct typemanager *tm,fixnum n) {

if (!sgc_enabled) return NULL;

@@ -687,7 +690,7 @@ alloc_after_turning_off_sgc(struct typemanager *tm,fixnum n) {

}

#endif

-inline void *

+static inline void *

alloc_mem(struct typemanager *tm,fixnum n) {

void *p;

@@ -711,7 +714,7 @@ alloc_mem(struct typemanager *tm,fixnum n) {

return exhausted_report(tm->tm_type,tm);

}

-inline object

+object

alloc_object(enum type t) {

object obj;

@@ -726,12 +729,12 @@ alloc_object(enum type t) {

}

-inline void *

+void *

alloc_contblock(size_t n) {

return alloc_mem(tm_of(t_contiguous),ROUND_UP_PTR_CONT(n));

}

-inline void *

+void *

alloc_relblock(size_t n) {

return alloc_mem(tm_of(t_relocatable),ROUND_UP_PTR(n));

@@ -739,7 +742,7 @@ alloc_relblock(size_t n) {

}

-inline object

+object

make_cons(object a,object d) {

static struct typemanager *tm=tm_table+t_cons;/*FIXME*/

@@ -757,7 +760,7 @@ make_cons(object a,object d) {

-inline object on_stack_cons(object x, object y)

+object on_stack_cons(object x, object y)

{object p = (object) alloca_val;

/* set_type_of(p,t_cons); */

p->c.c_car=x;

diff --git a/gcl/o/boot.c b/gcl/o/boot.c
index c8429c13f..f9c6f44af 100644
--- a/gcl/o/boot.c
+++ b/gcl/o/boot.c

@@ -217,22 +217,24 @@ DEFUN("TAILP",object,fLtailp,LISP,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") {

RETURN1(eql(x,y) ? Ct : Cnil);

}

+static inline object

+subst(object tree,object new,object x,object key,object test,object test_not) {

+

+ if (TESTA(x,tree,key,test,test_not))

+ return new;

+ else if (consp(tree)) {

+ object a=subst(tree->c.c_car,new,x,key,test,test_not),d=subst(tree->c.c_cdr,new,x,key,test,test_not);

+ return a==tree->c.c_car && d==tree->c.c_cdr ? tree : MMcons(a,d);

+ } else

+ return tree;

+

+}

+

DEFUN("SUBST",object,fLsubst,LISP,3,63,NONE,OO,OO,OO,OO,(object new,object x,object y,...),"") {

fixnum n=INIT_NARGS(3);

object l=Cnil,f=OBJNULL,*base=vs_top,z,key,test,test_not;

va_list ap;

- object subst(object tree) {

-

- if (MTEST(tree))

- return new;

- else if (consp(tree)) {

- object a=subst(tree->c.c_car),d=subst(tree->c.c_cdr);

- return a==tree->c.c_car && d==tree->c.c_cdr ? tree : MMcons(a,d);

- } else

- return tree;

-

- }

va_start(ap,y);

for (;(z=NEXT_ARG(n,ap,l,f,OBJNULL))!=OBJNULL;)

@@ -242,7 +244,7 @@ DEFUN("SUBST",object,fLsubst,LISP,3,63,NONE,OO,OO,OO,OO,(object new,object x,obj

parse_key(base,FALSE,FALSE,3,sKtest,sKtest_not,sKkey);

key=base[2];test=base[0];test_not=base[1];vs_top=base;

- RETURN1(subst(y));

+ RETURN1(subst(y,new,x,key,test,test_not));

}

@@ -488,14 +490,12 @@ DEFUN("MAKE-LIST",object,fSmake_list,LISP,1,63,NONE,OI,OO,OO,OO,(fixnum x,...),"

}

+static inline object

+copy_tree(object x) {

+ return consp(x) ? MMcons(copy_tree(x->c.c_car),copy_tree(x->c.c_cdr)) : x;

+}

+

DEFUN("COPY-TREE",object,fScopy_tree,LISP,1,2,NONE,OO,OO,OO,OO,(object x),"") {

- object copy_tree(object x) {

- if (consp(x)) {

- object a=copy_tree(x->c.c_car),d=copy_tree(x->c.c_cdr);

- return a==x->c.c_car && d==x->c.c_cdr ? x : MMcons(a,d);

- } else

- return x;

- }

RETURN1(copy_tree(x));

}

@@ -589,26 +589,24 @@ DEFUN("NINTH",object,fLninth,LISP,1,1,NONE,OO,OO,OO,OO,(object x),"")

DEFUN("TENTH",object,fLtenth,LISP,1,1,NONE,OO,OO,OO,OO,(object x),"")

{ return FFN(fLnth)(make_fixnum(9),x);}

+static inline object

+sublis(object alist,object tree,object key,object test,object test_not) {

+ object z;

-DEFKTFUN("SUBLIS",fLsublis,LISP,({\

- object sublis(object tree) {

-

- object z;

-

- for (z = x; !endp(z); z = z->c.c_cdr) {

- object w=z->c.c_car;

- if (TESTA(w->c.c_car,tree,key,test,test_not))

- return w->c.c_cdr;

- }

- if (consp(tree)) {

- object a=sublis(tree->c.c_car),d=sublis(tree->c.c_cdr);

- return a==tree->c.c_car && d==tree->c.c_cdr ? tree : MMcons(a,d);

- } else

- return tree;

-

-

+ for (z = alist; !endp(z); z = z->c.c_cdr) {

+ object w=z->c.c_car;

+ if (TESTA(w->c.c_car,tree,key,test,test_not))

+ return w->c.c_cdr;

}

- sublis(y);}))

+ if (consp(tree)) {

+ object a=sublis(alist,tree->c.c_car,key,test,test_not),d=sublis(alist,tree->c.c_cdr,key,test,test_not);

+ return a==tree->c.c_car && d==tree->c.c_cdr ? tree : MMcons(a,d);

+ } else

+ return tree;

+

+}

+

+DEFKTFUN("SUBLIS",fLsublis,LISP,sublis(x,y,key,test,test_not))

DEFUN("WILD-PATHNAME-P",object,fLwild_pathname_p,LISP,1,2,NONE,OO,OO,OO,OO,(object x,...),"") {

return Cnil;

diff --git a/gcl/o/cfun.c b/gcl/o/cfun.c
index ed6443030..873348c72 100644
--- a/gcl/o/cfun.c
+++ b/gcl/o/cfun.c

@@ -117,7 +117,7 @@ DEFUN("DLADDR",object,fSdladdr,SI,1,1,NONE,OI,OO,OO,OO,(fixnum ad),"") {

DEFUN("DLOPEN",object,fSdlopen,SI,1,1,NONE,OO,OO,OO,OO,(object name),"") {

- char ch;

+ char ch,*err;

void *v;

dlerror();

@@ -125,8 +125,8 @@ DEFUN("DLOPEN",object,fSdlopen,SI,1,1,NONE,OO,OO,OO,OO,(object name),"") {

name->st.st_self[name->st.st_fillp]=0;

v=dlopen(name->st.st_fillp ? name->st.st_self : 0,RTLD_LAZY|RTLD_GLOBAL);

name->st.st_self[name->st.st_fillp]=ch;

- if (dlerror())

- FEerror("dlopen faiure on ~s",1,name);

+ if ((err=dlerror()))

+ FEerror("dlopen failure on ~s: ~s",2,name,make_simple_string(err));

RETURN1(make_fixnum((fixnum)v));

diff --git a/gcl/o/eval.c b/gcl/o/eval.c
index 7e59019f9..c57200ee7 100644
--- a/gcl/o/eval.c
+++ b/gcl/o/eval.c

@@ -166,7 +166,7 @@ funcall_ap(object fun,fixnum n,va_list ap) {

object *b,*t;

ufixnum i,j;

- j=i=abs(n);

+ j=i=labs(n);

t=b=ZALLOCA(j*sizeof(*b));

for (;j--;)

*t++=va_arg(ap,object);

@@ -965,7 +965,7 @@ DEFUNM("EVAL-SRC",object,fSeval_src,SI,0,63,NONE,OO,OO,OO,OO,(object first,...),

va_list ap;

f=fun->fun.fun_plist->c.c_cdr->c.c_cdr->c.c_car;

- j=abs(narg)+((narg < 0) ? 0 : 1);

+ j=labs(narg)+((narg < 0) ? 0 : 1);

va_start(ap,first);

vs_base=vs_top;

for (i=1;j--;) {

diff --git a/gcl/o/funlink.c b/gcl/o/funlink.c
index c4c0bedd5..eea5cb229 100644
--- a/gcl/o/funlink.c
+++ b/gcl/o/funlink.c

@@ -406,7 +406,7 @@ call_proc_new(object sym,ufixnum clp,ufixnum vld,void **link,ufixnum argd,object

res=vs_base[0];

if (larg) {

- object *tmp=vs_base+1,*tl=(void *)larg,*tle=tl+abs(vald);/*FIXME avoid if pushed*/

+ object *tmp=vs_base+1,*tl=(void *)larg,*tle=tl+labs(vald);/*FIXME avoid if pushed*/

for (;tl<tle && tmp<vs_top;)

*tl++=*tmp++;

if (vald<0)

diff --git a/gcl/o/gbc.c b/gcl/o/gbc.c
index 70dd4e6c4..21b9397ff 100644
--- a/gcl/o/gbc.c
+++ b/gcl/o/gbc.c

@@ -107,14 +107,14 @@ off_check(void *v,void *ve,fixnum i,struct pageinfo *pi) {

#endif

-inline struct pageinfo *

+static inline struct pageinfo *

get_pageinfo(void *x) {

struct pageinfo *v=contblock_list_head;void *vv;

for (;(vv=v) && (vv>=x || vv+v->in_use*PAGESIZE<=x);v=v->next);

return v;

}

-inline char

+static inline char

get_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);

@@ -124,7 +124,7 @@ get_bit(char *v,struct pageinfo *pi,void *x) {

return (v[i]>>s)&0x1;

}

-inline void

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

@@ -139,7 +139,7 @@ set_bit(char *v,struct pageinfo *pi,void *x) {

#define ptr_get(v,i,s) (v+(((i<<LOG_BITS_CHAR)|s)<<LOG_BYTES_CONTBLOCK))

#define ptr_set(x,v,i,s) ({fixnum _o=(x-v)>>LOG_BYTES_CONTBLOCK;i=_o>>LOG_BITS_CHAR;s=_o&~(~0UL<<LOG_BITS_CHAR);})

-inline void

+static inline void

set_bits(char *v,struct pageinfo *pi,void *x1,void *x2) {

void *ds=CB_DATA_START(pi);

@@ -162,7 +162,7 @@ set_bits(char *v,struct pageinfo *pi,void *x1,void *x2) {

}

-inline void *

+static inline void *

get_bits(char *v,struct pageinfo *pi,void *x) {

void *ds=CB_DATA_START(pi),*de=CB_DATA_END(pi);

@@ -188,32 +188,32 @@ get_bits(char *v,struct pageinfo *pi,void *x) {

return ds<de ? ds : de;

}

-inline char

+static inline char

get_mark_bit(struct pageinfo *pi,void *x) {

return get_bit(CB_MARK_START(pi),pi,x);

}

-inline void

+static inline void

set_mark_bit(struct pageinfo *pi,void *x) {

set_bit(CB_MARK_START(pi),pi,x);

}

-inline void *

+static inline void *

get_mark_bits(struct pageinfo *pi,void *x) {

return get_bits(CB_MARK_START(pi),pi,x);

}

-inline void

+static inline void

set_mark_bits(struct pageinfo *pi,void *x1,void *x2) {

set_bits(CB_MARK_START(pi),pi,x1,x2);

}

-inline char

+static inline char

get_sgc_bit(struct pageinfo *pi,void *x) {

return get_bit(CB_SGCF_START(pi),pi,x);

}

-inline void

+static inline void

set_sgc_bit(struct pageinfo *pi,void *x) {

set_bit(CB_SGCF_START(pi),pi,x);

}

@@ -250,12 +250,12 @@ mark_object(object);

These assume that DBEGIN is divisible by 32, or else we should have

#define Shamt(x) (((((int) x -DBEGIN) >> 2) & ~(~0 << 5)))

*/

-inline void *

+static inline void *

get_sgc_bits(struct pageinfo *pi,void *x) {

return get_bits(CB_SGCF_START(pi),pi,x);

}

-inline void

+static inline void

set_sgc_bits(struct pageinfo *pi,void *x1,void *x2) {

set_bits(CB_SGCF_START(pi),pi,x1,x2);

}

@@ -337,7 +337,7 @@ enter_mark_origin(object *p) {

static void *mcsh,*mcsl;

-inline void

+static inline void

mark_cons(object x) {

do {

@@ -1515,7 +1515,7 @@ GBC(enum type t) {

}

- ZALLOCA(abs(mcsl-mcsh));

+ ZALLOCA(labs(mcsl-mcsh));

collect_both=0;

@@ -1542,10 +1542,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));

diff --git a/gcl/o/gmp_num_log.c b/gcl/o/gmp_num_log.c
index bb21234fe..e75d4cb97 100644
--- a/gcl/o/gmp_num_log.c
+++ b/gcl/o/gmp_num_log.c

@@ -46,7 +46,7 @@ integer_log_op2(fixnum op,object x,enum type tx,object y,enum type ty) {

}

-inline object

+object

log_op2(fixnum op,object x,object y) {

enum type tx=type_of(x),ty=type_of(y);

diff --git a/gcl/o/hash.d b/gcl/o/hash.d
index 4549de0cb..c1ced4989 100644
--- a/gcl/o/hash.d
+++ b/gcl/o/hash.d

@@ -176,7 +176,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[labs(depth%(sizeof(rtb)/sizeof(*rtb)))];

x = x->c.c_cdr;

goto BEGIN;

break;

diff --git a/gcl/o/main.c b/gcl/o/main.c
index 41391148a..48fce2df4 100644
--- a/gcl/o/main.c
+++ b/gcl/o/main.c

@@ -40,6 +40,8 @@ int ovm_process_created;

void initialize_process();

#endif

+#define INLINE

+

#include "include.h"

#include <signal.h>

#include "page.h"

@@ -131,7 +133,7 @@ clear_c_stack(VOL unsigned n) {

fixnum log_maxpage_bound=sizeof(fixnum)*8-1;

-inline int

+static inline int

mbrk(void *v) {

ufixnum uv=(ufixnum)v,uc=(ufixnum)sbrk(0),ux,um;

fixnum m=((1UL<<(sizeof(fixnum)*8-1))-1);

@@ -244,6 +246,8 @@ minimize_image(void) {

}

+#include <dlfcn.h>

+

void

init_boot(void) {

@@ -340,7 +344,7 @@ main(int argc, char **argv, char **envp) {

}

initlisp();

- lex_new();

+ ihs_top++;lex_new();/*FIXME*/

GBC_enable = TRUE;

diff --git a/gcl/o/makefile b/gcl/o/makefile
index d53481dd6..5bed27e33 100644
--- a/gcl/o/makefile
+++ b/gcl/o/makefile

@@ -48,7 +48,7 @@ boot.o: boot.c $(DECL) boot.h

boot.ini: boot.c grab_defs

$(CC) -DINICOMP -DNO_DEFUN -DNO_BOOT_H $(CFLAGS) $(DEFS) -E $*.c |\

- sed -e 's,DEFUN,\nDEFUN,g' -e 's,^.* DEFUNB,DEFUNB,g' -e 's/DEF,//g' -e 's:\"[ ]*):\"):g' | ./grab_defs > $@

+ sed -e 's,DEFUN,\'$$'\nDEFUN,g' -e 's,^.* DEFUNB,DEFUNB,g' -e 's/DEF,//g' -e 's:\"[ ]*):\"):g' | ./grab_defs > $@

boot.h: boot.ini

echo '#include "make-init.h"' > $@

diff --git a/gcl/o/num_sfun.c b/gcl/o/num_sfun.c
index 6de4b7183..91c1142cb 100644
--- a/gcl/o/num_sfun.c
+++ b/gcl/o/num_sfun.c

@@ -108,7 +108,7 @@ number_exp(object x)

}

}

-inline object

+static inline object

number_fix_iexpt(object x,fixnum y,fixnum ly,fixnum j) {

object z;

@@ -117,7 +117,7 @@ number_fix_iexpt(object x,fixnum y,fixnum ly,fixnum j) {

return fixnum_bitp(j,y) ? number_times(x,z) : z;

}

-inline object

+static inline object

number_big_iexpt(object x,object y,fixnum ly,fixnum j) {

object z;

@@ -127,7 +127,7 @@ number_big_iexpt(object x,object y,fixnum ly,fixnum j) {

}

-inline object

+static inline object

number_zero_expt(object x,bool promote_short_p) {

switch (type_of(x)) {

@@ -149,7 +149,7 @@ number_zero_expt(object x,bool promote_short_p) {

}

-inline object

+static inline object

number_ui_expt(object x,fixnum fy) {

switch (type_of(x)) {

@@ -182,17 +182,17 @@ number_ui_expt(object x,fixnum fy) {

}

-inline object

+static inline object

number_ump_expt(object x,object y) {

return number_big_iexpt(x,y,fix(integer_length(y)),0);

}

-inline object

+static inline object

number_log_expt(object x,object y) {

return number_zerop(y) ? number_zero_expt(y,type_of(x)==t_longfloat) : number_exp(number_times(number_nlog(x),y));

}

-inline object

+static inline object

number_invert(object x,object y,object z) {

switch (type_of(z)) {

@@ -207,7 +207,7 @@ number_invert(object x,object y,object z) {

}

-inline object

+static inline object

number_si_expt(object x,object y) {

switch (type_of(y)) {

case t_fixnum:

diff --git a/gcl/o/pathname.d b/gcl/o/pathname.d
index 67b522dce..3bd7ac7a8 100644
--- a/gcl/o/pathname.d
+++ b/gcl/o/pathname.d

@@ -563,19 +563,19 @@ object host, device, directory, name, type, version, casekey;

*/

static int

-parse_namestring_check(s,start,end,c,restrict)

+parse_namestring_check(s,start,end,c,restr)

object s;

int start, end;

char c;

-int restrict;

+int restr;

{

int i;

for (i=start; (s->st.st_self[i]!=c) && (i<end); i++) {

- if ((restrict==':') &&

+ if ((restr==':') &&

!( isalnum(s->st.st_self[i]) || (s->st.st_self[i]=='-') || (s->st.st_self[i]=='.') ))

return -2;

#ifdef ANSI

- if ((restrict==';') && pathname_resolve(pathKansi) &&

+ if ((restr==';') && pathname_resolve(pathKansi) &&

!( isalnum(s->st.st_self[i]) || (s->st.st_self[i]=='-') ||

(s->st.st_self[i]=='*') || (s->st.st_self[i]=='?') ))

return -2;

@@ -1680,7 +1680,7 @@ LFD(Lhost_namestring)(void)

equalp(path->pn.pn_type, defaults->pn.pn_type) ?

Cnil : path->pn.pn_type,

equalp(path->pn.pn_version, defaults->pn.pn_version) ?

- Cnil : path->pn.pn_version);

+ Cnil : path->pn.pn_version,sKcommon);

} else

path = make_pathname(

equalp(path->pn.pn_host, defaults->pn.pn_host) ?

@@ -1694,7 +1694,7 @@ LFD(Lhost_namestring)(void)

equalp(path->pn.pn_type, defaults->pn.pn_type) ?

Cnil : path->pn.pn_type,

equalp(path->pn.pn_version, defaults->pn.pn_version) ?

- Cnil : path->pn.pn_version);

+ Cnil : path->pn.pn_version,sKcommon);

@(return `namestring(path)`)

@)

diff --git a/gcl/o/prelink.c b/gcl/o/prelink.c
new file mode 100644
index 000000000..9ce197d7a
--- /dev/null
+++ b/gcl/o/prelink.c

@@ -0,0 +1,31 @@

+#define NO_PRELINK_UNEXEC_DIVERSION

+

+#include "include.h"

+

+#if !defined(__MINGW32__) && !defined(__CYGWIN__)

+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

+#endif

+

+void

+prelink_init(void) {

+

+ my_stdin=stdin;

+ my_stdout=stdout;

+ my_stderr=stderr;

+#ifdef HAVE_READLINE

+ my_rl_completion_entry_function_ptr=(void *)&rl_completion_entry_function;

+ my_rl_readline_name_ptr=(void *)&rl_readline_name;

+#endif

+

+}

+

diff --git a/gcl/o/read.d b/gcl/o/read.d
index 6d07cfdfb..5b5b8aa31 100644
--- a/gcl/o/read.d
+++ b/gcl/o/read.d

@@ -1098,7 +1098,7 @@ DEFUN("SHARP-\\-READER",object,fSsharp_sl_reader,SI,3,3,NONE,OO,OO,OO,OO,(object

if (type_of(y)!=t_fixnum || fix(y) != 0)

FEerror("~S is an illegal CHAR-FONT.", 1, y);

/* assuming that CHAR-FONT-LIMIT is 1 */

- unread_char(character_table+'\\', s);

+ unread_char(((object)(character_table+'\\')), s);

if (READsuppress) {

(void)read_object(s);

RETURN1(Cnil);

diff --git a/gcl/o/sfaslmacho.c b/gcl/o/sfaslmacho.c
index 84181447a..19e157277 100644
--- a/gcl/o/sfaslmacho.c
+++ b/gcl/o/sfaslmacho.c

@@ -205,6 +205,7 @@ load_memory(struct section *sec1,struct section *sece,void *v1,

memory->cfd.cfd_size=sz;

memory->cfd.cfd_self=0;

memory->cfd.cfd_start=0;

+ memory->cfd.cfd_dlist=Cnil;

prefer_low_mem_contblock=TRUE;

memory->cfd.cfd_start=alloc_contblock(sz);

prefer_low_mem_contblock=FALSE;

diff --git a/gcl/o/symbol.d b/gcl/o/symbol.d
index 8a7fed8c5..f93584693 100644
--- a/gcl/o/symbol.d
+++ b/gcl/o/symbol.d

@@ -57,7 +57,7 @@ object st;

x->s.s_stype = (short)stp_ordinary;

x->s.s_mflag = FALSE;

vs_push(x);

- if (raw_image && st->st.st_self < heap_end)

+ if (0)/* (raw_image && st->st.st_self < heap_end) */

x->s.s_self = st->st.st_self;

else {

x->s.s_self = alloc_relblock(x->s.s_fillp);

diff --git a/gcl/o/unixtime.c b/gcl/o/unixtime.c
index dba00d2c5..1e72b9a03 100644
--- a/gcl/o/unixtime.c
+++ b/gcl/o/unixtime.c

@@ -172,7 +172,7 @@ DEFUNM("GET-INTERNAL-RUN-TIMES",object,fSget_internal_run_times,SI,0,0,NONE,OO,O

DEFUN("GET-INTERNAL-RUN-TIME",object,fLget_internal_run_time,LISP

,0,0,NONE,OO,OO,OO,OO,(void),"") {

- object x=FFN(fSget_internal_run_times)(0);

+ object x=FFN(fSget_internal_run_times)();

RETURN1(x);

}