From 45ab6f72fe114bb41182fb8417126f43f611d976 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Tue, 7 Oct 2008 23:59:57 +0200 Subject: [PATCH 01/60] New signal handlers which delay signals until an interruptible safe point is reached. --- src/c/alloc_2.d | 1 + src/c/file.d | 11 ++ src/c/interpreter.d | 2 +- src/c/main.d | 22 +++- src/c/stacks.d | 35 ++++-- src/c/threads.d | 8 +- src/c/unixint.d | 286 +++++++++++++++++++++++++++++++------------- src/h/external.h | 25 ++-- src/h/internal.h | 9 +- 9 files changed, 287 insertions(+), 112 deletions(-) diff --git a/src/c/alloc_2.d b/src/c/alloc_2.d index da4375bd3..c00147dfa 100644 --- a/src/c/alloc_2.d +++ b/src/c/alloc_2.d @@ -206,6 +206,7 @@ init_alloc(void) GC_time_limit = GC_TIME_UNLIMITED; GC_init(); if (ecl_get_option(ECL_OPT_INCREMENTAL_GC)) { + printf("Enable incremental\n"); GC_enable_incremental(); } GC_register_displacement(1); diff --git a/src/c/file.d b/src/c/file.d index 8d6ed2f7d..648eebee9 100644 --- a/src/c/file.d +++ b/src/c/file.d @@ -376,6 +376,8 @@ not_a_character_stream(cl_object s) static void io_error(cl_object strm) { + FILE *f = strm->stream.file; + if (f) clearerr(f); FElibc_error("Read or write operation to stream ~S signaled an error.", 1, strm); } @@ -1144,12 +1146,21 @@ BEGIN: case smm_io: io_stream_begin_read(strm); case smm_input: { + cl_env_ptr the_env = &cl_env; FILE *fp = (FILE*)strm->stream.file; if (!strm->stream.char_stream_p) not_a_character_stream(strm); if (fp == NULL) wrong_file_handler(strm); + if (cl_env.disable_interrupts) printf("Cannot disable interrupts twice.\n"); + ECL_DISABLE_INTERRUPTS(the_env); c = getc(fp); + if (the_env->interrupt_pending) { + printf("Clearing file errors\n"); + clearerr(fp); + } + ECL_ENABLE_INTERRUPTS(the_env); + if (cl_env.disable_interrupts) printf("Interrupts are not reenabled.\n"); if (c == EOF && ferror(fp)) io_error(strm); break; diff --git a/src/c/interpreter.d b/src/c/interpreter.d index f1bda688a..4ed632ffb 100644 --- a/src/c/interpreter.d +++ b/src/c/interpreter.d @@ -512,7 +512,7 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs struct ecl_stack_frame frame_aux; volatile struct ihs_frame ihs; - ecl_cs_check(ihs); + /*ecl_cs_check(ihs);*/ if (type_of(bytecodes) != t_bytecodes) FEinvalid_function(bytecodes); diff --git a/src/c/main.d b/src/c/main.d index 0c4968b35..625d83d1a 100644 --- a/src/c/main.d +++ b/src/c/main.d @@ -32,6 +32,9 @@ # include # endif #endif +#ifdef HAVE_MMAP +# include +#endif #include #include #include @@ -40,9 +43,9 @@ extern int GC_dont_gc; /******************************* EXPORTS ******************************/ #if !defined(ECL_THREADS) -struct cl_env_struct cl_env; +cl_env_ptr cl_env_p; #elif defined(WITH___THREAD) -__thread struct cl_env_struct * cl_env_p; +__thread cl_env_ptr cl_env_p; #endif struct cl_core_struct cl_core; const char *ecl_self; @@ -105,7 +108,7 @@ ecl_set_option(int option, cl_fixnum value) } void -ecl_init_env(struct cl_env_struct *env) +ecl_init_env(cl_env_ptr env) { int i; @@ -225,6 +228,9 @@ cl_boot(int argc, char **argv) cl_object aux; cl_object features; int i; +#if defined(ECL_THREADS) && !defined(WITH__THREAD) + static cl_env_ptr cl_env_p; +#endif i = ecl_get_option(ECL_OPT_BOOTED); if (i) { @@ -247,8 +253,16 @@ cl_boot(int argc, char **argv) init_unixint(0); init_alloc(); GC_disable(); +#if !defined(HAVE_MMAP) + cl_env_p = cl_alloc(sizeof(*cl_env_p)); +#else + cl_env_p = mmap(0, sizeof(*cl_env_p), PROT_READ | PROT_WRITE, + MAP_ANON | MAP_PRIVATE, 0, 0); + if (cl_env_p < 0) + ecl_internal_error("Unable to allocate environment structure."); +#endif #ifdef ECL_THREADS - init_threads(); + init_threads(cl_env_p); #endif #if !defined(MSDOS) && !defined(cygwin) diff --git a/src/c/stacks.d b/src/c/stacks.d index 1bcfcbe06..d17900d38 100644 --- a/src/c/stacks.d +++ b/src/c/stacks.d @@ -32,11 +32,17 @@ cs_set_size(cl_index new_size) cl_index safety_area = ecl_get_option(ECL_OPT_C_STACK_SAFETY_AREA); new_size += 2*safety_area; #ifdef ECL_DOWN_STACK - if (&foo > cl_env.cs_org - new_size + 16) + if (&foo > cl_env.cs_org - new_size + 16) { cl_env.cs_limit = cl_env.cs_org - new_size + 2*safety_area; + if (cl_env.cs_limit < cl_env.cs_barrier) + cl_env.cs_barrier = cl_env.cs_limit; + } #else - if (&foo < cl_env.cs_org + new_size - 16) + if (&foo < cl_env.cs_org + new_size - 16) { cl_env.cs_limit = cl_env.cs_org + new_size - 2*safety_area; + if (cl_env.cs_limit > cl_env.cs_barrier) + cl_env.cs_barrier = cl_env.cs_limit; + } #endif else ecl_internal_error("can't reset cl_env.cs_limit."); @@ -500,16 +506,22 @@ init_stacks(struct cl_env_struct *env, int *new_cs_org) ihs_org.index = 0; env->cs_org = new_cs_org; + env->cs_barrier = new_cs_org; #if defined(HAVE_SYS_RESOURCE_H) && defined(RLIMIT_STACK) { - struct rlimit rl; - cl_index size; - getrlimit(RLIMIT_STACK, &rl); - if (rl.rlim_cur != RLIM_INFINITY) { - size = rl.rlim_cur / sizeof(cl_fixnum) / 2; - if (size > ecl_get_option(ECL_OPT_C_STACK_SIZE)) - ecl_set_option(ECL_OPT_C_STACK_SIZE, size); - } + struct rlimit rl; + cl_index size; + getrlimit(RLIMIT_STACK, &rl); + if (rl.rlim_cur != RLIM_INFINITY) { + size = rl.rlim_cur / sizeof(cl_fixnum) / 2; + if (size > ecl_get_option(ECL_OPT_C_STACK_SIZE)) + ecl_set_option(ECL_OPT_C_STACK_SIZE, size); +#ifdef ECL_DOWN_STACK + env->cs_barrier = env->cs_org - rl.rlim_cur - 1024; +#else + env->cs_barrier = env->cs_org + rl.rlim_cur + 1024; +#endif + } } #endif cs_set_size(ecl_get_option(ECL_OPT_C_STACK_SIZE)); @@ -531,4 +543,7 @@ init_stacks(struct cl_env_struct *env, int *new_cs_org) sigaltstack(&new_stack, NULL); } #endif +#ifdef SA_SIGINFO + env->interrupt_info = cl_alloc_atomic(sizeof(siginfo_t)); +#endif } diff --git a/src/c/threads.d b/src/c/threads.d index c5e204393..0a4871342 100644 --- a/src/c/threads.d +++ b/src/c/threads.d @@ -30,6 +30,9 @@ #ifdef HAVE_SCHED_YIELD # include #endif +#ifdef HAVE_MMAP +# include +#endif #ifndef WITH___THREAD static pthread_key_t cl_env_key; @@ -489,10 +492,9 @@ mp_condition_variable_broadcast(cl_object cv) */ void -init_threads() +init_threads(cl_env_ptr env) { cl_object process; - struct cl_env_struct *env; pthread_mutexattr_t attr; cl_core.processes = OBJNULL; @@ -507,7 +509,7 @@ init_threads() process->process.function = Cnil; process->process.args = Cnil; process->process.thread = pthread_self(); - process->process.env = env = cl_alloc(sizeof(*env)); + process->process.env = env; #ifdef WITH___THREAD cl_env_p = env; diff --git a/src/c/unixint.d b/src/c/unixint.d index 9baabed24..478b22230 100644 --- a/src/c/unixint.d +++ b/src/c/unixint.d @@ -15,6 +15,8 @@ See file '../Copyright' for full details. */ +#include +#include #include #if defined(HAVE_FENV_H) && !defined(ECL_AVOID_FENV_H) # define _GNU_SOURCE @@ -36,6 +38,12 @@ # endif #endif #include +#ifdef HAVE_MMAP +# ifndef SA_SIGINFO +# error "We cannot use the mmap code without siginfo" +# endif +# include +#endif #if defined(mingw32) || defined(_MSC_VER) # include void handle_fpe_signal(int,int); @@ -150,9 +158,10 @@ static struct { /******************************* ------- ******************************/ -bool ecl_interrupt_enable; - #ifdef HAVE_SIGPROCMASK +#define define_handler(name, sig, info, aux) name(sig, info, aux) +#define call_handler(name, sig, info, aux) name(sig, info, aux) +#define reinstall_signal(x,y) static void mysignal(int code, void *handler) { @@ -172,20 +181,39 @@ mysignal(int code, void *handler) sigaction(code, &new_action, &old_action); } #else +#define define_handler(name, sig, info, aux) name(sig) +#define call_handler(name, sig, info, aux) name(sig) #define mysignal(x,y) signal(x,y) +#define reinstall_signal(x,y) signal(x,y) #endif -static void -#ifdef SA_SIGINFO -handle_signal(int sig, siginfo_t *info, void *aux) -#else -handle_signal(int sig) -#endif +static bool +interrupts_disabled(cl_env_ptr the_env) { + return the_env->disable_interrupts || + (ecl_get_option(ECL_OPT_BOOTED) && + ecl_symbol_value(@'si::*interrupt-enable*') == Cnil); +} + +static void +jump_to_sigsegv_handler(cl_env_ptr the_env) +{ + ecl_frame_ptr destination = frs_sch(OBJNULL); + if (destination) { + the_env->nvalues = 0; + ecl_unwind(destination); + } + ecl_internal_error("SIGSEGV without handler to jump to."); +} + +static void +define_handler(lisp_signal_handler, int sig, siginfo_t *info, void *aux) +{ + cl_env_ptr the_env = &cl_env; switch (sig) { #if defined(ECL_THREADS) && !defined(_MSC_VER) && !defined(mingw32) case SIGUSR1: - funcall(1, cl_env.own_process->process.interrupt); + funcall(1, the_env->own_process->process.interrupt); break; #endif case SIGINT: @@ -220,81 +248,170 @@ handle_signal(int sig) cl_error(1, condition); break; } - case SIGSEGV: -#ifdef SA_SIGINFO - if (sbrk(0) < info->si_addr) { - GC_disable(); - cl_error(3, @'ext::stack-overflow', @':type', @'ext::c-stack'); + case SIGSEGV: { + ecl_frame_ptr destination = frs_sch(OBJNULL); + if (destination) { + the_env->nvalues = 0; + ecl_unwind(destination); } -#endif - cl_error(1, @'ext::segmentation-violation'); - break; + ecl_internal_error("SIGSEGV without handler to jump to."); + } + case SIGBUS: { + ecl_frame_ptr destination = frs_sch(OBJNULL); + if (destination) { + the_env->nvalues = 0; + ecl_unwind(destination); + } + ecl_internal_error("SIGSEGV without handler to jump to."); + } default: FEerror("Serious signal ~D caught.", 1, MAKE_FIXNUM(sig)); } } -/* - * TODO: Use POSIX signals, and in particular use sigaltstack to - * handle stack overflows gracefully. - */ -static void -#ifdef SA_SIGINFO -signal_catcher(int sig, siginfo_t *siginfo, void *data) -#else -signal_catcher(int sig) -#endif -{ -#ifdef GBC_BOEHM - int old_GC_enabled = GC_enabled(); -#endif - if (!ecl_interrupt_enable || - (ecl_get_option(ECL_OPT_BOOTED) && - ecl_symbol_value(@'si::*interrupt-enable*') == Cnil)) { - mysignal(sig, signal_catcher); - cl_env.interrupt_pending = sig; - return; - } - mysignal(sig, signal_catcher); #ifdef HAVE_SIGPROCMASK - CL_UNWIND_PROTECT_BEGIN { -#ifdef SA_SIGINFO - handle_signal(sig, siginfo, data); +static void +unblock_signal(int signal) +{ + struct sigaction oact; + sigset_t block_mask; + sigaction(signal, NULL, &oact); + block_mask = oact.sa_mask; + sigaddset(&block_mask, signal); +# ifdef ECL_THREADS + pthread_sigmask(SIG_UNBLOCK, &block_mask, NULL); +# else + sigprocmask(SIG_UNBLOCK, &block_mask, NULL); +# endif +} #else - handle_signal(sig); +#define unblock_signal(sig) #endif - } CL_UNWIND_PROTECT_EXIT { - sigset_t block_mask; - sigemptyset(&block_mask); - sigaddset(&block_mask, sig); -#ifdef ECL_THREADS - pthread_sigmask(SIG_UNBLOCK, &block_mask, NULL); -#else - sigprocmask(SIG_UNBLOCK, &block_mask, NULL); -#endif - if (old_GC_enabled) GC_enable() else GC_disable(); - } CL_UNWIND_PROTECT_END; -#else + +static void +define_handler(handle_signal_now, int sig, siginfo_t *info, void *aux) +{ #if defined (_MSC_VER) if (sig == SIGFPE) { handle_fpe_signal(sig, _fpecode); } #endif - handle_signal(sig); + unblock_signal(sig); + call_handler(lisp_signal_handler, sig, info, aux); +} + +static void define_handler(sigsegv_handler, int sig, siginfo_t *info, void *aux); + +static void +define_handler(non_evil_signal_handler, int sig, siginfo_t *siginfo, void *data) +{ + int old_errno = errno; + cl_env_ptr the_env = &cl_env; + reinstall_signal(sig, non_evil_signal_handler); + printf("Non evil handler\n"); + /* + * If interrupts are disabled, and we have not pushed a pending + * signal, save this signal and return. On platforms in which + * mprotect() works, we block all write access to the environment + * for a cheap check of pending interrupts. + */ + if (interrupts_disabled(the_env)) { + if (!the_env->interrupt_pending) { + struct sigaction oact; + the_env->interrupt_pending = sig; + memcpy(the_env->interrupt_info, siginfo, sizeof(siginfo)); + printf("Postponing signal %d\n", sig); + sigaction(SIGSEGV, NULL, &oact); + printf("SIGSEGV Handler: %x\n", oact.sa_sigaction); + sigaction(SIGBUS, NULL, &oact); + printf("SIGBUS Handler: %x\n", oact.sa_sigaction); + printf("sigsegv_handler: %x\n", sigsegv_handler); +#ifdef HAVE_MMAP + printf("Protecting %x\n", the_env); + if (mprotect(the_env, sizeof(*the_env), PROT_READ) < 0) + ecl_internal_error("Unable to mprotect environment."); #endif + } + errno = old_errno; + return; + } + /* + * If interrupts are enabled, that means we are in a safe area + * and may execute arbitrary lisp code. We can thus call the + * appropriate handlers. + */ + errno = old_errno; + call_handler(handle_signal_now, sig, siginfo, data); +} + +static void +define_handler(sigsegv_handler, int sig, siginfo_t *info, void *aux) +{ + cl_env_ptr the_env = &cl_env; +#ifdef HAVE_SIGPROCMASK +# ifdef ECL_DOWN_STACK + if ((cl_fixnum*)info->si_addr > the_env->cs_barrier && + (cl_fixnum*)info->si_addr <= the_env->cs_org) { + jump_to_sigsegv_handler(the_env); + } +# else + if ((cl_fixnum*)info->si_addr < the_env->cs_barrier && + (cl_fixnum*)info->si_addr >= the_env->cs_org) { + jump_to_sigsegv_handler(the_env); + } +# endif + if (interrupts_disabled(the_env)) { + the_env->interrupt_pending = sig; + memcpy(the_env->interrupt_info, info, sizeof(*info)); +# ifdef HAVE_MMAP + printf("Protecting %p\n", the_env); + if (mprotect(the_env, sizeof(*the_env), PROT_READ) < 0) + ecl_internal_error("Unable to mprotect environment."); +# endif + } else { + handle_signal_now(sig, info, aux); + } +#else + reinstall_signal_handler(sig, sigsegv_signal_handler); + /* + * We cannot distinguish between a stack overflow and a simple + * access violation. Thus we assume the worst case and jump to + * the outermost handler. + */ + jump_to_sigsegv_handler(&cl_env); +#endif +} + +static void +define_handler(sigbus_handler, int sig, siginfo_t *info, void *aux) +{ + cl_env_ptr the_env = &cl_env; + printf("Entering sigbus_handler for address %0p\n", info->si_addr); +#if defined(SA_SIGINFO) && defined(HAVE_MMAP) + /* We access the environment when it was protected. That + * means there was a pending signal. */ + if (the_env == info->si_addr) { + int signal = the_env->interrupt_pending; + siginfo_t info = *(siginfo_t*)(the_env->interrupt_info); + printf("Unprotecting %p\n", the_env); + mprotect(the_env, sizeof(*the_env), PROT_READ | PROT_WRITE); + the_env->interrupt_pending = 0; + the_env->disable_interrupts = 0; + unblock_signal(sig); + return handle_signal_now(signal, &info, aux); + } +#endif + call_handler(handle_signal_now, sig, info, aux); } cl_object si_check_pending_interrupts(void) { - int what = cl_env.interrupt_pending; + int sig = cl_env.interrupt_pending; + void *info = cl_env.interrupt_info; cl_env.interrupt_pending = 0; - if (what) { -#if defined (HAVE_SIGPROCMASK) && defined(SA_SIGINFO) - handle_signal(what, 0, 0); -#else - handle_signal(what); -#endif + if (sig) { + call_handler(handle_signal_now, sig, info, 0); } @(return) } @@ -324,8 +441,14 @@ si_catch_signal(cl_object code, cl_object boolean) #endif for (i = 0; known_signals[i].code >= 0; i++) { if (known_signals[i].code == code_int) { - mysignal(code_int, - Null(boolean)? SIG_DFL : signal_catcher); + if (Null(boolean)) + mysignal(code_int, SIG_DFL); + else if (code_int == SIGSEGV) + mysignal(code_int, sigsegv_handler); + else if (code_int == SIGBUS) + mysignal(code_int, sigbus_handler); + else + mysignal(code_int, non_evil_signal_handler); @(return Ct) } } @@ -350,15 +473,15 @@ LONG WINAPI W32_exception_filter(struct _EXCEPTION_POINTERS* ep) case EXCEPTION_FLT_DENORMAL_OPERAND: case EXCEPTION_FLT_INVALID_OPERATION: case EXCEPTION_FLT_STACK_CHECK: - handle_signal(SIGFPE); + non_evil_signal_handler(SIGFPE); break; /* Catch segmentation fault */ case EXCEPTION_ACCESS_VIOLATION: - handle_signal(SIGSEGV); + sigsegv_handler(SIGSEGV); break; /* Catch illegal instruction */ case EXCEPTION_ILLEGAL_INSTRUCTION: - handle_signal(SIGILL); + non_evil_signal_handler(SIGILL); break; /* Do not catch anything else */ default: @@ -384,7 +507,6 @@ void handle_fpe_signal(int sig, int num) condition = @'division-by-zero'; break; } - si_trap_fpe(@'last', Ct); cl_error(1, condition); } @@ -395,7 +517,7 @@ BOOL WINAPI W32_console_ctrl_handler(DWORD type) { /* Catch CTRL-C */ case CTRL_C_EVENT: - handle_signal(SIGINT); + non_evil_signal_handler(SIGINT); return TRUE; } return FALSE; @@ -440,27 +562,21 @@ init_unixint(int pass) if (pass == 0) { #ifdef SIGSEGV if (ecl_get_option(ECL_OPT_TRAP_SIGSEGV)) { - mysignal(SIGSEGV, signal_catcher); + mysignal(SIGSEGV, sigsegv_handler); } #endif -#if defined(SIGBUS) && !defined(GBC_BOEHM) +#if defined(SIGBUS) /*&& !defined(GBC_BOEHM)*/ if (ecl_get_option(ECL_OPT_TRAP_SIGBUS)) { - mysignal(SIGBUS, signal_catcher); + mysignal(SIGBUS, sigbus_handler); } #endif #ifdef SIGINT if (ecl_get_option(ECL_OPT_TRAP_SIGINT)) { - mysignal(SIGINT, signal_catcher); - } -#endif -#ifdef SIGFPE - if (ecl_get_option(ECL_OPT_TRAP_SIGFPE)) { - mysignal(SIGFPE, signal_catcher); - si_trap_fpe(Ct, Ct); + mysignal(SIGINT, non_evil_signal_handler); } #endif #if defined(ECL_THREADS) && !defined(_MSC_VER) && !defined(mingw32) - mysignal(SIGUSR1, signal_catcher); + mysignal(SIGUSR1, non_evil_signal_handler); #endif #ifdef _MSC_VER SetUnhandledExceptionFilter(W32_exception_filter); @@ -475,6 +591,12 @@ init_unixint(int pass) si_Xmake_constant(name, MAKE_FIXNUM(known_signals[i].code)); } ECL_SET(@'si::*interrupt-enable*', Ct); +#ifdef SIGFPE + if (ecl_get_option(ECL_OPT_TRAP_SIGFPE)) { + mysignal(SIGFPE, non_evil_signal_handler); + si_trap_fpe(Ct, Ct); + } +#endif + cl_env.disable_interrupts = 0; } - ecl_interrupt_enable = 1; } diff --git a/src/h/external.h b/src/h/external.h index 7f3a898fd..1eb1178b6 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -9,7 +9,10 @@ extern "C" { * Per-thread data. */ -struct cl_env_struct { +typedef struct cl_env_struct { + /* Flag for disabling interrupts while we call C library functions. */ + int disable_interrupts; + /* The four stacks in ECL. */ /* @@ -57,6 +60,7 @@ struct cl_env_struct { */ cl_fixnum *cs_org; cl_fixnum *cs_limit; + cl_fixnum *cs_barrier; cl_index cs_size; /* Array where values are returned by functions. */ @@ -91,6 +95,7 @@ struct cl_env_struct { cl_object own_process; #endif int interrupt_pending; + void *interrupt_info; /* The following is a hash table for caching invocations of generic functions. In a multithreaded environment we must @@ -111,21 +116,22 @@ struct cl_env_struct { /* Alternative stack for processing signals */ void *altstack; cl_index altstack_size; -}; +} *cl_env_ptr; #ifndef __GNUC__ #define __attribute__(x) #endif #if defined(ECL_THREADS) # ifdef WITH___THREAD -extern __thread struct cl_env_struct * cl_env_p; -#define cl_env (*cl_env_p) +# define cl_env (*cl_env_p) + extern __thread cl_env_ptr cl_env_p; # else -#define cl_env (*ecl_process_env()) -extern ECL_API struct cl_env_struct *ecl_process_env(void) __attribute__((const)); +# define cl_env (*ecl_process_env()) + extern ECL_API cl_env_ptr ecl_process_env(void) __attribute__((const)); # endif #else -extern ECL_API struct cl_env_struct cl_env; +# define cl_env (*cl_env_p) + extern cl_env_ptr cl_env_p; #endif /* @@ -647,7 +653,7 @@ extern ECL_API void ecl_register_root(cl_object *p); /* gfun.c */ #ifdef CLOS -extern ECL_API void _ecl_set_method_hash_size(struct cl_env_struct *env, cl_index size); +extern ECL_API void _ecl_set_method_hash_size(cl_env_ptr env, cl_index size); extern ECL_API cl_object si_clear_gfun_hash(cl_object what); extern ECL_API cl_object clos_set_funcallable_instance_function(cl_object x, cl_object function_or_t); extern ECL_API cl_object si_generic_function_p(cl_object instance); @@ -1546,6 +1552,9 @@ extern ECL_API cl_object si_get_library_pathname(void); /* unixint.c */ +#define ECL_DISABLE_INTERRUPTS(env) ((env)->disable_interrupts=1) +#define ECL_ENABLE_INTERRUPTS(env) ((env)->disable_interrupts=0) +#define ECL_ATOMIC(env,stmt) (ECL_DISABLE_INTERRUPTS(env),(stmt),ECL_ENABLE_INTERRUPTS(env)) extern ECL_API cl_object si_catch_signal(cl_object signal, cl_object state); extern ECL_API cl_object si_check_pending_interrupts(void); extern ECL_API cl_object si_trap_fpe(cl_object condition, cl_object flag); diff --git a/src/h/internal.h b/src/h/internal.h index 4599d81b0..e63573cd7 100644 --- a/src/h/internal.h +++ b/src/h/internal.h @@ -39,13 +39,16 @@ extern void init_GC(void); extern void init_macros(void); extern void init_number(void); extern void init_read(void); -extern void init_stacks(struct cl_env_struct *, int *); +extern void init_stacks(cl_env_ptr, int *); extern void init_unixint(int pass); extern void init_unixtime(void); #ifdef mingw32 extern void init_compiler(void); #endif -extern void ecl_init_env(struct cl_env_struct *); +#ifdef ECL_THREADS +extern void init_threads(cl_env_ptr); +#endif +extern void ecl_init_env(cl_env_ptr); extern void init_lib_LSP(cl_object); /* alloc.d/alloc_2.d */ @@ -193,8 +196,6 @@ extern cl_fixnum ecl_runtime(void); /* unixint.d */ -extern bool ecl_interrupt_enable; - #if defined(_MSC_VER) || defined(mingw32) # include # if defined(_MSC_VER) From b5119bfb90815a9df14d885f40083eb02847c431 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Wed, 8 Oct 2008 23:49:31 +0200 Subject: [PATCH 02/60] Add a configuration flag for using mprotect. Add an implementation of interrupt disable/enable without mprotect. Set up interrupt barriers around I/O operations. Force error routines to enable interrupts. --- msvc/ecl/config.h.msvc6 | 7 +- src/c/error.d | 26 +- src/c/file.d | 130 +- src/c/main.d | 26 +- src/c/symbols_list.h | 2 + src/c/symbols_list2.h | 2 + src/c/threads.d | 5 +- src/c/unixint.d | 98 +- src/configure | 5520 +++++++++++++++++++++++---------------- src/configure.in | 2 + src/h/config.h.in | 3 + src/h/external.h | 19 +- src/h/internal.h | 2 + 13 files changed, 3448 insertions(+), 2394 deletions(-) diff --git a/msvc/ecl/config.h.msvc6 b/msvc/ecl/config.h.msvc6 index 76436a20d..bd345707a 100644 --- a/msvc/ecl/config.h.msvc6 +++ b/msvc/ecl/config.h.msvc6 @@ -196,13 +196,16 @@ typedef unsigned int uint32_t; /* Assembler implementation of APPLY and friends */ /* #undef ECL_ASM_APPLY */ +/* Stack grows downwards */ +#define ECL_DOWN_STACK 1 + +/* Use mprotect for fast interrupt dispatch */ +/* #undef ECL_USE_MPROTECT */ /* * SYSTEM FEATURES: */ -/* Stack grows downwards */ -#define DOWN_STACK 1 /* Arguments cannot be accessed as array */ /* #undef NO_ARGS_ARRAY */ /* Most significant byte first */ diff --git a/src/c/error.d b/src/c/error.d index 10797d5de..253e23637 100644 --- a/src/c/error.d +++ b/src/c/error.d @@ -46,6 +46,7 @@ FEerror(const char *s, int narg, ...) { cl_va_list args; cl_va_start(args, narg, narg, 0); + ecl_enable_interrupts(); funcall(4, @'si::universal-error-handler', Cnil, /* not correctable */ make_constant_base_string(s), /* condition text */ @@ -57,6 +58,7 @@ CEerror(cl_object c, const char *err, int narg, ...) { cl_va_list args; cl_va_start(args, narg, narg, 0); + ecl_enable_interrupts(); return funcall(4, @'si::universal-error-handler', c, /* correctable */ make_constant_base_string(err), /* continue-format-string */ @@ -70,7 +72,7 @@ CEerror(cl_object c, const char *err, int narg, ...) void FEprogram_error(const char *s, int narg, ...) { - cl_object form, real_args, text; + cl_object form, real_args, text; cl_va_list args; cl_va_start(args, narg, narg, 0); text = make_constant_base_string(s); @@ -209,11 +211,11 @@ FEinvalid_function_name(cl_object fname) } /* bootstrap version */ -static -@(defun "universal_error_handler" (c err args) -@ +static cl_object +universal_error_handler(cl_narg narg, cl_object c, cl_object err, cl_object args, ...) +{ ecl_internal_error("\nLisp initialization error.\n"); -@) +} void FEillegal_index(cl_object x, cl_object i) @@ -285,18 +287,16 @@ FEwin32_error(const char *msg, int narg, ...) @(defun error (eformat &rest args) @ - funcall(4, @'si::universal-error-handler', - Cnil, - eformat, - cl_grab_rest_args(args)); + ecl_enable_interrupts(); + return funcall(4, @'si::universal-error-handler', Cnil, eformat, + cl_grab_rest_args(args)); @) @(defun cerror (cformat eformat &rest args) @ - return(funcall(4, @'si::universal-error-handler', - cformat, - eformat, - cl_grab_rest_args(args))); + ecl_enable_interrupts(); + return funcall(4, @'si::universal-error-handler', cformat, eformat, + cl_grab_rest_args(args)); @) void diff --git a/src/c/file.d b/src/c/file.d index 648eebee9..4d3d86335 100644 --- a/src/c/file.d +++ b/src/c/file.d @@ -376,8 +376,9 @@ not_a_character_stream(cl_object s) static void io_error(cl_object strm) { + cl_env_ptr the_env = &cl_env; FILE *f = strm->stream.file; - if (f) clearerr(f); + if (f) ECL_PSEUDO_ATOMIC_ENV(the_env, clearerr(f)); FElibc_error("Read or write operation to stream ~S signaled an error.", 1, strm); } @@ -394,10 +395,14 @@ wsock_error( const char *err_msg, cl_object strm ) { char *msg; cl_object msg_obj; - FormatMessage( FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER, - 0, WSAGetLastError(), 0, ( void* )&msg, 0, NULL ); - msg_obj = make_base_string_copy( msg ); - LocalFree( msg ); + ecl_disable_interrupts(); + { + FormatMessage( FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER, + 0, WSAGetLastError(), 0, ( void* )&msg, 0, NULL ); + msg_obj = make_base_string_copy( msg ); + LocalFree( msg ); + } + ecl_enable_interrupts(); FEerror( err_msg, 2, strm, msg_obj ); } #endif @@ -413,6 +418,7 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, cl_object if_does_not_exist, cl_fixnum byte_size, bool char_stream_p, bool use_header_p) { + cl_env_ptr the_env = &cl_env; cl_object x; FILE *fp; cl_object filename = si_coerce_to_filename(fn); @@ -429,33 +435,36 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, if (char_stream_p && byte_size != 8) { FEerror("Tried to make a character stream of byte size /= 8.",0); } + ecl_disable_interrupts_env(the_env); if (smm == smm_input || smm == smm_probe) { fp = fopen(fname, OPEN_R); if (fp == NULL) { - if (if_does_not_exist == @':error') - FEcannot_open(fn); - else if (if_does_not_exist == @':create') { + if (if_does_not_exist == @':error') { + goto CANNOT_OPEN; + } else if (if_does_not_exist == @':create') { fp = fopen(fname, OPEN_W); if (fp == NULL) - FEcannot_open(fn); + goto CANNOT_OPEN; fclose(fp); fp = fopen(fname, OPEN_R); if (fp == NULL) - FEcannot_open(fn); + goto CANNOT_OPEN; } else if (Null(if_does_not_exist)) { - return(Cnil); + x = Cnil; + goto OUTPUT; } else { - FEerror("~S is an illegal IF-DOES-NOT-EXIST option.", - 1, if_does_not_exist); + x = @':if-does-not-exist'; + fn = if_does_not_exist; + goto INVALID_OPTION; } } else if (!char_stream_p && use_header_p) { /* Read the binary header */ int c = getc(fp); if (c != EOF) { binary_header = c & 0xFF; - if (binary_header & ~7) - FEerror("~S has an invalid binary header ~S", - 2, fn, MAKE_FIXNUM(binary_header)); + if (binary_header & ~7) { + goto INVALID_HEADER; + } } ecl_fseeko(fp, 0, SEEK_SET); } @@ -469,9 +478,9 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, int c = getc(fp); if (c != EOF) { binary_header = c & 0xFF; - if (binary_header & ~7) - FEerror("~S has an invalid binary header ~S", - 2, fn, MAKE_FIXNUM(binary_header)); + if (binary_header & ~7) { + goto INVALID_HEADER; + } if (binary_header != 0 && if_exists == @':append' && ecl_fseeko(fp, -1, SEEK_END) == 0) { /* Read the last byte */ @@ -481,63 +490,71 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, } } fclose(fp); - if (if_exists == @':error') - FEcannot_open(fn); - else if (if_exists == @':rename') { + if (if_exists == @':error') { + goto CANNOT_OPEN; + } else if (if_exists == @':rename') { fp = ecl_backup_fopen(fname, (smm == smm_output) ? OPEN_W : OPEN_RW); - if (fp == NULL) - FEcannot_open(fn); + if (fp == NULL) { + goto CANNOT_OPEN; + } } else if (if_exists == @':rename_and_delete' || if_exists == @':new_version' || if_exists == @':supersede') { fp = fopen(fname, (smm == smm_output) ? OPEN_W : OPEN_RW); - if (fp == NULL) - FEcannot_open(fn); + if (fp == NULL) { + goto CANNOT_OPEN; + } } else if (if_exists == @':overwrite' || if_exists == @':append') { /* We cannot use "w+b" because it truncates. We cannot use "a+b" because writes jump to the end. */ int f = open(filename->base_string.self, (smm == smm_output)? (O_WRONLY|O_CREAT) : (O_RDWR|O_CREAT)); - if (f < 0) - FEcannot_open(fn); + if (f < 0) { + goto CANNOT_OPEN; + } fp = fdopen(f, (smm == smm_output)? OPEN_W : OPEN_RW); if (fp == NULL) { close(f); - FEcannot_open(fn); + goto CANNOT_OPEN; } if (if_exists == @':append') { ecl_fseeko(fp, 0, SEEK_END); appending = TRUE; } } else if (Null(if_exists)) { - return(Cnil); + x = Cnil; + goto OUTPUT; } else { - FEerror("~S is an illegal IF-EXISTS option.", - 1, if_exists); + x = @':if-exists'; + fn = if_exists; + goto INVALID_OPTION; } } else { - if (if_does_not_exist == @':error') - FEcannot_open(fn); - else if (if_does_not_exist == @':create') { + if (if_does_not_exist == @':error') { + goto CANNOT_OPEN; + } else if (if_does_not_exist == @':create') { CREATE: fp = fopen(fname, (smm == smm_output) ? OPEN_W : OPEN_RW); - if (fp == NULL) - FEcannot_open(fn); + if (fp == NULL) { + goto CANNOT_OPEN; + } } else if (Null(if_does_not_exist)) { - return(Cnil); + x = Cnil; + goto OUTPUT; } else { - FEerror("~S is an illegal IF-DOES-NOT-EXIST option.", - 1, if_does_not_exist); + x = @':if-does-not-exist'; + fn = if_does_not_exist; + goto INVALID_OPTION; } } } else { - FEerror("Illegal stream mode ~S", 1, MAKE_FIXNUM(smm)); + goto INVALID_MODE; } x = cl_alloc_object(t_stream); x->stream.mode = (short)smm; @@ -577,7 +594,22 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, } } } - return(x); + OUTPUT: + ecl_enable_interrupts_env(the_env); + return x; + CANNOT_OPEN: + FEcannot_open(fn); + return Cnil; + INVALID_OPTION: + FEerror("Invalid value op option ~A: ~A", 2, x, fn); + return Cnil; + INVALID_HEADER: + FEerror("~S has an invalid binary header ~S", 2, fn, + MAKE_FIXNUM(binary_header)); + return Cnil; + INVALID_MODE: + FEerror("Illegal stream mode ~S", 1, MAKE_FIXNUM(smm)); + return Cnil; } /* Forward definitions */ @@ -1153,13 +1185,15 @@ BEGIN: if (fp == NULL) wrong_file_handler(strm); if (cl_env.disable_interrupts) printf("Cannot disable interrupts twice.\n"); - ECL_DISABLE_INTERRUPTS(the_env); - c = getc(fp); - if (the_env->interrupt_pending) { - printf("Clearing file errors\n"); - clearerr(fp); + ecl_disable_interrupts_env(the_env); + { + c = getc(fp); + if (the_env->interrupt_pending) { + printf("Clearing file errors\n"); + clearerr(fp); + } } - ECL_ENABLE_INTERRUPTS(the_env); + ecl_enable_interrupts_env(the_env); if (cl_env.disable_interrupts) printf("Interrupts are not reenabled.\n"); if (c == EOF && ferror(fp)) io_error(strm); diff --git a/src/c/main.d b/src/c/main.d index 625d83d1a..4745ee691 100644 --- a/src/c/main.d +++ b/src/c/main.d @@ -32,7 +32,7 @@ # include # endif #endif -#ifdef HAVE_MMAP +#ifdef ECL_USE_MPROTECT # include #endif #include @@ -199,6 +199,21 @@ static const struct { {NULL, -1} }; +cl_env_ptr +_ecl_alloc_env() +{ + cl_env_ptr output; +#if defined(ECL_USE_MPROTECT) + output = mmap(0, sizeof(*cl_env_p), PROT_READ | PROT_WRITE, + MAP_ANON | MAP_PRIVATE, 0, 0); + if (output < 0) + ecl_internal_error("Unable to allocate environment structure."); +#else + output = cl_alloc(sizeof(*cl_env_p)); +#endif + return output; +} + int cl_shutdown(void) { @@ -253,14 +268,7 @@ cl_boot(int argc, char **argv) init_unixint(0); init_alloc(); GC_disable(); -#if !defined(HAVE_MMAP) - cl_env_p = cl_alloc(sizeof(*cl_env_p)); -#else - cl_env_p = mmap(0, sizeof(*cl_env_p), PROT_READ | PROT_WRITE, - MAP_ANON | MAP_PRIVATE, 0, 0); - if (cl_env_p < 0) - ecl_internal_error("Unable to allocate environment structure."); -#endif + cl_env_p = _ecl_alloc_env(); #ifdef ECL_THREADS init_threads(cl_env_p); #endif diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index 8f4e7eb1e..1bf8cbc6c 100644 --- a/src/c/symbols_list.h +++ b/src/c/symbols_list.h @@ -1709,5 +1709,7 @@ cl_symbols[] = { {EXT_ "SET-STACK-SIZE", SI_ORDINARY, si_set_stack_size, 2, OBJNULL}, {EXT_ "SEGMENTATION-VIOLATION", SI_ORDINARY, NULL, -1, OBJNULL}, +{SYS_ "CHECK-PENDING-INTERRUPTS", SI_ORDINARY, si_check_pending_interrupts, 0, OBJNULL}, + /* Tag for end of list */ {NULL, CL_ORDINARY, NULL, -1, OBJNULL}}; diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h index 787bb8820..4b684e396 100644 --- a/src/c/symbols_list2.h +++ b/src/c/symbols_list2.h @@ -1709,5 +1709,7 @@ cl_symbols[] = { {EXT_ "SET-STACK-SIZE","si_set_stack_size"}, {EXT_ "SEGMENTATION-VIOLATION",NULL}, +{SYS_ "CHECK-PENDING-INTERRUPTS","si_check_pending_interrupts"}, + /* Tag for end of list */ {NULL,NULL}}; diff --git a/src/c/threads.d b/src/c/threads.d index 0a4871342..70f9f4f76 100644 --- a/src/c/threads.d +++ b/src/c/threads.d @@ -30,9 +30,6 @@ #ifdef HAVE_SCHED_YIELD # include #endif -#ifdef HAVE_MMAP -# include -#endif #ifndef WITH___THREAD static pthread_key_t cl_env_key; @@ -132,7 +129,7 @@ alloc_process(cl_object name) process->process.function = Cnil; process->process.args = Cnil; process->process.interrupt = Cnil; - process->process.env = cl_alloc(sizeof(*process->process.env)); + process->process.env = _ecl_alloc_env(); process->process.env->own_process = process; return process; } diff --git a/src/c/unixint.d b/src/c/unixint.d index 478b22230..98faed9d4 100644 --- a/src/c/unixint.d +++ b/src/c/unixint.d @@ -38,7 +38,7 @@ # endif #endif #include -#ifdef HAVE_MMAP +#ifdef ECL_USE_MPROTECT # ifndef SA_SIGINFO # error "We cannot use the mmap code without siginfo" # endif @@ -162,6 +162,7 @@ static struct { #define define_handler(name, sig, info, aux) name(sig, info, aux) #define call_handler(name, sig, info, aux) name(sig, info, aux) #define reinstall_signal(x,y) +#define copy_siginfo(x,y) memcpy(x, y, sizeof(struct sigaction)) static void mysignal(int code, void *handler) { @@ -185,14 +186,20 @@ mysignal(int code, void *handler) #define call_handler(name, sig, info, aux) name(sig) #define mysignal(x,y) signal(x,y) #define reinstall_signal(x,y) signal(x,y) +#define copy_siginfo(x,y) #endif static bool -interrupts_disabled(cl_env_ptr the_env) +interrupts_disabled_by_C(cl_env_ptr the_env) { - return the_env->disable_interrupts || - (ecl_get_option(ECL_OPT_BOOTED) && - ecl_symbol_value(@'si::*interrupt-enable*') == Cnil); + return the_env->disable_interrupts; +} + +static bool +interrupts_disabled_by_lisp(cl_env_ptr the_env) +{ + return (ecl_get_option(ECL_OPT_BOOTED) && + ecl_symbol_value(@'si::*interrupt-enable*') == Cnil); } static void @@ -310,23 +317,39 @@ define_handler(non_evil_signal_handler, int sig, siginfo_t *siginfo, void *data) reinstall_signal(sig, non_evil_signal_handler); printf("Non evil handler\n"); /* - * If interrupts are disabled, and we have not pushed a pending - * signal, save this signal and return. On platforms in which - * mprotect() works, we block all write access to the environment - * for a cheap check of pending interrupts. + * If interrupts are disabled by C we are not so eager on + * detecting when the interrupts become enabled again. We + * queue the signal and are done with that. */ - if (interrupts_disabled(the_env)) { + if (interrupts_disabled_by_lisp(the_env)) { + if (!the_env->interrupt_pending) { + the_env->interrupt_pending = sig; + copy_siginfo(the_env->interrupt_info, siginfo); + } + errno = old_errno; + return; + } + /* + * If interrupts are disabled by C, and we have not pushed a + * pending signal, save this signal and return. On platforms + * in which mprotect() works, we block all write access to the + * environment for a cheap check of pending interrupts. On other + * platforms we change the value of disable_interrupts to 3, so + * that we detect changes. + */ + if (interrupts_disabled_by_C(the_env)) { + the_env->disable_interrupts = 3; if (!the_env->interrupt_pending) { struct sigaction oact; the_env->interrupt_pending = sig; - memcpy(the_env->interrupt_info, siginfo, sizeof(siginfo)); + copy_siginfo(the_env->interrupt_info, siginfo); printf("Postponing signal %d\n", sig); sigaction(SIGSEGV, NULL, &oact); printf("SIGSEGV Handler: %x\n", oact.sa_sigaction); sigaction(SIGBUS, NULL, &oact); printf("SIGBUS Handler: %x\n", oact.sa_sigaction); printf("sigsegv_handler: %x\n", sigsegv_handler); -#ifdef HAVE_MMAP +#ifdef ECL_USE_MPROTECT printf("Protecting %x\n", the_env); if (mprotect(the_env, sizeof(*the_env), PROT_READ) < 0) ecl_internal_error("Unable to mprotect environment."); @@ -352,25 +375,34 @@ define_handler(sigsegv_handler, int sig, siginfo_t *info, void *aux) # ifdef ECL_DOWN_STACK if ((cl_fixnum*)info->si_addr > the_env->cs_barrier && (cl_fixnum*)info->si_addr <= the_env->cs_org) { - jump_to_sigsegv_handler(the_env); + return jump_to_sigsegv_handler(the_env); } # else if ((cl_fixnum*)info->si_addr < the_env->cs_barrier && (cl_fixnum*)info->si_addr >= the_env->cs_org) { - jump_to_sigsegv_handler(the_env); + return jump_to_sigsegv_handler(the_env); } # endif - if (interrupts_disabled(the_env)) { - the_env->interrupt_pending = sig; - memcpy(the_env->interrupt_info, info, sizeof(*info)); -# ifdef HAVE_MMAP - printf("Protecting %p\n", the_env); - if (mprotect(the_env, sizeof(*the_env), PROT_READ) < 0) - ecl_internal_error("Unable to mprotect environment."); -# endif - } else { - handle_signal_now(sig, info, aux); + if (interrupts_disabled_by_lisp(the_env)) { + if (!the_env->interrupt_pending) { + the_env->interrupt_pending = sig; + copy_siginfo(the_env->interrupt_info, info); + } + return; } + if (interrupts_disabled_by_C(the_env)) { + if (!the_env->interrupt_pending) { + the_env->interrupt_pending = sig; + copy_siginfo(the_env->interrupt_info, info); +# ifdef ECL_USE_MPROTECT + printf("Protecting %p\n", the_env); + if (mprotect(the_env, sizeof(*the_env), PROT_READ) < 0) + ecl_internal_error("Unable to mprotect environment."); +# endif + } + return; + } + handle_signal_now(sig, info, aux); #else reinstall_signal_handler(sig, sigsegv_signal_handler); /* @@ -387,7 +419,7 @@ define_handler(sigbus_handler, int sig, siginfo_t *info, void *aux) { cl_env_ptr the_env = &cl_env; printf("Entering sigbus_handler for address %0p\n", info->si_addr); -#if defined(SA_SIGINFO) && defined(HAVE_MMAP) +#if defined(SA_SIGINFO) && defined(ECL_USE_MPROTECT) /* We access the environment when it was protected. That * means there was a pending signal. */ if (the_env == info->si_addr) { @@ -407,13 +439,21 @@ define_handler(sigbus_handler, int sig, siginfo_t *info, void *aux) cl_object si_check_pending_interrupts(void) { - int sig = cl_env.interrupt_pending; - void *info = cl_env.interrupt_info; - cl_env.interrupt_pending = 0; + ecl_check_pending_interrupts(); + @(return) +} + +void +ecl_check_pending_interrupts(void) +{ + int sig; + void *info; + cl_env.disable_interrupts = 0; + info = cl_env.interrupt_info; + sig = cl_env.interrupt_pending; if (sig) { call_handler(handle_signal_now, sig, info, 0); } - @(return) } cl_object diff --git a/src/configure b/src/configure index 56b321786..57ff33c2f 100755 --- a/src/configure +++ b/src/configure @@ -1,10 +1,10 @@ #! /bin/sh # From configure.in Revision. # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.61 for ecl 8.10.0. +# Generated by GNU Autoconf 2.63 for ecl 8.10.0. # # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, -# 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. +# 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. ## --------------------- ## @@ -16,7 +16,7 @@ DUALCASE=1; export DUALCASE # for MKS sh if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: - # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST @@ -38,17 +38,45 @@ as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +if (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then - echo "#! /bin/sh" >conf$$.sh - echo "exit 0" >>conf$$.sh - chmod +x conf$$.sh - if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then - PATH_SEPARATOR=';' - else - PATH_SEPARATOR=: - fi - rm -f conf$$.sh + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } fi # Support unset when possible. @@ -64,8 +92,6 @@ fi # there to prevent editors from complaining about space-tab. # (If _AS_PATH_WALK were called with IFS unset, it would disable word # splitting by setting IFS to empty value.) -as_nl=' -' IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. @@ -88,7 +114,7 @@ if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then - echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 { (exit 1); exit 1; } fi @@ -101,17 +127,10 @@ PS2='> ' PS4='+ ' # NLS nuisances. -for as_var in \ - LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ - LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ - LC_TELEPHONE LC_TIME -do - if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then - eval $as_var=C; export $as_var - else - ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var - fi -done +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1 && @@ -133,7 +152,7 @@ as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || -echo X/"$0" | +$as_echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q @@ -159,7 +178,7 @@ else as_have_required=no fi - if test $as_have_required = yes && (eval ": + if test $as_have_required = yes && (eval ": (as_func_return () { (exit \$1) } @@ -241,7 +260,7 @@ IFS=$as_save_IFS if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: - # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST @@ -262,7 +281,7 @@ _ASEOF if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: - # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST @@ -342,10 +361,10 @@ fi if test "x$CONFIG_SHELL" != x; then for as_var in BASH_ENV ENV - do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var - done - export CONFIG_SHELL - exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"} + do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var + done + export CONFIG_SHELL + exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"} fi @@ -414,9 +433,10 @@ fi test \$exitcode = 0") || { echo No shell found that supports shell functions. - echo Please tell autoconf@gnu.org about your system, - echo including any error possibly output before this - echo message + echo Please tell bug-autoconf@gnu.org about your system, + echo including any error possibly output before this message. + echo This can help us improve future autoconf versions. + echo Configuration will now proceed without shell functions. } @@ -452,7 +472,7 @@ test \$exitcode = 0") || { s/-\n.*// ' >$as_me.lineno && chmod +x "$as_me.lineno" || - { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 + { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems @@ -480,7 +500,6 @@ case `echo -n x` in *) ECHO_N='-n';; esac - if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr @@ -493,19 +512,22 @@ if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir - mkdir conf$$.dir + mkdir conf$$.dir 2>/dev/null fi -echo >conf$$.file -if ln -s conf$$.file conf$$ 2>/dev/null; then - as_ln_s='ln -s' - # ... but there are two gotchas: - # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. - # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. - # In both cases, we have to default to `cp -p'. - ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -p'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -p' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else as_ln_s='cp -p' -elif ln conf$$.file conf$$ 2>/dev/null; then - as_ln_s=ln + fi else as_ln_s='cp -p' fi @@ -530,10 +552,10 @@ else as_test_x=' eval sh -c '\'' if test -d "$1"; then - test -d "$1/."; + test -d "$1/."; else case $1 in - -*)set "./$1";; + -*)set "./$1";; esac; case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in ???[sx]*):;;*)false;;esac;fi @@ -614,127 +636,167 @@ ac_includes_default="\ # include #endif" -ac_subst_vars='SHELL -PATH_SEPARATOR -PACKAGE_NAME -PACKAGE_TARNAME -PACKAGE_VERSION -PACKAGE_STRING -PACKAGE_BUGREPORT -exec_prefix -prefix -program_transform_name -bindir -sbindir -libexecdir -datarootdir -datadir -sysconfdir -sharedstatedir -localstatedir -includedir -oldincludedir -docdir -infodir -htmldir -dvidir -pdfdir -psdir -libdir -localedir -mandir -DEFS -ECHO_C -ECHO_N -ECHO_T -LIBS -build_alias -host_alias -target_alias -ecldir -buildir -ECL_CFLAGS -DEBUG_CFLAGS -GMP_CFLAGS -GMP_LDFLAGS -FASL_LIBS -CORE_LIBS -SHARED_LDFLAGS -BUNDLE_LDFLAGS -EXTRA_OBJS -TARGETS -SUBDIRS -LIBRARIES -LSP_LIBRARIES -LSP_FEATURES -build -build_cpu -build_vendor -build_os -host -host_cpu -host_vendor -host_os -CC -CFLAGS -LDFLAGS -CPPFLAGS -ac_ct_CC -EXEEXT -OBJEXT -CXX -CXXFLAGS -ac_ct_CXX -CPP -RANLIB -INSTALL_PROGRAM -INSTALL_SCRIPT -INSTALL_DATA -LN_S -SET_MAKE -true_srcdir -true_builddir -CP -RM -MV -EXE_SUFFIX -ARCHITECTURE -SOFTWARE_TYPE -SOFTWARE_VERSION -MACHINE_VERSION -LDRPATH -LIBPREFIX -LIBEXT -SHAREDEXT -SHAREDPREFIX -INSTALL_TARGET -thehost -INFOEXT -INSTALL_INFO -SONAME3 -SONAME2 -SONAME1 -SONAME -SONAME_LDFLAGS -XMKMF -GREP -EGREP -CL_FIXNUM_TYPE -CL_FIXNUM_BITS -CL_FIXNUM_MAX -CL_FIXNUM_MIN -ECL_SETJMP -ECL_LONGJMP -ECL_FILE_CNT -ECL_FPE_CODE -LIBOBJS -POW_LIB -ECL_CC -CLX_INFO -ECL_BOEHM_GC_HEADER +ac_subst_vars='LTLIBOBJS ECL_GMP_HEADER -LTLIBOBJS' +ECL_BOEHM_GC_HEADER +CLX_INFO +ECL_CC +POW_LIB +LIBOBJS +ECL_FPE_CODE +ECL_FILE_CNT +ECL_LONGJMP +ECL_SETJMP +CL_FIXNUM_MIN +CL_FIXNUM_MAX +CL_FIXNUM_BITS +CL_FIXNUM_TYPE +EGREP +GREP +XMKMF +SONAME_LDFLAGS +SONAME +SONAME1 +SONAME2 +SONAME3 +INSTALL_INFO +INFOEXT +thehost +INSTALL_TARGET +SHAREDPREFIX +SHAREDEXT +LIBEXT +LIBPREFIX +LDRPATH +MACHINE_VERSION +SOFTWARE_VERSION +SOFTWARE_TYPE +ARCHITECTURE +EXE_SUFFIX +MV +RM +CP +true_builddir +true_srcdir +SET_MAKE +LN_S +INSTALL_DATA +INSTALL_SCRIPT +INSTALL_PROGRAM +RANLIB +CPP +ac_ct_CXX +CXXFLAGS +CXX +OBJEXT +EXEEXT +ac_ct_CC +CPPFLAGS +LDFLAGS +CFLAGS +CC +host_os +host_vendor +host_cpu +host +build_os +build_vendor +build_cpu +build +LSP_FEATURES +LSP_LIBRARIES +LIBRARIES +SUBDIRS +TARGETS +EXTRA_OBJS +BUNDLE_LDFLAGS +SHARED_LDFLAGS +CORE_LIBS +FASL_LIBS +GMP_LDFLAGS +GMP_CFLAGS +DEBUG_CFLAGS +ECL_CFLAGS +buildir +ecldir +target_alias +host_alias +build_alias +LIBS +ECHO_T +ECHO_N +ECHO_C +DEFS +mandir +localedir +libdir +psdir +pdfdir +dvidir +htmldir +infodir +docdir +oldincludedir +includedir +localstatedir +sharedstatedir +sysconfdir +datadir +datarootdir +libexecdir +sbindir +bindir +program_transform_name +prefix +exec_prefix +PACKAGE_BUGREPORT +PACKAGE_STRING +PACKAGE_VERSION +PACKAGE_TARNAME +PACKAGE_NAME +PATH_SEPARATOR +SHELL' ac_subst_files='' +ac_user_opts=' +enable_option_checking +with_cross_config +enable_shared +enable_threads +enable_boehm +enable_slow_config +enable_soname +with_system_boehm +with_gmp +with_system_gmp +with_gmp_prefix +with_gmp_incdir +with_gmp_libdir +enable_local_gmp +with___thread +enable_debug +enable_opcode8 +with_cxx +with_tcp +with_serve_event +with_clx +with_clos_streams +with_cmuformat +with_asdf +with_defsystem +with_cmp +with_rt +with_profile +with_fpe +with_signed_zero +enable_unicode +enable_longdouble +enable_c99complex +enable_hpack +enable_asmapply +enable_smallcons +enable_gengc +with_x +' ac_precious_vars='build_alias host_alias target_alias @@ -753,6 +815,8 @@ XMKMF' # Initialize some variables set by options. ac_init_help= ac_init_version=false +ac_unrecognized_opts= +ac_unrecognized_sep= # The variables have the same names as the options, with # dashes changed to underlines. cache_file=/dev/null @@ -851,13 +915,21 @@ do datarootdir=$ac_optarg ;; -disable-* | --disable-*) - ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'` + ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. - expr "x$ac_feature" : ".*[^-._$as_cr_alnum]" >/dev/null && - { echo "$as_me: error: invalid feature name: $ac_feature" >&2 + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + { $as_echo "$as_me: error: invalid feature name: $ac_useropt" >&2 { (exit 1); exit 1; }; } - ac_feature=`echo $ac_feature | sed 's/[-.]/_/g'` - eval enable_$ac_feature=no ;; + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=no ;; -docdir | --docdir | --docdi | --doc | --do) ac_prev=docdir ;; @@ -870,13 +942,21 @@ do dvidir=$ac_optarg ;; -enable-* | --enable-*) - ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` + ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. - expr "x$ac_feature" : ".*[^-._$as_cr_alnum]" >/dev/null && - { echo "$as_me: error: invalid feature name: $ac_feature" >&2 + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + { $as_echo "$as_me: error: invalid feature name: $ac_useropt" >&2 { (exit 1); exit 1; }; } - ac_feature=`echo $ac_feature | sed 's/[-.]/_/g'` - eval enable_$ac_feature=\$ac_optarg ;; + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=\$ac_optarg ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ @@ -1067,22 +1147,38 @@ do ac_init_version=: ;; -with-* | --with-*) - ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` + ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. - expr "x$ac_package" : ".*[^-._$as_cr_alnum]" >/dev/null && - { echo "$as_me: error: invalid package name: $ac_package" >&2 + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + { $as_echo "$as_me: error: invalid package name: $ac_useropt" >&2 { (exit 1); exit 1; }; } - ac_package=`echo $ac_package | sed 's/[-.]/_/g'` - eval with_$ac_package=\$ac_optarg ;; + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=\$ac_optarg ;; -without-* | --without-*) - ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'` + ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. - expr "x$ac_package" : ".*[^-._$as_cr_alnum]" >/dev/null && - { echo "$as_me: error: invalid package name: $ac_package" >&2 + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + { $as_echo "$as_me: error: invalid package name: $ac_useropt" >&2 { (exit 1); exit 1; }; } - ac_package=`echo $ac_package | sed 's/[-.]/_/g'` - eval with_$ac_package=no ;; + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=no ;; --x) # Obsolete; use --with-x. @@ -1102,7 +1198,7 @@ do | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; - -*) { echo "$as_me: error: unrecognized option: $ac_option + -*) { $as_echo "$as_me: error: unrecognized option: $ac_option Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; } ;; @@ -1111,16 +1207,16 @@ Try \`$0 --help' for more information." >&2 ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` # Reject names that are not valid shell variable names. expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null && - { echo "$as_me: error: invalid variable name: $ac_envvar" >&2 + { $as_echo "$as_me: error: invalid variable name: $ac_envvar" >&2 { (exit 1); exit 1; }; } eval $ac_envvar=\$ac_optarg export $ac_envvar ;; *) # FIXME: should be removed in autoconf 3.0. - echo "$as_me: WARNING: you should use --build, --host, --target" >&2 + $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && - echo "$as_me: WARNING: invalid host type: $ac_option" >&2 + $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2 : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} ;; @@ -1129,22 +1225,38 @@ done if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` - { echo "$as_me: error: missing argument to $ac_option" >&2 + { $as_echo "$as_me: error: missing argument to $ac_option" >&2 { (exit 1); exit 1; }; } fi -# Be sure to have absolute directory names. +if test -n "$ac_unrecognized_opts"; then + case $enable_option_checking in + no) ;; + fatal) { $as_echo "$as_me: error: unrecognized options: $ac_unrecognized_opts" >&2 + { (exit 1); exit 1; }; } ;; + *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; + esac +fi + +# Check all directory arguments for consistency. for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ datadir sysconfdir sharedstatedir localstatedir includedir \ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ libdir localedir mandir do eval ac_val=\$$ac_var + # Remove trailing slashes. + case $ac_val in + */ ) + ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` + eval $ac_var=\$ac_val;; + esac + # Be sure to have absolute directory names. case $ac_val in [\\/$]* | ?:[\\/]* ) continue;; NONE | '' ) case $ac_var in *prefix ) continue;; esac;; esac - { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 + { $as_echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 { (exit 1); exit 1; }; } done @@ -1159,7 +1271,7 @@ target=$target_alias if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe - echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. + $as_echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. If a cross compiler is detected then cross compile mode will be used." >&2 elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes @@ -1175,10 +1287,10 @@ test "$silent" = yes && exec 6>/dev/null ac_pwd=`pwd` && test -n "$ac_pwd" && ac_ls_di=`ls -di .` && ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || - { echo "$as_me: error: Working directory cannot be determined" >&2 + { $as_echo "$as_me: error: working directory cannot be determined" >&2 { (exit 1); exit 1; }; } test "X$ac_ls_di" = "X$ac_pwd_ls_di" || - { echo "$as_me: error: pwd does not report name of working directory" >&2 + { $as_echo "$as_me: error: pwd does not report name of working directory" >&2 { (exit 1); exit 1; }; } @@ -1186,12 +1298,12 @@ test "X$ac_ls_di" = "X$ac_pwd_ls_di" || if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then the parent directory. - ac_confdir=`$as_dirname -- "$0" || -$as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$0" : 'X\(//\)[^/]' \| \ - X"$0" : 'X\(//\)$' \| \ - X"$0" : 'X\(/\)' \| . 2>/dev/null || -echo X"$0" | + ac_confdir=`$as_dirname -- "$as_myself" || +$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_myself" : 'X\(//\)[^/]' \| \ + X"$as_myself" : 'X\(//\)$' \| \ + X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_myself" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q @@ -1218,12 +1330,12 @@ else fi if test ! -r "$srcdir/$ac_unique_file"; then test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." - { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2 + { $as_echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2 { (exit 1); exit 1; }; } fi ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" ac_abs_confdir=`( - cd "$srcdir" && test -r "./$ac_unique_file" || { echo "$as_me: error: $ac_msg" >&2 + cd "$srcdir" && test -r "./$ac_unique_file" || { $as_echo "$as_me: error: $ac_msg" >&2 { (exit 1); exit 1; }; } pwd)` # When building in place, set srcdir=. @@ -1272,9 +1384,9 @@ Configuration: Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX - [$ac_default_prefix] + [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX - [PREFIX] + [PREFIX] By default, \`make install' will install all the files in \`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify @@ -1284,25 +1396,25 @@ for instance \`--prefix=\$HOME'. For better control, use the options below. Fine tuning of the installation directories: - --bindir=DIR user executables [EPREFIX/bin] - --sbindir=DIR system admin executables [EPREFIX/sbin] - --libexecdir=DIR program executables [EPREFIX/libexec] - --sysconfdir=DIR read-only single-machine data [PREFIX/etc] - --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] - --localstatedir=DIR modifiable single-machine data [PREFIX/var] - --libdir=DIR object code libraries [EPREFIX/lib] - --includedir=DIR C header files [PREFIX/include] - --oldincludedir=DIR C header files for non-gcc [/usr/include] - --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] - --datadir=DIR read-only architecture-independent data [DATAROOTDIR] - --infodir=DIR info documentation [DATAROOTDIR/info] - --localedir=DIR locale-dependent data [DATAROOTDIR/locale] - --mandir=DIR man documentation [DATAROOTDIR/man] - --docdir=DIR documentation root [DATAROOTDIR/doc/ecl] - --htmldir=DIR html documentation [DOCDIR] - --dvidir=DIR dvi documentation [DOCDIR] - --pdfdir=DIR pdf documentation [DOCDIR] - --psdir=DIR ps documentation [DOCDIR] + --bindir=DIR user executables [EPREFIX/bin] + --sbindir=DIR system admin executables [EPREFIX/sbin] + --libexecdir=DIR program executables [EPREFIX/libexec] + --sysconfdir=DIR read-only single-machine data [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] + --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --libdir=DIR object code libraries [EPREFIX/lib] + --includedir=DIR C header files [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc [/usr/include] + --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] + --datadir=DIR read-only architecture-independent data [DATAROOTDIR] + --infodir=DIR info documentation [DATAROOTDIR/info] + --localedir=DIR locale-dependent data [DATAROOTDIR/locale] + --mandir=DIR man documentation [DATAROOTDIR/man] + --docdir=DIR documentation root [DATAROOTDIR/doc/ecl] + --htmldir=DIR html documentation [DOCDIR] + --dvidir=DIR dvi documentation [DOCDIR] + --pdfdir=DIR pdf documentation [DOCDIR] + --psdir=DIR ps documentation [DOCDIR] _ACEOF cat <<\_ACEOF @@ -1324,6 +1436,7 @@ if test -n "$ac_init_help"; then cat <<\_ACEOF Optional Features: + --disable-option-checking ignore unrecognized --enable/--with options --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] --enable-shared enable loading compiled files (default=YES) @@ -1405,15 +1518,17 @@ fi if test "$ac_init_help" = "recursive"; then # If there are subdirs, report their specific --help. for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue - test -d "$ac_dir" || continue + test -d "$ac_dir" || + { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || + continue ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) - ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` # A ".." for each directory in $ac_dir_suffix. - ac_top_builddir_sub=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,/..,g;s,/,,'` + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; @@ -1449,7 +1564,7 @@ ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix echo && $SHELL "$ac_srcdir/configure" --help=recursive else - echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 + $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 fi || ac_status=$? cd "$ac_pwd" || { ac_status=$?; break; } done @@ -1459,10 +1574,10 @@ test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF ecl configure 8.10.0 -generated by GNU Autoconf 2.61 +generated by GNU Autoconf 2.63 Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, -2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. +2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF @@ -1473,7 +1588,7 @@ This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by ecl $as_me 8.10.0, which was -generated by GNU Autoconf 2.61. Invocation command line was +generated by GNU Autoconf 2.63. Invocation command line was $ $0 $@ @@ -1509,7 +1624,7 @@ for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - echo "PATH: $as_dir" + $as_echo "PATH: $as_dir" done IFS=$as_save_IFS @@ -1544,7 +1659,7 @@ do | -silent | --silent | --silen | --sile | --sil) continue ;; *\'*) - ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; + ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac case $ac_pass in 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;; @@ -1596,11 +1711,12 @@ _ASBOX case $ac_val in #( *${as_nl}*) case $ac_var in #( - *_cv_*) { echo "$as_me:$LINENO: WARNING: Cache variable $ac_var contains a newline." >&5 -echo "$as_me: WARNING: Cache variable $ac_var contains a newline." >&2;} ;; + *_cv_*) { $as_echo "$as_me:$LINENO: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( *) $as_unset $ac_var ;; esac ;; esac @@ -1630,9 +1746,9 @@ _ASBOX do eval ac_val=\$$ac_var case $ac_val in - *\'\''*) ac_val=`echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac - echo "$ac_var='\''$ac_val'\''" + $as_echo "$ac_var='\''$ac_val'\''" done | sort echo @@ -1647,9 +1763,9 @@ _ASBOX do eval ac_val=\$$ac_var case $ac_val in - *\'\''*) ac_val=`echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac - echo "$ac_var='\''$ac_val'\''" + $as_echo "$ac_var='\''$ac_val'\''" done | sort echo fi @@ -1665,8 +1781,8 @@ _ASBOX echo fi test "$ac_signal" != 0 && - echo "$as_me: caught signal $ac_signal" - echo "$as_me: exit $exit_status" + $as_echo "$as_me: caught signal $ac_signal" + $as_echo "$as_me: exit $exit_status" } >&5 rm -f core *.core core.conftest.* && rm -f -r conftest* confdefs* conf$$* $ac_clean_files && @@ -1708,21 +1824,24 @@ _ACEOF # Let the site file select an alternate cache file if it wants to. -# Prefer explicitly selected file to automatically selected ones. +# Prefer an explicitly selected file to automatically selected ones. +ac_site_file1=NONE +ac_site_file2=NONE if test -n "$CONFIG_SITE"; then - set x "$CONFIG_SITE" + ac_site_file1=$CONFIG_SITE elif test "x$prefix" != xNONE; then - set x "$prefix/share/config.site" "$prefix/etc/config.site" + ac_site_file1=$prefix/share/config.site + ac_site_file2=$prefix/etc/config.site else - set x "$ac_default_prefix/share/config.site" \ - "$ac_default_prefix/etc/config.site" + ac_site_file1=$ac_default_prefix/share/config.site + ac_site_file2=$ac_default_prefix/etc/config.site fi -shift -for ac_site_file +for ac_site_file in "$ac_site_file1" "$ac_site_file2" do + test "x$ac_site_file" = xNONE && continue if test -r "$ac_site_file"; then - { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5 -echo "$as_me: loading site script $ac_site_file" >&6;} + { $as_echo "$as_me:$LINENO: loading site script $ac_site_file" >&5 +$as_echo "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 . "$ac_site_file" fi @@ -1732,16 +1851,16 @@ if test -r "$cache_file"; then # Some versions of bash will fail to source /dev/null (special # files actually), so we avoid doing that. if test -f "$cache_file"; then - { echo "$as_me:$LINENO: loading cache $cache_file" >&5 -echo "$as_me: loading cache $cache_file" >&6;} + { $as_echo "$as_me:$LINENO: loading cache $cache_file" >&5 +$as_echo "$as_me: loading cache $cache_file" >&6;} case $cache_file in [\\/]* | ?:[\\/]* ) . "$cache_file";; *) . "./$cache_file";; esac fi else - { echo "$as_me:$LINENO: creating cache $cache_file" >&5 -echo "$as_me: creating cache $cache_file" >&6;} + { $as_echo "$as_me:$LINENO: creating cache $cache_file" >&5 +$as_echo "$as_me: creating cache $cache_file" >&6;} >$cache_file fi @@ -1755,29 +1874,38 @@ for ac_var in $ac_precious_vars; do eval ac_new_val=\$ac_env_${ac_var}_value case $ac_old_set,$ac_new_set in set,) - { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 -echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} + { $as_echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) - { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5 -echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} + { $as_echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then - { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5 -echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} - { echo "$as_me:$LINENO: former value: $ac_old_val" >&5 -echo "$as_me: former value: $ac_old_val" >&2;} - { echo "$as_me:$LINENO: current value: $ac_new_val" >&5 -echo "$as_me: current value: $ac_new_val" >&2;} - ac_cache_corrupted=: + # differences in whitespace do not lead to failure. + ac_old_val_w=`echo x $ac_old_val` + ac_new_val_w=`echo x $ac_new_val` + if test "$ac_old_val_w" != "$ac_new_val_w"; then + { $as_echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5 +$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} + ac_cache_corrupted=: + else + { $as_echo "$as_me:$LINENO: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 +$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} + eval $ac_var=\$ac_old_val + fi + { $as_echo "$as_me:$LINENO: former value: \`$ac_old_val'" >&5 +$as_echo "$as_me: former value: \`$ac_old_val'" >&2;} + { $as_echo "$as_me:$LINENO: current value: \`$ac_new_val'" >&5 +$as_echo "$as_me: current value: \`$ac_new_val'" >&2;} fi;; esac # Pass precious variables to config.status. if test "$ac_new_set" = set; then case $ac_new_val in - *\'*) ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; + *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; *) ac_arg=$ac_var=$ac_new_val ;; esac case " $ac_configure_args " in @@ -1787,10 +1915,12 @@ echo "$as_me: current value: $ac_new_val" >&2;} fi done if $ac_cache_corrupted; then - { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5 -echo "$as_me: error: changes in the environment can compromise the build" >&2;} - { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5 -echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;} + { $as_echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + { $as_echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5 +$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;} + { { $as_echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5 +$as_echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;} { (exit 1); exit 1; }; } fi @@ -1844,8 +1974,8 @@ for ac_dir in ${srcdir}/gmp "$srcdir"/${srcdir}/gmp; do fi done if test -z "$ac_aux_dir"; then - { { echo "$as_me:$LINENO: error: cannot find install-sh or install.sh in ${srcdir}/gmp \"$srcdir\"/${srcdir}/gmp" >&5 -echo "$as_me: error: cannot find install-sh or install.sh in ${srcdir}/gmp \"$srcdir\"/${srcdir}/gmp" >&2;} + { { $as_echo "$as_me:$LINENO: error: cannot find install-sh or install.sh in ${srcdir}/gmp \"$srcdir\"/${srcdir}/gmp" >&5 +$as_echo "$as_me: error: cannot find install-sh or install.sh in ${srcdir}/gmp \"$srcdir\"/${srcdir}/gmp" >&2;} { (exit 1); exit 1; }; } fi @@ -1861,8 +1991,8 @@ ac_configure="$SHELL $ac_aux_dir/configure" # Please don't use this var. if test -f configure; then - { { echo "$as_me:$LINENO: error: This program cannot be built within the source directory" >&5 -echo "$as_me: error: This program cannot be built within the source directory" >&2;} + { { $as_echo "$as_me:$LINENO: error: This program cannot be built within the source directory" >&5 +$as_echo "$as_me: error: This program cannot be built within the source directory" >&2;} { (exit 1); exit 1; }; } fi @@ -1919,8 +2049,8 @@ fi # Check whether --with-system-boehm was given. if test "${with_system_boehm+set}" = set; then - withval=$with_system_boehm; { echo "$as_me:$LINENO: WARNING: --with-system-boehm is deprecated, use --enable-boehm=system instead!" >&5 -echo "$as_me: WARNING: --with-system-boehm is deprecated, use --enable-boehm=system instead!" >&2;} + withval=$with_system_boehm; { $as_echo "$as_me:$LINENO: WARNING: --with-system-boehm is deprecated, use --enable-boehm=system instead!" >&5 +$as_echo "$as_me: WARNING: --with-system-boehm is deprecated, use --enable-boehm=system instead!" >&2;} test ${withval} = "no" || enable_boehm="system" fi @@ -1966,8 +2096,8 @@ fi # Check whether --enable-local-gmp was given. if test "${enable_local_gmp+set}" = set; then - enableval=$enable_local_gmp; { echo "$as_me:$LINENO: WARNING: --with-local-gmp is deprecated, use --with-system-gmp instead!" >&5 -echo "$as_me: WARNING: --with-local-gmp is deprecated, use --with-system-gmp instead!" >&2;} + enableval=$enable_local_gmp; { $as_echo "$as_me:$LINENO: WARNING: --with-local-gmp is deprecated, use --with-system-gmp instead!" >&5 +$as_echo "$as_me: WARNING: --with-local-gmp is deprecated, use --with-system-gmp instead!" >&2;} with_system_gmp="${enableval}" fi @@ -2180,34 +2310,34 @@ SUBDIRS=c # Make sure we can run config.sub. $SHELL "$ac_aux_dir/config.sub" sun4 >/dev/null 2>&1 || - { { echo "$as_me:$LINENO: error: cannot run $SHELL $ac_aux_dir/config.sub" >&5 -echo "$as_me: error: cannot run $SHELL $ac_aux_dir/config.sub" >&2;} + { { $as_echo "$as_me:$LINENO: error: cannot run $SHELL $ac_aux_dir/config.sub" >&5 +$as_echo "$as_me: error: cannot run $SHELL $ac_aux_dir/config.sub" >&2;} { (exit 1); exit 1; }; } -{ echo "$as_me:$LINENO: checking build system type" >&5 -echo $ECHO_N "checking build system type... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking build system type" >&5 +$as_echo_n "checking build system type... " >&6; } if test "${ac_cv_build+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else ac_build_alias=$build_alias test "x$ac_build_alias" = x && ac_build_alias=`$SHELL "$ac_aux_dir/config.guess"` test "x$ac_build_alias" = x && - { { echo "$as_me:$LINENO: error: cannot guess build type; you must specify one" >&5 -echo "$as_me: error: cannot guess build type; you must specify one" >&2;} + { { $as_echo "$as_me:$LINENO: error: cannot guess build type; you must specify one" >&5 +$as_echo "$as_me: error: cannot guess build type; you must specify one" >&2;} { (exit 1); exit 1; }; } ac_cv_build=`$SHELL "$ac_aux_dir/config.sub" $ac_build_alias` || - { { echo "$as_me:$LINENO: error: $SHELL $ac_aux_dir/config.sub $ac_build_alias failed" >&5 -echo "$as_me: error: $SHELL $ac_aux_dir/config.sub $ac_build_alias failed" >&2;} + { { $as_echo "$as_me:$LINENO: error: $SHELL $ac_aux_dir/config.sub $ac_build_alias failed" >&5 +$as_echo "$as_me: error: $SHELL $ac_aux_dir/config.sub $ac_build_alias failed" >&2;} { (exit 1); exit 1; }; } fi -{ echo "$as_me:$LINENO: result: $ac_cv_build" >&5 -echo "${ECHO_T}$ac_cv_build" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_build" >&5 +$as_echo "$ac_cv_build" >&6; } case $ac_cv_build in *-*-*) ;; -*) { { echo "$as_me:$LINENO: error: invalid value of canonical build" >&5 -echo "$as_me: error: invalid value of canonical build" >&2;} +*) { { $as_echo "$as_me:$LINENO: error: invalid value of canonical build" >&5 +$as_echo "$as_me: error: invalid value of canonical build" >&2;} { (exit 1); exit 1; }; };; esac build=$ac_cv_build @@ -2224,27 +2354,27 @@ IFS=$ac_save_IFS case $build_os in *\ *) build_os=`echo "$build_os" | sed 's/ /-/g'`;; esac -{ echo "$as_me:$LINENO: checking host system type" >&5 -echo $ECHO_N "checking host system type... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking host system type" >&5 +$as_echo_n "checking host system type... " >&6; } if test "${ac_cv_host+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else if test "x$host_alias" = x; then ac_cv_host=$ac_cv_build else ac_cv_host=`$SHELL "$ac_aux_dir/config.sub" $host_alias` || - { { echo "$as_me:$LINENO: error: $SHELL $ac_aux_dir/config.sub $host_alias failed" >&5 -echo "$as_me: error: $SHELL $ac_aux_dir/config.sub $host_alias failed" >&2;} + { { $as_echo "$as_me:$LINENO: error: $SHELL $ac_aux_dir/config.sub $host_alias failed" >&5 +$as_echo "$as_me: error: $SHELL $ac_aux_dir/config.sub $host_alias failed" >&2;} { (exit 1); exit 1; }; } fi fi -{ echo "$as_me:$LINENO: result: $ac_cv_host" >&5 -echo "${ECHO_T}$ac_cv_host" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_host" >&5 +$as_echo "$ac_cv_host" >&6; } case $ac_cv_host in *-*-*) ;; -*) { { echo "$as_me:$LINENO: error: invalid value of canonical host" >&5 -echo "$as_me: error: invalid value of canonical host" >&2;} +*) { { $as_echo "$as_me:$LINENO: error: invalid value of canonical host" >&5 +$as_echo "$as_me: error: invalid value of canonical host" >&2;} { (exit 1); exit 1; }; };; esac host=$ac_cv_host @@ -2271,10 +2401,10 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. set dummy ${ac_tool_prefix}gcc; ac_word=$2 -{ echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } if test "${ac_cv_prog_CC+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -2287,7 +2417,7 @@ do for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="${ac_tool_prefix}gcc" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done @@ -2298,11 +2428,11 @@ fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then - { echo "$as_me:$LINENO: result: $CC" >&5 -echo "${ECHO_T}$CC" >&6; } + { $as_echo "$as_me:$LINENO: result: $CC" >&5 +$as_echo "$CC" >&6; } else - { echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6; } + { $as_echo "$as_me:$LINENO: result: no" >&5 +$as_echo "no" >&6; } fi @@ -2311,10 +2441,10 @@ if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 -{ echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } if test "${ac_cv_prog_ac_ct_CC+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. @@ -2327,7 +2457,7 @@ do for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_CC="gcc" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done @@ -2338,11 +2468,11 @@ fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then - { echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 -echo "${ECHO_T}$ac_ct_CC" >&6; } + { $as_echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } else - { echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6; } + { $as_echo "$as_me:$LINENO: result: no" >&5 +$as_echo "no" >&6; } fi if test "x$ac_ct_CC" = x; then @@ -2350,12 +2480,8 @@ fi else case $cross_compiling:$ac_tool_warned in yes:) -{ echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools -whose name does not start with the host triplet. If you think this -configuration is useful to you, please write to autoconf@gnu.org." >&5 -echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools -whose name does not start with the host triplet. If you think this -configuration is useful to you, please write to autoconf@gnu.org." >&2;} +{ $as_echo "$as_me:$LINENO: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC @@ -2368,10 +2494,10 @@ if test -z "$CC"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. set dummy ${ac_tool_prefix}cc; ac_word=$2 -{ echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } if test "${ac_cv_prog_CC+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -2384,7 +2510,7 @@ do for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="${ac_tool_prefix}cc" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done @@ -2395,11 +2521,11 @@ fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then - { echo "$as_me:$LINENO: result: $CC" >&5 -echo "${ECHO_T}$CC" >&6; } + { $as_echo "$as_me:$LINENO: result: $CC" >&5 +$as_echo "$CC" >&6; } else - { echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6; } + { $as_echo "$as_me:$LINENO: result: no" >&5 +$as_echo "no" >&6; } fi @@ -2408,10 +2534,10 @@ fi if test -z "$CC"; then # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 -{ echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } if test "${ac_cv_prog_CC+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -2429,7 +2555,7 @@ do continue fi ac_cv_prog_CC="cc" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done @@ -2452,11 +2578,11 @@ fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then - { echo "$as_me:$LINENO: result: $CC" >&5 -echo "${ECHO_T}$CC" >&6; } + { $as_echo "$as_me:$LINENO: result: $CC" >&5 +$as_echo "$CC" >&6; } else - { echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6; } + { $as_echo "$as_me:$LINENO: result: no" >&5 +$as_echo "no" >&6; } fi @@ -2467,10 +2593,10 @@ if test -z "$CC"; then do # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. set dummy $ac_tool_prefix$ac_prog; ac_word=$2 -{ echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } if test "${ac_cv_prog_CC+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -2483,7 +2609,7 @@ do for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="$ac_tool_prefix$ac_prog" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done @@ -2494,11 +2620,11 @@ fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then - { echo "$as_me:$LINENO: result: $CC" >&5 -echo "${ECHO_T}$CC" >&6; } + { $as_echo "$as_me:$LINENO: result: $CC" >&5 +$as_echo "$CC" >&6; } else - { echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6; } + { $as_echo "$as_me:$LINENO: result: no" >&5 +$as_echo "no" >&6; } fi @@ -2511,10 +2637,10 @@ if test -z "$CC"; then do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 -{ echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } if test "${ac_cv_prog_ac_ct_CC+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. @@ -2527,7 +2653,7 @@ do for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_CC="$ac_prog" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done @@ -2538,11 +2664,11 @@ fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then - { echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 -echo "${ECHO_T}$ac_ct_CC" >&6; } + { $as_echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } else - { echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6; } + { $as_echo "$as_me:$LINENO: result: no" >&5 +$as_echo "no" >&6; } fi @@ -2554,12 +2680,8 @@ done else case $cross_compiling:$ac_tool_warned in yes:) -{ echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools -whose name does not start with the host triplet. If you think this -configuration is useful to you, please write to autoconf@gnu.org." >&5 -echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools -whose name does not start with the host triplet. If you think this -configuration is useful to you, please write to autoconf@gnu.org." >&2;} +{ $as_echo "$as_me:$LINENO: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC @@ -2569,44 +2691,50 @@ fi fi -test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH +test -z "$CC" && { { $as_echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +{ { $as_echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&5 -echo "$as_me: error: no acceptable C compiler found in \$PATH +$as_echo "$as_me: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&2;} - { (exit 1); exit 1; }; } + { (exit 1); exit 1; }; }; } # Provide some information about the compiler. -echo "$as_me:$LINENO: checking for C compiler version" >&5 -ac_compiler=`set X $ac_compile; echo $2` +$as_echo "$as_me:$LINENO: checking for C compiler version" >&5 +set X $ac_compile +ac_compiler=$2 { (ac_try="$ac_compiler --version >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compiler --version >&5") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (ac_try="$ac_compiler -v >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compiler -v >&5") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (ac_try="$ac_compiler -V >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compiler -V >&5") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } cat >conftest.$ac_ext <<_ACEOF @@ -2625,27 +2753,22 @@ main () } _ACEOF ac_clean_files_save=$ac_clean_files -ac_clean_files="$ac_clean_files a.out a.exe b.out" +ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out" # Try to create an executable without -o first, disregard a.out. # It will help us diagnose broken compilers, and finding out an intuition # of exeext. -{ echo "$as_me:$LINENO: checking for C compiler default output file name" >&5 -echo $ECHO_N "checking for C compiler default output file name... $ECHO_C" >&6; } -ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` -# -# List of possible output files, starting from the most likely. -# The algorithm is not robust to junk in `.', hence go to wildcards (a.*) -# only as a last resort. b.out is created by i960 compilers. -ac_files='a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out' -# -# The IRIX 6 linker writes into existing files which may not be -# executable, retaining their permissions. Remove them first so a -# subsequent execution test works. +{ $as_echo "$as_me:$LINENO: checking for C compiler default output file name" >&5 +$as_echo_n "checking for C compiler default output file name... " >&6; } +ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` + +# The possible output files: +ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*" + ac_rmfiles= for ac_file in $ac_files do case $ac_file in - *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;; + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; * ) ac_rmfiles="$ac_rmfiles $ac_file";; esac done @@ -2656,10 +2779,11 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link_default") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. # So ignore a value of `no', otherwise this would lead to `EXEEXT = no' @@ -2670,7 +2794,7 @@ for ac_file in $ac_files '' do test -f "$ac_file" || continue case $ac_file in - *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; [ab].out ) # We found the default executable, but exeext='' is most @@ -2697,25 +2821,27 @@ else ac_file='' fi -{ echo "$as_me:$LINENO: result: $ac_file" >&5 -echo "${ECHO_T}$ac_file" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_file" >&5 +$as_echo "$ac_file" >&6; } if test -z "$ac_file"; then - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 -{ { echo "$as_me:$LINENO: error: C compiler cannot create executables +{ { $as_echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +{ { $as_echo "$as_me:$LINENO: error: C compiler cannot create executables See \`config.log' for more details." >&5 -echo "$as_me: error: C compiler cannot create executables +$as_echo "$as_me: error: C compiler cannot create executables See \`config.log' for more details." >&2;} - { (exit 77); exit 77; }; } + { (exit 77); exit 77; }; }; } fi ac_exeext=$ac_cv_exeext # Check that the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. -{ echo "$as_me:$LINENO: checking whether the C compiler works" >&5 -echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking whether the C compiler works" >&5 +$as_echo_n "checking whether the C compiler works... " >&6; } # FIXME: These cross compiler hacks should be removed for Autoconf 3.0 # If not cross compiling, check that we can run a simple program. if test "$cross_compiling" != yes; then @@ -2724,49 +2850,53 @@ if test "$cross_compiling" != yes; then *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_try") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then cross_compiling=no else if test "$cross_compiling" = maybe; then cross_compiling=yes else - { { echo "$as_me:$LINENO: error: cannot run C compiled programs. + { { $as_echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +{ { $as_echo "$as_me:$LINENO: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&5 -echo "$as_me: error: cannot run C compiled programs. +$as_echo "$as_me: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&2;} - { (exit 1); exit 1; }; } + { (exit 1); exit 1; }; }; } fi fi fi -{ echo "$as_me:$LINENO: result: yes" >&5 -echo "${ECHO_T}yes" >&6; } +{ $as_echo "$as_me:$LINENO: result: yes" >&5 +$as_echo "yes" >&6; } -rm -f a.out a.exe conftest$ac_cv_exeext b.out +rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out ac_clean_files=$ac_clean_files_save # Check that the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. -{ echo "$as_me:$LINENO: checking whether we are cross compiling" >&5 -echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6; } -{ echo "$as_me:$LINENO: result: $cross_compiling" >&5 -echo "${ECHO_T}$cross_compiling" >&6; } +{ $as_echo "$as_me:$LINENO: checking whether we are cross compiling" >&5 +$as_echo_n "checking whether we are cross compiling... " >&6; } +{ $as_echo "$as_me:$LINENO: result: $cross_compiling" >&5 +$as_echo "$cross_compiling" >&6; } -{ echo "$as_me:$LINENO: checking for suffix of executables" >&5 -echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for suffix of executables" >&5 +$as_echo_n "checking for suffix of executables... " >&6; } if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # If both `conftest.exe' and `conftest' are `present' (well, observable) # catch `conftest.exe'. For instance with Cygwin, `ls conftest' will @@ -2775,31 +2905,33 @@ eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 for ac_file in conftest.exe conftest conftest.*; do test -f "$ac_file" || continue case $ac_file in - *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;; + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` break;; * ) break;; esac done else - { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link + { { $as_echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +{ { $as_echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&5 -echo "$as_me: error: cannot compute suffix of executables: cannot compile and link +$as_echo "$as_me: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&2;} - { (exit 1); exit 1; }; } + { (exit 1); exit 1; }; }; } fi rm -f conftest$ac_cv_exeext -{ echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5 -echo "${ECHO_T}$ac_cv_exeext" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5 +$as_echo "$ac_cv_exeext" >&6; } rm -f conftest.$ac_ext EXEEXT=$ac_cv_exeext ac_exeext=$EXEEXT -{ echo "$as_me:$LINENO: checking for suffix of object files" >&5 -echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for suffix of object files" >&5 +$as_echo_n "checking for suffix of object files... " >&6; } if test "${ac_cv_objext+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ @@ -2822,40 +2954,43 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then for ac_file in conftest.o conftest.obj conftest.*; do test -f "$ac_file" || continue; case $ac_file in - *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf ) ;; + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;; *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` break;; esac done else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 -{ { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile +{ { $as_echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +{ { $as_echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&5 -echo "$as_me: error: cannot compute suffix of object files: cannot compile +$as_echo "$as_me: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&2;} - { (exit 1); exit 1; }; } + { (exit 1); exit 1; }; }; } fi rm -f conftest.$ac_cv_objext conftest.$ac_ext fi -{ echo "$as_me:$LINENO: result: $ac_cv_objext" >&5 -echo "${ECHO_T}$ac_cv_objext" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_objext" >&5 +$as_echo "$ac_cv_objext" >&6; } OBJEXT=$ac_cv_objext ac_objext=$OBJEXT -{ echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5 -echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5 +$as_echo_n "checking whether we are using the GNU C compiler... " >&6; } if test "${ac_cv_c_compiler_gnu+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ @@ -2881,20 +3016,21 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ac_compiler_gnu=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_compiler_gnu=no @@ -2904,15 +3040,19 @@ rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ac_cv_c_compiler_gnu=$ac_compiler_gnu fi -{ echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5 -echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6; } -GCC=`test $ac_compiler_gnu = yes && echo yes` +{ $as_echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5 +$as_echo "$ac_cv_c_compiler_gnu" >&6; } +if test $ac_compiler_gnu = yes; then + GCC=yes +else + GCC= +fi ac_test_CFLAGS=${CFLAGS+set} ac_save_CFLAGS=$CFLAGS -{ echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5 -echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5 +$as_echo_n "checking whether $CC accepts -g... " >&6; } if test "${ac_cv_prog_cc_g+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else ac_save_c_werror_flag=$ac_c_werror_flag ac_c_werror_flag=yes @@ -2939,20 +3079,21 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ac_cv_prog_cc_g=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 CFLAGS="" @@ -2977,20 +3118,21 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then : else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_c_werror_flag=$ac_save_c_werror_flag @@ -3016,20 +3158,21 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ac_cv_prog_cc_g=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 @@ -3044,8 +3187,8 @@ fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ac_c_werror_flag=$ac_save_c_werror_flag fi -{ echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5 -echo "${ECHO_T}$ac_cv_prog_cc_g" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5 +$as_echo "$ac_cv_prog_cc_g" >&6; } if test "$ac_test_CFLAGS" = set; then CFLAGS=$ac_save_CFLAGS elif test $ac_cv_prog_cc_g = yes; then @@ -3061,10 +3204,10 @@ else CFLAGS= fi fi -{ echo "$as_me:$LINENO: checking for $CC option to accept ISO C89" >&5 -echo $ECHO_N "checking for $CC option to accept ISO C89... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for $CC option to accept ISO C89" >&5 +$as_echo_n "checking for $CC option to accept ISO C89... " >&6; } if test "${ac_cv_prog_cc_c89+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else ac_cv_prog_cc_c89=no ac_save_CC=$CC @@ -3135,20 +3278,21 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ac_cv_prog_cc_c89=$ac_arg else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 @@ -3164,15 +3308,15 @@ fi # AC_CACHE_VAL case "x$ac_cv_prog_cc_c89" in x) - { echo "$as_me:$LINENO: result: none needed" >&5 -echo "${ECHO_T}none needed" >&6; } ;; + { $as_echo "$as_me:$LINENO: result: none needed" >&5 +$as_echo "none needed" >&6; } ;; xno) - { echo "$as_me:$LINENO: result: unsupported" >&5 -echo "${ECHO_T}unsupported" >&6; } ;; + { $as_echo "$as_me:$LINENO: result: unsupported" >&5 +$as_echo "unsupported" >&6; } ;; *) CC="$CC $ac_cv_prog_cc_c89" - { echo "$as_me:$LINENO: result: $ac_cv_prog_cc_c89" >&5 -echo "${ECHO_T}$ac_cv_prog_cc_c89" >&6; } ;; + { $as_echo "$as_me:$LINENO: result: $ac_cv_prog_cc_c89" >&5 +$as_echo "$ac_cv_prog_cc_c89" >&6; } ;; esac @@ -3196,10 +3340,10 @@ if test -z "$CXX"; then do # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. set dummy $ac_tool_prefix$ac_prog; ac_word=$2 -{ echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } if test "${ac_cv_prog_CXX+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else if test -n "$CXX"; then ac_cv_prog_CXX="$CXX" # Let the user override the test. @@ -3212,7 +3356,7 @@ do for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CXX="$ac_tool_prefix$ac_prog" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done @@ -3223,11 +3367,11 @@ fi fi CXX=$ac_cv_prog_CXX if test -n "$CXX"; then - { echo "$as_me:$LINENO: result: $CXX" >&5 -echo "${ECHO_T}$CXX" >&6; } + { $as_echo "$as_me:$LINENO: result: $CXX" >&5 +$as_echo "$CXX" >&6; } else - { echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6; } + { $as_echo "$as_me:$LINENO: result: no" >&5 +$as_echo "no" >&6; } fi @@ -3240,10 +3384,10 @@ if test -z "$CXX"; then do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 -{ echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } if test "${ac_cv_prog_ac_ct_CXX+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_CXX"; then ac_cv_prog_ac_ct_CXX="$ac_ct_CXX" # Let the user override the test. @@ -3256,7 +3400,7 @@ do for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_CXX="$ac_prog" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done @@ -3267,11 +3411,11 @@ fi fi ac_ct_CXX=$ac_cv_prog_ac_ct_CXX if test -n "$ac_ct_CXX"; then - { echo "$as_me:$LINENO: result: $ac_ct_CXX" >&5 -echo "${ECHO_T}$ac_ct_CXX" >&6; } + { $as_echo "$as_me:$LINENO: result: $ac_ct_CXX" >&5 +$as_echo "$ac_ct_CXX" >&6; } else - { echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6; } + { $as_echo "$as_me:$LINENO: result: no" >&5 +$as_echo "no" >&6; } fi @@ -3283,12 +3427,8 @@ done else case $cross_compiling:$ac_tool_warned in yes:) -{ echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools -whose name does not start with the host triplet. If you think this -configuration is useful to you, please write to autoconf@gnu.org." >&5 -echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools -whose name does not start with the host triplet. If you think this -configuration is useful to you, please write to autoconf@gnu.org." >&2;} +{ $as_echo "$as_me:$LINENO: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac CXX=$ac_ct_CXX @@ -3298,43 +3438,47 @@ fi fi fi # Provide some information about the compiler. -echo "$as_me:$LINENO: checking for C++ compiler version" >&5 -ac_compiler=`set X $ac_compile; echo $2` +$as_echo "$as_me:$LINENO: checking for C++ compiler version" >&5 +set X $ac_compile +ac_compiler=$2 { (ac_try="$ac_compiler --version >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compiler --version >&5") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (ac_try="$ac_compiler -v >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compiler -v >&5") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (ac_try="$ac_compiler -V >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compiler -V >&5") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } -{ echo "$as_me:$LINENO: checking whether we are using the GNU C++ compiler" >&5 -echo $ECHO_N "checking whether we are using the GNU C++ compiler... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking whether we are using the GNU C++ compiler" >&5 +$as_echo_n "checking whether we are using the GNU C++ compiler... " >&6; } if test "${ac_cv_cxx_compiler_gnu+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ @@ -3360,20 +3504,21 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_cxx_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ac_compiler_gnu=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_compiler_gnu=no @@ -3383,15 +3528,19 @@ rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ac_cv_cxx_compiler_gnu=$ac_compiler_gnu fi -{ echo "$as_me:$LINENO: result: $ac_cv_cxx_compiler_gnu" >&5 -echo "${ECHO_T}$ac_cv_cxx_compiler_gnu" >&6; } -GXX=`test $ac_compiler_gnu = yes && echo yes` +{ $as_echo "$as_me:$LINENO: result: $ac_cv_cxx_compiler_gnu" >&5 +$as_echo "$ac_cv_cxx_compiler_gnu" >&6; } +if test $ac_compiler_gnu = yes; then + GXX=yes +else + GXX= +fi ac_test_CXXFLAGS=${CXXFLAGS+set} ac_save_CXXFLAGS=$CXXFLAGS -{ echo "$as_me:$LINENO: checking whether $CXX accepts -g" >&5 -echo $ECHO_N "checking whether $CXX accepts -g... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking whether $CXX accepts -g" >&5 +$as_echo_n "checking whether $CXX accepts -g... " >&6; } if test "${ac_cv_prog_cxx_g+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else ac_save_cxx_werror_flag=$ac_cxx_werror_flag ac_cxx_werror_flag=yes @@ -3418,20 +3567,21 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_cxx_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ac_cv_prog_cxx_g=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 CXXFLAGS="" @@ -3456,20 +3606,21 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_cxx_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then : else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cxx_werror_flag=$ac_save_cxx_werror_flag @@ -3495,20 +3646,21 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_cxx_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ac_cv_prog_cxx_g=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 @@ -3523,8 +3675,8 @@ fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ac_cxx_werror_flag=$ac_save_cxx_werror_flag fi -{ echo "$as_me:$LINENO: result: $ac_cv_prog_cxx_g" >&5 -echo "${ECHO_T}$ac_cv_prog_cxx_g" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_prog_cxx_g" >&5 +$as_echo "$ac_cv_prog_cxx_g" >&6; } if test "$ac_test_CXXFLAGS" = set; then CXXFLAGS=$ac_save_CXXFLAGS elif test $ac_cv_prog_cxx_g = yes; then @@ -3551,15 +3703,15 @@ ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu -{ echo "$as_me:$LINENO: checking how to run the C preprocessor" >&5 -echo $ECHO_N "checking how to run the C preprocessor... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking how to run the C preprocessor" >&5 +$as_echo_n "checking how to run the C preprocessor... " >&6; } # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= fi if test -z "$CPP"; then if test "${ac_cv_prog_CPP+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else # Double quotes because CPP needs to be expanded for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" @@ -3591,20 +3743,21 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null && { test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || test ! -s conftest.err }; then : else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Broken: fails on valid input. @@ -3628,13 +3781,14 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null && { test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || test ! -s conftest.err @@ -3642,7 +3796,7 @@ eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 # Broken: success on invalid input. continue else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Passes both tests. @@ -3667,8 +3821,8 @@ fi else ac_cv_prog_CPP=$CPP fi -{ echo "$as_me:$LINENO: result: $CPP" >&5 -echo "${ECHO_T}$CPP" >&6; } +{ $as_echo "$as_me:$LINENO: result: $CPP" >&5 +$as_echo "$CPP" >&6; } ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do @@ -3696,20 +3850,21 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null && { test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || test ! -s conftest.err }; then : else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Broken: fails on valid input. @@ -3733,13 +3888,14 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null && { test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || test ! -s conftest.err @@ -3747,7 +3903,7 @@ eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 # Broken: success on invalid input. continue else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Passes both tests. @@ -3763,11 +3919,13 @@ rm -f conftest.err conftest.$ac_ext if $ac_preproc_ok; then : else - { { echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check + { { $as_echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +{ { $as_echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&5 -echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check +$as_echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&2;} - { (exit 1); exit 1; }; } + { (exit 1); exit 1; }; }; } fi ac_ext=c @@ -3779,10 +3937,10 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args. set dummy ${ac_tool_prefix}ranlib; ac_word=$2 -{ echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } if test "${ac_cv_prog_RANLIB+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else if test -n "$RANLIB"; then ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. @@ -3795,7 +3953,7 @@ do for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done @@ -3806,11 +3964,11 @@ fi fi RANLIB=$ac_cv_prog_RANLIB if test -n "$RANLIB"; then - { echo "$as_me:$LINENO: result: $RANLIB" >&5 -echo "${ECHO_T}$RANLIB" >&6; } + { $as_echo "$as_me:$LINENO: result: $RANLIB" >&5 +$as_echo "$RANLIB" >&6; } else - { echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6; } + { $as_echo "$as_me:$LINENO: result: no" >&5 +$as_echo "no" >&6; } fi @@ -3819,10 +3977,10 @@ if test -z "$ac_cv_prog_RANLIB"; then ac_ct_RANLIB=$RANLIB # Extract the first word of "ranlib", so it can be a program name with args. set dummy ranlib; ac_word=$2 -{ echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } if test "${ac_cv_prog_ac_ct_RANLIB+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_RANLIB"; then ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. @@ -3835,7 +3993,7 @@ do for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_RANLIB="ranlib" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done @@ -3846,11 +4004,11 @@ fi fi ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB if test -n "$ac_ct_RANLIB"; then - { echo "$as_me:$LINENO: result: $ac_ct_RANLIB" >&5 -echo "${ECHO_T}$ac_ct_RANLIB" >&6; } + { $as_echo "$as_me:$LINENO: result: $ac_ct_RANLIB" >&5 +$as_echo "$ac_ct_RANLIB" >&6; } else - { echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6; } + { $as_echo "$as_me:$LINENO: result: no" >&5 +$as_echo "no" >&6; } fi if test "x$ac_ct_RANLIB" = x; then @@ -3858,12 +4016,8 @@ fi else case $cross_compiling:$ac_tool_warned in yes:) -{ echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools -whose name does not start with the host triplet. If you think this -configuration is useful to you, please write to autoconf@gnu.org." >&5 -echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools -whose name does not start with the host triplet. If you think this -configuration is useful to you, please write to autoconf@gnu.org." >&2;} +{ $as_echo "$as_me:$LINENO: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac RANLIB=$ac_ct_RANLIB @@ -3885,11 +4039,12 @@ fi # SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" # OS/2's system install, which has a completely different semantic # ./install, which can be erroneously created by make from ./install.sh. -{ echo "$as_me:$LINENO: checking for a BSD-compatible install" >&5 -echo $ECHO_N "checking for a BSD-compatible install... $ECHO_C" >&6; } +# Reject install programs that cannot install multiple files. +{ $as_echo "$as_me:$LINENO: checking for a BSD-compatible install" >&5 +$as_echo_n "checking for a BSD-compatible install... " >&6; } if test -z "$INSTALL"; then if test "${ac_cv_path_install+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH @@ -3918,17 +4073,29 @@ case $as_dir/ in # program-specific install script used by HP pwplus--don't use. : else - ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c" - break 3 + rm -rf conftest.one conftest.two conftest.dir + echo one > conftest.one + echo two > conftest.two + mkdir conftest.dir + if "$as_dir/$ac_prog$ac_exec_ext" -c conftest.one conftest.two "`pwd`/conftest.dir" && + test -s conftest.one && test -s conftest.two && + test -s conftest.dir/conftest.one && + test -s conftest.dir/conftest.two + then + ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c" + break 3 + fi fi fi done done ;; esac + done IFS=$as_save_IFS +rm -rf conftest.one conftest.two conftest.dir fi if test "${ac_cv_path_install+set}" = set; then @@ -3941,8 +4108,8 @@ fi INSTALL=$ac_install_sh fi fi -{ echo "$as_me:$LINENO: result: $INSTALL" >&5 -echo "${ECHO_T}$INSTALL" >&6; } +{ $as_echo "$as_me:$LINENO: result: $INSTALL" >&5 +$as_echo "$INSTALL" >&6; } # Use test -z because SunOS4 sh mishandles braces in ${var-val}. # It thinks the first close brace ends the variable substitution. @@ -3952,22 +4119,23 @@ test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}' test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644' # sets variables INSTALL, INSTALL_DATA, INSTALL_PROGRAM -{ echo "$as_me:$LINENO: checking whether ln -s works" >&5 -echo $ECHO_N "checking whether ln -s works... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking whether ln -s works" >&5 +$as_echo_n "checking whether ln -s works... " >&6; } LN_S=$as_ln_s if test "$LN_S" = "ln -s"; then - { echo "$as_me:$LINENO: result: yes" >&5 -echo "${ECHO_T}yes" >&6; } + { $as_echo "$as_me:$LINENO: result: yes" >&5 +$as_echo "yes" >&6; } else - { echo "$as_me:$LINENO: result: no, using $LN_S" >&5 -echo "${ECHO_T}no, using $LN_S" >&6; } + { $as_echo "$as_me:$LINENO: result: no, using $LN_S" >&5 +$as_echo "no, using $LN_S" >&6; } fi # sets variable LN_S -{ echo "$as_me:$LINENO: checking whether ${MAKE-make} sets \$(MAKE)" >&5 -echo $ECHO_N "checking whether ${MAKE-make} sets \$(MAKE)... $ECHO_C" >&6; } -set x ${MAKE-make}; ac_make=`echo "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'` +{ $as_echo "$as_me:$LINENO: checking whether ${MAKE-make} sets \$(MAKE)" >&5 +$as_echo_n "checking whether ${MAKE-make} sets \$(MAKE)... " >&6; } +set x ${MAKE-make} +ac_make=`$as_echo "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'` if { as_var=ac_cv_prog_make_${ac_make}_set; eval "test \"\${$as_var+set}\" = set"; }; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else cat >conftest.make <<\_ACEOF SHELL = /bin/sh @@ -3984,20 +4152,20 @@ esac rm -f conftest.make fi if eval test \$ac_cv_prog_make_${ac_make}_set = yes; then - { echo "$as_me:$LINENO: result: yes" >&5 -echo "${ECHO_T}yes" >&6; } + { $as_echo "$as_me:$LINENO: result: yes" >&5 +$as_echo "yes" >&6; } SET_MAKE= else - { echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6; } + { $as_echo "$as_me:$LINENO: result: no" >&5 +$as_echo "no" >&6; } SET_MAKE="MAKE=${MAKE-make}" fi # set $(MAKE) if needed if test "${enable_slow_config}" = "yes"; then -{ echo "$as_me:$LINENO: checking Using the GMP library to guess good compiler/linker flags" >&5 -echo $ECHO_N "checking Using the GMP library to guess good compiler/linker flags... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking Using the GMP library to guess good compiler/linker flags" >&5 +$as_echo_n "checking Using the GMP library to guess good compiler/linker flags... " >&6; } (rm -rf tmp; \ mkdir tmp; \ aux=`cd ${srcdir}/gmp; pwd`; @@ -4012,14 +4180,14 @@ LDFLAGS=`grep '^s,@LDFLAGS@' config.status| sed 's&s,@LDFLAGS@,\(.*\),;t t&\1&'` LDFLAGS=`echo ${LDFLAGS} ${GMP_LDFLAGS} | sed 's%-Wc,%%'` CFLAGS="${CFLAGS} ${GMP_CFLAGS}" #host=`grep '^s,@host@' config.status | sed 's&s,@host@,\(.*\),;t t&\1&'` -{ echo "$as_me:$LINENO: checking C/C++ compiler flags" >&5 -echo $ECHO_N "checking C/C++ compiler flags... $ECHO_C" >&6; } -{ echo "$as_me:$LINENO: result: ${CFLAGS}" >&5 -echo "${ECHO_T}${CFLAGS}" >&6; } -{ echo "$as_me:$LINENO: checking Linker flags" >&5 -echo $ECHO_N "checking Linker flags... $ECHO_C" >&6; } -{ echo "$as_me:$LINENO: result: ${LDFLAGS}" >&5 -echo "${ECHO_T}${LDFLAGS}" >&6; } +{ $as_echo "$as_me:$LINENO: checking C/C++ compiler flags" >&5 +$as_echo_n "checking C/C++ compiler flags... " >&6; } +{ $as_echo "$as_me:$LINENO: result: ${CFLAGS}" >&5 +$as_echo "${CFLAGS}" >&6; } +{ $as_echo "$as_me:$LINENO: checking Linker flags" >&5 +$as_echo_n "checking Linker flags... " >&6; } +{ $as_echo "$as_me:$LINENO: result: ${LDFLAGS}" >&5 +$as_echo "${LDFLAGS}" >&6; } fi @@ -4094,27 +4262,27 @@ ECL_FILE_CNT=0 ECL_TO_RUN=`which ecl` EOF cat ${with_cross_config} - { { echo "$as_me:$LINENO: error: Configuration aborted" >&5 -echo "$as_me: error: Configuration aborted" >&2;} + { { $as_echo "$as_me:$LINENO: error: Configuration aborted" >&5 +$as_echo "$as_me: error: Configuration aborted" >&2;} { (exit 1); exit 1; }; } fi if test "${ECL_TO_RUN}" = "failed"; then - { { echo "$as_me:$LINENO: error: The program ECL is not installed in your system" >&5 -echo "$as_me: error: The program ECL is not installed in your system" >&2;} + { { $as_echo "$as_me:$LINENO: error: The program ECL is not installed in your system" >&5 +$as_echo "$as_me: error: The program ECL is not installed in your system" >&2;} { (exit 1); exit 1; }; } fi ECL_MIN_TO_RUN=`${ECL_TO_RUN} -eval '(progn (print (truename "sys:ecl_min")) (si:quit))' \ | grep '\#\P' | sed 's,#P"\(.*\)",\1,'` if test -z "${ECL_MIN_TO_RUN}" -o "${ECL_MIN_TO_RUN}" = "failed" ; then - { { echo "$as_me:$LINENO: error: The program ECL-MIN is not installed in your system" >&5 -echo "$as_me: error: The program ECL-MIN is not installed in your system" >&2;} + { { $as_echo "$as_me:$LINENO: error: The program ECL-MIN is not installed in your system" >&5 +$as_echo "$as_me: error: The program ECL-MIN is not installed in your system" >&2;} { (exit 1); exit 1; }; } fi DPP_TO_RUN=`${ECL_TO_RUN} -eval '(progn (print (truename "sys:dpp")) (si:quit))' \ | grep '\#\P' | sed 's,#P"\(.*\)",\1,'` if test -z "${DPP_TO_RUN}" -o "${DPP_TO_RUN}" = "failed" ; then - { { echo "$as_me:$LINENO: error: The program DPP is not installed in your system" >&5 -echo "$as_me: error: The program DPP is not installed in your system" >&2;} + { { $as_echo "$as_me:$LINENO: error: The program DPP is not installed in your system" >&5 +$as_echo "$as_me: error: The program DPP is not installed in your system" >&2;} { (exit 1); exit 1; }; } fi (echo '#!/bin/sh'; echo exec ${ECL_MIN_TO_RUN} '$''*') > CROSS-COMPILER @@ -4298,38 +4466,38 @@ case "${host_cpu}" in CFLAGS="${CFLAGS} -mieee";; esac ECL_CFLAGS="-D${thehost}" -{ echo "$as_me:$LINENO: checking for ld flags when building shared libraries" >&5 -echo $ECHO_N "checking for ld flags when building shared libraries... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for ld flags when building shared libraries" >&5 +$as_echo_n "checking for ld flags when building shared libraries... " >&6; } if test "${enable_shared}" = "yes"; then -{ echo "$as_me:$LINENO: result: ${SHARED_LDFLAGS}" >&5 -echo "${ECHO_T}${SHARED_LDFLAGS}" >&6; } +{ $as_echo "$as_me:$LINENO: result: ${SHARED_LDFLAGS}" >&5 +$as_echo "${SHARED_LDFLAGS}" >&6; } CFLAGS="${CFLAGS} ${PICFLAG}" else shared="no"; -{ echo "$as_me:$LINENO: result: cannot build" >&5 -echo "${ECHO_T}cannot build" >&6; } +{ $as_echo "$as_me:$LINENO: result: cannot build" >&5 +$as_echo "cannot build" >&6; } fi LIBS="${clibs} ${LIBS}" -{ echo "$as_me:$LINENO: checking for required libraries" >&5 -echo $ECHO_N "checking for required libraries... $ECHO_C" >&6; } -{ echo "$as_me:$LINENO: result: ${clibs}" >&5 -echo "${ECHO_T}${clibs}" >&6; } -{ echo "$as_me:$LINENO: checking for architecture" >&5 -echo $ECHO_N "checking for architecture... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for required libraries" >&5 +$as_echo_n "checking for required libraries... " >&6; } +{ $as_echo "$as_me:$LINENO: result: ${clibs}" >&5 +$as_echo "${clibs}" >&6; } +{ $as_echo "$as_me:$LINENO: checking for architecture" >&5 +$as_echo_n "checking for architecture... " >&6; } ARCHITECTURE=`echo "${host_cpu}" | tr a-z A-Z` # i386 -> I386 -{ echo "$as_me:$LINENO: result: ${ARCHITECTURE}" >&5 -echo "${ECHO_T}${ARCHITECTURE}" >&6; } -{ echo "$as_me:$LINENO: checking for software type" >&5 -echo $ECHO_N "checking for software type... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: result: ${ARCHITECTURE}" >&5 +$as_echo "${ARCHITECTURE}" >&6; } +{ $as_echo "$as_me:$LINENO: checking for software type" >&5 +$as_echo_n "checking for software type... " >&6; } SOFTWARE_TYPE="$thehost" SOFTWARE_VERSION="" -{ echo "$as_me:$LINENO: result: ${SOFTWARE_TYPE} / ${SOFTWARE_VERSION}" >&5 -echo "${ECHO_T}${SOFTWARE_TYPE} / ${SOFTWARE_VERSION}" >&6; } +{ $as_echo "$as_me:$LINENO: result: ${SOFTWARE_TYPE} / ${SOFTWARE_VERSION}" >&5 +$as_echo "${SOFTWARE_TYPE} / ${SOFTWARE_VERSION}" >&6; } -{ echo "$as_me:$LINENO: checking for __thread local data" >&5 -echo $ECHO_N "checking for __thread local data... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for __thread local data" >&5 +$as_echo_n "checking for __thread local data... " >&6; } if test "${ac_cv_ecl___thread+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else cat >conftest.$ac_ext <<_ACEOF @@ -4353,20 +4521,21 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ac_cv_ecl___thread=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_ecl___thread=no @@ -4374,8 +4543,8 @@ fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -{ echo "$as_me:$LINENO: result: $ac_cv_ecl___thread" >&5 -echo "${ECHO_T}$ac_cv_ecl___thread" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_ecl___thread" >&5 +$as_echo "$ac_cv_ecl___thread" >&6; } ac_cv_ecl___thread=no @@ -4383,10 +4552,10 @@ ac_cv_ecl___thread=no # Extract the first word of "install-info", so it can be a program name with args. set dummy install-info; ac_word=$2 -{ echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } if test "${ac_cv_path_INSTALL_INFO+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else case $INSTALL_INFO in [\\/]* | ?:[\\/]*) @@ -4402,7 +4571,7 @@ do for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_path_INSTALL_INFO="$as_dir/$ac_word$ac_exec_ext" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done @@ -4415,11 +4584,11 @@ esac fi INSTALL_INFO=$ac_cv_path_INSTALL_INFO if test -n "$INSTALL_INFO"; then - { echo "$as_me:$LINENO: result: $INSTALL_INFO" >&5 -echo "${ECHO_T}$INSTALL_INFO" >&6; } + { $as_echo "$as_me:$LINENO: result: $INSTALL_INFO" >&5 +$as_echo "$INSTALL_INFO" >&6; } else - { echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6; } + { $as_echo "$as_me:$LINENO: result: no" >&5 +$as_echo "no" >&6; } fi @@ -4432,10 +4601,10 @@ fi LIBS="${LIBS} -lm" -{ echo "$as_me:$LINENO: checking for getpwnam in -lsun" >&5 -echo $ECHO_N "checking for getpwnam in -lsun... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for getpwnam in -lsun" >&5 +$as_echo_n "checking for getpwnam in -lsun... " >&6; } if test "${ac_cv_lib_sun_getpwnam+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lsun $LIBS" @@ -4467,33 +4636,37 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err - } && test -s conftest$ac_exeext && - $as_test_x conftest$ac_exeext; then + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + $as_test_x conftest$ac_exeext + }; then ac_cv_lib_sun_getpwnam=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_sun_getpwnam=no fi +rm -rf conftest.dSYM rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi -{ echo "$as_me:$LINENO: result: $ac_cv_lib_sun_getpwnam" >&5 -echo "${ECHO_T}$ac_cv_lib_sun_getpwnam" >&6; } -if test $ac_cv_lib_sun_getpwnam = yes; then +{ $as_echo "$as_me:$LINENO: result: $ac_cv_lib_sun_getpwnam" >&5 +$as_echo "$ac_cv_lib_sun_getpwnam" >&6; } +if test "x$ac_cv_lib_sun_getpwnam" = x""yes; then cat >>confdefs.h <<_ACEOF #define HAVE_LIBSUN 1 _ACEOF @@ -4502,10 +4675,10 @@ _ACEOF fi # on IRIX adds -lsun -{ echo "$as_me:$LINENO: checking for library containing strerror" >&5 -echo $ECHO_N "checking for library containing strerror... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for library containing strerror" >&5 +$as_echo_n "checking for library containing strerror... " >&6; } if test "${ac_cv_search_strerror+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else ac_func_search_save_LIBS=$LIBS cat >conftest.$ac_ext <<_ACEOF @@ -4543,26 +4716,30 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err - } && test -s conftest$ac_exeext && - $as_test_x conftest$ac_exeext; then + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + $as_test_x conftest$ac_exeext + }; then ac_cv_search_strerror=$ac_res else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi +rm -rf conftest.dSYM rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext if test "${ac_cv_search_strerror+set}" = set; then @@ -4577,8 +4754,8 @@ fi rm conftest.$ac_ext LIBS=$ac_func_search_save_LIBS fi -{ echo "$as_me:$LINENO: result: $ac_cv_search_strerror" >&5 -echo "${ECHO_T}$ac_cv_search_strerror" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_search_strerror" >&5 +$as_echo "$ac_cv_search_strerror" >&6; } ac_res=$ac_cv_search_strerror if test "$ac_res" != no; then test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" @@ -4587,22 +4764,22 @@ fi if test "${enable_threads}" = "auto"; then - { echo "$as_me:$LINENO: checking for threads support" >&5 -echo $ECHO_N "checking for threads support... $ECHO_C" >&6; } + { $as_echo "$as_me:$LINENO: checking for threads support" >&5 +$as_echo_n "checking for threads support... " >&6; } if test -z "${THREAD_OBJ}"; then - { echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6; } + { $as_echo "$as_me:$LINENO: result: no" >&5 +$as_echo "no" >&6; } enable_threads="no" else - { echo "$as_me:$LINENO: result: yes" >&5 -echo "${ECHO_T}yes" >&6; } + { $as_echo "$as_me:$LINENO: result: yes" >&5 +$as_echo "yes" >&6; } enable_threads="yes" fi fi if test "${enable_threads}" = "yes" ; then if test -z "${THREAD_OBJ}"; then - { { echo "$as_me:$LINENO: error: Threads aren't supported on this system." >&5 -echo "$as_me: error: Threads aren't supported on this system." >&2;} + { { $as_echo "$as_me:$LINENO: error: Threads aren't supported on this system." >&5 +$as_echo "$as_me: error: Threads aren't supported on this system." >&2;} { (exit 1); exit 1; }; } else boehm_configure_flags="${boehm_configure_flags} ${THREAD_GC_FLAGS}" @@ -4627,8 +4804,8 @@ else fi if test ${enable_boehm} = "no" ; then - { { echo "$as_me:$LINENO: error: Boehm GC library is currently needed to build ECL" >&5 -echo "$as_me: error: Boehm GC library is currently needed to build ECL" >&2;} + { { $as_echo "$as_me:$LINENO: error: Boehm GC library is currently needed to build ECL" >&5 +$as_echo "$as_me: error: Boehm GC library is currently needed to build ECL" >&2;} { (exit 1); exit 1; }; }; fi if test ${enable_boehm} = "no" ; then @@ -4636,10 +4813,10 @@ if test ${enable_boehm} = "no" ; then enable_smallcons="no" else if test ${enable_boehm} = "auto"; then - { echo "$as_me:$LINENO: checking for GC_malloc in -lgc" >&5 -echo $ECHO_N "checking for GC_malloc in -lgc... $ECHO_C" >&6; } + { $as_echo "$as_me:$LINENO: checking for GC_malloc in -lgc" >&5 +$as_echo_n "checking for GC_malloc in -lgc... " >&6; } if test "${ac_cv_lib_gc_GC_malloc+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lgc $LIBS" @@ -4671,33 +4848,37 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err - } && test -s conftest$ac_exeext && - $as_test_x conftest$ac_exeext; then + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + $as_test_x conftest$ac_exeext + }; then ac_cv_lib_gc_GC_malloc=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_gc_GC_malloc=no fi +rm -rf conftest.dSYM rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi -{ echo "$as_me:$LINENO: result: $ac_cv_lib_gc_GC_malloc" >&5 -echo "${ECHO_T}$ac_cv_lib_gc_GC_malloc" >&6; } -if test $ac_cv_lib_gc_GC_malloc = yes; then +{ $as_echo "$as_me:$LINENO: result: $ac_cv_lib_gc_GC_malloc" >&5 +$as_echo "$ac_cv_lib_gc_GC_malloc" >&6; } +if test "x$ac_cv_lib_gc_GC_malloc" = x""yes; then enable_boehm="system" else enable_boehm="included" @@ -4706,10 +4887,10 @@ fi fi if test ${enable_boehm} = "system"; then - { echo "$as_me:$LINENO: checking for GC_malloc in -lgc" >&5 -echo $ECHO_N "checking for GC_malloc in -lgc... $ECHO_C" >&6; } + { $as_echo "$as_me:$LINENO: checking for GC_malloc in -lgc" >&5 +$as_echo_n "checking for GC_malloc in -lgc... " >&6; } if test "${ac_cv_lib_gc_GC_malloc+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lgc $LIBS" @@ -4741,42 +4922,46 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err - } && test -s conftest$ac_exeext && - $as_test_x conftest$ac_exeext; then + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + $as_test_x conftest$ac_exeext + }; then ac_cv_lib_gc_GC_malloc=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_gc_GC_malloc=no fi +rm -rf conftest.dSYM rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi -{ echo "$as_me:$LINENO: result: $ac_cv_lib_gc_GC_malloc" >&5 -echo "${ECHO_T}$ac_cv_lib_gc_GC_malloc" >&6; } -if test $ac_cv_lib_gc_GC_malloc = yes; then +{ $as_echo "$as_me:$LINENO: result: $ac_cv_lib_gc_GC_malloc" >&5 +$as_echo "$ac_cv_lib_gc_GC_malloc" >&6; } +if test "x$ac_cv_lib_gc_GC_malloc" = x""yes; then FASL_LIBS="${FASL_LIBS} -lgc" else - { { echo "$as_me:$LINENO: error: System Boehm GC library requested but not found." >&5 -echo "$as_me: error: System Boehm GC library requested but not found." >&2;} + { { $as_echo "$as_me:$LINENO: error: System Boehm GC library requested but not found." >&5 +$as_echo "$as_me: error: System Boehm GC library requested but not found." >&2;} { (exit 1); exit 1; }; } fi - { echo "$as_me:$LINENO: checking if we need to copy GC private headers " >&5 -echo $ECHO_N "checking if we need to copy GC private headers ... $ECHO_C" >&6; } + { $as_echo "$as_me:$LINENO: checking if we need to copy GC private headers " >&5 +$as_echo_n "checking if we need to copy GC private headers ... " >&6; } cat >>confdefs.h <<\_ACEOF #define GBC_BOEHM 1 @@ -4818,10 +5003,10 @@ if test "x${with_gmp}" != "xno"; then if test ${with_system_gmp} = "auto"; then - { echo "$as_me:$LINENO: checking for __gmpz_init in -lgmp" >&5 -echo $ECHO_N "checking for __gmpz_init in -lgmp... $ECHO_C" >&6; } + { $as_echo "$as_me:$LINENO: checking for __gmpz_init in -lgmp" >&5 +$as_echo_n "checking for __gmpz_init in -lgmp... " >&6; } if test "${ac_cv_lib_gmp___gmpz_init+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lgmp $LIBS" @@ -4853,33 +5038,37 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err - } && test -s conftest$ac_exeext && - $as_test_x conftest$ac_exeext; then + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + $as_test_x conftest$ac_exeext + }; then ac_cv_lib_gmp___gmpz_init=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_gmp___gmpz_init=no fi +rm -rf conftest.dSYM rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi -{ echo "$as_me:$LINENO: result: $ac_cv_lib_gmp___gmpz_init" >&5 -echo "${ECHO_T}$ac_cv_lib_gmp___gmpz_init" >&6; } -if test $ac_cv_lib_gmp___gmpz_init = yes; then +{ $as_echo "$as_me:$LINENO: result: $ac_cv_lib_gmp___gmpz_init" >&5 +$as_echo "$ac_cv_lib_gmp___gmpz_init" >&6; } +if test "x$ac_cv_lib_gmp___gmpz_init" = x""yes; then with_system_gmp=yes else with_system_gmp=no @@ -4888,10 +5077,10 @@ fi fi if test "${with_system_gmp}" = "yes"; then - { echo "$as_me:$LINENO: checking for __gmpz_init in -lgmp" >&5 -echo $ECHO_N "checking for __gmpz_init in -lgmp... $ECHO_C" >&6; } + { $as_echo "$as_me:$LINENO: checking for __gmpz_init in -lgmp" >&5 +$as_echo_n "checking for __gmpz_init in -lgmp... " >&6; } if test "${ac_cv_lib_gmp___gmpz_init+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lgmp $LIBS" @@ -4923,37 +5112,41 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err - } && test -s conftest$ac_exeext && - $as_test_x conftest$ac_exeext; then + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + $as_test_x conftest$ac_exeext + }; then ac_cv_lib_gmp___gmpz_init=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_gmp___gmpz_init=no fi +rm -rf conftest.dSYM rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi -{ echo "$as_me:$LINENO: result: $ac_cv_lib_gmp___gmpz_init" >&5 -echo "${ECHO_T}$ac_cv_lib_gmp___gmpz_init" >&6; } -if test $ac_cv_lib_gmp___gmpz_init = yes; then +{ $as_echo "$as_me:$LINENO: result: $ac_cv_lib_gmp___gmpz_init" >&5 +$as_echo "$ac_cv_lib_gmp___gmpz_init" >&6; } +if test "x$ac_cv_lib_gmp___gmpz_init" = x""yes; then FASL_LIBS="${FASL_LIBS} -lgmp" else - { { echo "$as_me:$LINENO: error: System gmp library requested but not found." >&5 -echo "$as_me: error: System gmp library requested but not found." >&2;} + { { $as_echo "$as_me:$LINENO: error: System gmp library requested but not found." >&5 +$as_echo "$as_me: error: System gmp library requested but not found." >&2;} { (exit 1); exit 1; }; } fi @@ -4966,8 +5159,8 @@ fi fi fi -{ echo "$as_me:$LINENO: checking for soname flags" >&5 -echo $ECHO_N "checking for soname flags... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for soname flags" >&5 +$as_echo_n "checking for soname flags... " >&6; } if test "${enable_soname}" != yes; then SONAME='' SONAME1='' @@ -4975,8 +5168,8 @@ if test "${enable_soname}" != yes; then SONAME3='' SONAME_ALIASES='' SONAME_LDFLAGS='' - { echo "$as_me:$LINENO: result: none" >&5 -echo "${ECHO_T}none" >&6; } + { $as_echo "$as_me:$LINENO: result: none" >&5 +$as_echo "none" >&6; } else PACKAGE_MAJOR=`echo ${PACKAGE_VERSION} | sed -e 's,\(.*\)\..*\..*,\1,g'` PACKAGE_MINOR=`echo ${PACKAGE_VERSION} | sed -e 's,.*\.\(.*\)\..*,\1,g'` @@ -4989,8 +5182,8 @@ else SONAME1=`echo $SONAME | sed "s,.SOVERSION,.$i,g"` SONAME=`echo $SONAME | sed "s,.SOVERSION,,g"` SONAME_LDFLAGS=`echo $SONAME_LDFLAGS | sed "s,SONAME,$SONAME2,g"` - { echo "$as_me:$LINENO: result: ${SONAME_LDFLAGS}" >&5 -echo "${ECHO_T}${SONAME_LDFLAGS}" >&6; } + { $as_echo "$as_me:$LINENO: result: ${SONAME_LDFLAGS}" >&5 +$as_echo "${SONAME_LDFLAGS}" >&6; } fi @@ -5013,8 +5206,8 @@ fi -{ echo "$as_me:$LINENO: checking for X" >&5 -echo $ECHO_N "checking for X... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for X" >&5 +$as_echo_n "checking for X... " >&6; } # Check whether --with-x was given. @@ -5028,11 +5221,11 @@ if test "x$with_x" = xno; then have_x=disabled else case $x_includes,$x_libraries in #( - *\'*) { { echo "$as_me:$LINENO: error: Cannot use X directory names containing '" >&5 -echo "$as_me: error: Cannot use X directory names containing '" >&2;} + *\'*) { { $as_echo "$as_me:$LINENO: error: cannot use X directory names containing '" >&5 +$as_echo "$as_me: error: cannot use X directory names containing '" >&2;} { (exit 1); exit 1; }; };; #( *,NONE | NONE,*) if test "${ac_cv_have_x+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else # One or both of the vars are not set, and there is no cached value. ac_x_includes=no ac_x_libraries=no @@ -5053,7 +5246,7 @@ _ACEOF eval "ac_im_$ac_var=\`\${MAKE-make} $ac_var 2>/dev/null | sed -n 's/^$ac_var=//p'\`" done # Open Windows xmkmf reportedly sets LIBDIR instead of USRLIBDIR. - for ac_extension in a so sl; do + for ac_extension in a so sl dylib la dll; do if test ! -f "$ac_im_usrlibdir/libX11.$ac_extension" && test -f "$ac_im_libdir/libX11.$ac_extension"; then ac_im_usrlibdir=$ac_im_libdir; break @@ -5067,7 +5260,7 @@ _ACEOF *) test -f "$ac_im_incroot/X11/Xos.h" && ac_x_includes=$ac_im_incroot;; esac case $ac_im_usrlibdir in - /usr/lib | /lib) ;; + /usr/lib | /usr/lib64 | /lib | /lib64) ;; *) test -d "$ac_im_usrlibdir" && ac_x_libraries=$ac_im_usrlibdir ;; esac fi @@ -5128,13 +5321,14 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null && { test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || test ! -s conftest.err @@ -5142,7 +5336,7 @@ eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 # We can compile using X headers with no special include directory. ac_x_includes= else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 for ac_dir in $ac_x_header_dirs; do @@ -5183,30 +5377,33 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err - } && test -s conftest$ac_exeext && - $as_test_x conftest$ac_exeext; then + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + $as_test_x conftest$ac_exeext + }; then LIBS=$ac_save_LIBS # We can link X programs with no special library path. ac_x_libraries= else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 LIBS=$ac_save_LIBS -for ac_dir in `echo "$ac_x_includes $ac_x_header_dirs" | sed s/include/lib/g` +for ac_dir in `$as_echo "$ac_x_includes $ac_x_header_dirs" | sed s/include/lib/g` do # Don't even attempt the hair of trying to link an X program! - for ac_extension in a so sl; do + for ac_extension in a so sl dylib la dll; do if test -r "$ac_dir/libX11.$ac_extension"; then ac_x_libraries=$ac_dir break 2 @@ -5215,6 +5412,7 @@ do done fi +rm -rf conftest.dSYM rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi # $ac_x_libraries = no @@ -5237,8 +5435,8 @@ fi fi # $with_x != no if test "$have_x" != yes; then - { echo "$as_me:$LINENO: result: $have_x" >&5 -echo "${ECHO_T}$have_x" >&6; } + { $as_echo "$as_me:$LINENO: result: $have_x" >&5 +$as_echo "$have_x" >&6; } no_x=yes else # If each of the values was on the command line, it overrides each guess. @@ -5248,8 +5446,8 @@ else ac_cv_have_x="have_x=yes\ ac_x_includes='$x_includes'\ ac_x_libraries='$x_libraries'" - { echo "$as_me:$LINENO: result: libraries $x_libraries, headers $x_includes" >&5 -echo "${ECHO_T}libraries $x_libraries, headers $x_includes" >&6; } + { $as_echo "$as_me:$LINENO: result: libraries $x_libraries, headers $x_includes" >&5 +$as_echo "libraries $x_libraries, headers $x_includes" >&6; } fi @@ -5259,11 +5457,11 @@ fi ac_header_dirent=no for ac_hdr in dirent.h sys/ndir.h sys/dir.h ndir.h; do - as_ac_Header=`echo "ac_cv_header_dirent_$ac_hdr" | $as_tr_sh` -{ echo "$as_me:$LINENO: checking for $ac_hdr that defines DIR" >&5 -echo $ECHO_N "checking for $ac_hdr that defines DIR... $ECHO_C" >&6; } + as_ac_Header=`$as_echo "ac_cv_header_dirent_$ac_hdr" | $as_tr_sh` +{ $as_echo "$as_me:$LINENO: checking for $ac_hdr that defines DIR" >&5 +$as_echo_n "checking for $ac_hdr that defines DIR... " >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ @@ -5289,20 +5487,21 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then eval "$as_ac_Header=yes" else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_Header=no" @@ -5310,12 +5509,15 @@ fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -ac_res=`eval echo '${'$as_ac_Header'}'` - { echo "$as_me:$LINENO: result: $ac_res" >&5 -echo "${ECHO_T}$ac_res" >&6; } -if test `eval echo '${'$as_ac_Header'}'` = yes; then +ac_res=`eval 'as_val=${'$as_ac_Header'} + $as_echo "$as_val"'` + { $as_echo "$as_me:$LINENO: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +as_val=`eval 'as_val=${'$as_ac_Header'} + $as_echo "$as_val"'` + if test "x$as_val" = x""yes; then cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_hdr" | $as_tr_cpp` 1 +#define `$as_echo "HAVE_$ac_hdr" | $as_tr_cpp` 1 _ACEOF ac_header_dirent=$ac_hdr; break @@ -5324,10 +5526,10 @@ fi done # Two versions of opendir et al. are in -ldir and -lx on SCO Xenix. if test $ac_header_dirent = dirent.h; then - { echo "$as_me:$LINENO: checking for library containing opendir" >&5 -echo $ECHO_N "checking for library containing opendir... $ECHO_C" >&6; } + { $as_echo "$as_me:$LINENO: checking for library containing opendir" >&5 +$as_echo_n "checking for library containing opendir... " >&6; } if test "${ac_cv_search_opendir+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else ac_func_search_save_LIBS=$LIBS cat >conftest.$ac_ext <<_ACEOF @@ -5365,26 +5567,30 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err - } && test -s conftest$ac_exeext && - $as_test_x conftest$ac_exeext; then + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + $as_test_x conftest$ac_exeext + }; then ac_cv_search_opendir=$ac_res else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi +rm -rf conftest.dSYM rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext if test "${ac_cv_search_opendir+set}" = set; then @@ -5399,8 +5605,8 @@ fi rm conftest.$ac_ext LIBS=$ac_func_search_save_LIBS fi -{ echo "$as_me:$LINENO: result: $ac_cv_search_opendir" >&5 -echo "${ECHO_T}$ac_cv_search_opendir" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_search_opendir" >&5 +$as_echo "$ac_cv_search_opendir" >&6; } ac_res=$ac_cv_search_opendir if test "$ac_res" != no; then test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" @@ -5408,10 +5614,10 @@ if test "$ac_res" != no; then fi else - { echo "$as_me:$LINENO: checking for library containing opendir" >&5 -echo $ECHO_N "checking for library containing opendir... $ECHO_C" >&6; } + { $as_echo "$as_me:$LINENO: checking for library containing opendir" >&5 +$as_echo_n "checking for library containing opendir... " >&6; } if test "${ac_cv_search_opendir+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else ac_func_search_save_LIBS=$LIBS cat >conftest.$ac_ext <<_ACEOF @@ -5449,26 +5655,30 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err - } && test -s conftest$ac_exeext && - $as_test_x conftest$ac_exeext; then + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + $as_test_x conftest$ac_exeext + }; then ac_cv_search_opendir=$ac_res else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi +rm -rf conftest.dSYM rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext if test "${ac_cv_search_opendir+set}" = set; then @@ -5483,8 +5693,8 @@ fi rm conftest.$ac_ext LIBS=$ac_func_search_save_LIBS fi -{ echo "$as_me:$LINENO: result: $ac_cv_search_opendir" >&5 -echo "${ECHO_T}$ac_cv_search_opendir" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_search_opendir" >&5 +$as_echo "$ac_cv_search_opendir" >&6; } ac_res=$ac_cv_search_opendir if test "$ac_res" != no; then test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" @@ -5493,42 +5703,37 @@ fi fi -{ echo "$as_me:$LINENO: checking for grep that handles long lines and -e" >&5 -echo $ECHO_N "checking for grep that handles long lines and -e... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for grep that handles long lines and -e" >&5 +$as_echo_n "checking for grep that handles long lines and -e... " >&6; } if test "${ac_cv_path_GREP+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - # Extract the first word of "grep ggrep" to use in msg output -if test -z "$GREP"; then -set dummy grep ggrep; ac_prog_name=$2 -if test "${ac_cv_path_GREP+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else + if test -z "$GREP"; then ac_path_GREP_found=false -# Loop through the user's path and test for each of PROGNAME-LIST -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_prog in grep ggrep; do - for ac_exec_ext in '' $ac_executable_extensions; do - ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext" - { test -f "$ac_path_GREP" && $as_test_x "$ac_path_GREP"; } || continue - # Check for GNU ac_path_GREP and select it if it is found. + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext" + { test -f "$ac_path_GREP" && $as_test_x "$ac_path_GREP"; } || continue +# Check for GNU ac_path_GREP and select it if it is found. # Check for GNU $ac_path_GREP case `"$ac_path_GREP" --version 2>&1` in *GNU*) ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; *) ac_count=0 - echo $ECHO_N "0123456789$ECHO_C" >"conftest.in" + $as_echo_n 0123456789 >"conftest.in" while : do cat "conftest.in" "conftest.in" >"conftest.tmp" mv "conftest.tmp" "conftest.in" cp "conftest.in" "conftest.nl" - echo 'GREP' >> "conftest.nl" + $as_echo 'GREP' >> "conftest.nl" "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break ac_count=`expr $ac_count + 1` @@ -5543,74 +5748,60 @@ case `"$ac_path_GREP" --version 2>&1` in rm -f conftest.in conftest.tmp conftest.nl conftest.out;; esac - - $ac_path_GREP_found && break 3 + $ac_path_GREP_found && break 3 + done done done - -done IFS=$as_save_IFS - - -fi - -GREP="$ac_cv_path_GREP" -if test -z "$GREP"; then - { { echo "$as_me:$LINENO: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&5 -echo "$as_me: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&2;} + if test -z "$ac_cv_path_GREP"; then + { { $as_echo "$as_me:$LINENO: error: no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&5 +$as_echo "$as_me: error: no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&2;} { (exit 1); exit 1; }; } -fi - + fi else ac_cv_path_GREP=$GREP fi - fi -{ echo "$as_me:$LINENO: result: $ac_cv_path_GREP" >&5 -echo "${ECHO_T}$ac_cv_path_GREP" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_path_GREP" >&5 +$as_echo "$ac_cv_path_GREP" >&6; } GREP="$ac_cv_path_GREP" -{ echo "$as_me:$LINENO: checking for egrep" >&5 -echo $ECHO_N "checking for egrep... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for egrep" >&5 +$as_echo_n "checking for egrep... " >&6; } if test "${ac_cv_path_EGREP+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 then ac_cv_path_EGREP="$GREP -E" else - # Extract the first word of "egrep" to use in msg output -if test -z "$EGREP"; then -set dummy egrep; ac_prog_name=$2 -if test "${ac_cv_path_EGREP+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else + if test -z "$EGREP"; then ac_path_EGREP_found=false -# Loop through the user's path and test for each of PROGNAME-LIST -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_prog in egrep; do - for ac_exec_ext in '' $ac_executable_extensions; do - ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext" - { test -f "$ac_path_EGREP" && $as_test_x "$ac_path_EGREP"; } || continue - # Check for GNU ac_path_EGREP and select it if it is found. + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext" + { test -f "$ac_path_EGREP" && $as_test_x "$ac_path_EGREP"; } || continue +# Check for GNU ac_path_EGREP and select it if it is found. # Check for GNU $ac_path_EGREP case `"$ac_path_EGREP" --version 2>&1` in *GNU*) ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; *) ac_count=0 - echo $ECHO_N "0123456789$ECHO_C" >"conftest.in" + $as_echo_n 0123456789 >"conftest.in" while : do cat "conftest.in" "conftest.in" >"conftest.tmp" mv "conftest.tmp" "conftest.in" cp "conftest.in" "conftest.nl" - echo 'EGREP' >> "conftest.nl" + $as_echo 'EGREP' >> "conftest.nl" "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break ac_count=`expr $ac_count + 1` @@ -5625,40 +5816,31 @@ case `"$ac_path_EGREP" --version 2>&1` in rm -f conftest.in conftest.tmp conftest.nl conftest.out;; esac - - $ac_path_EGREP_found && break 3 + $ac_path_EGREP_found && break 3 + done done done - -done IFS=$as_save_IFS - - -fi - -EGREP="$ac_cv_path_EGREP" -if test -z "$EGREP"; then - { { echo "$as_me:$LINENO: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&5 -echo "$as_me: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&2;} + if test -z "$ac_cv_path_EGREP"; then + { { $as_echo "$as_me:$LINENO: error: no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&5 +$as_echo "$as_me: error: no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&2;} { (exit 1); exit 1; }; } -fi - + fi else ac_cv_path_EGREP=$EGREP fi - fi fi -{ echo "$as_me:$LINENO: result: $ac_cv_path_EGREP" >&5 -echo "${ECHO_T}$ac_cv_path_EGREP" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_path_EGREP" >&5 +$as_echo "$ac_cv_path_EGREP" >&6; } EGREP="$ac_cv_path_EGREP" -{ echo "$as_me:$LINENO: checking for ANSI C header files" >&5 -echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for ANSI C header files" >&5 +$as_echo_n "checking for ANSI C header files... " >&6; } if test "${ac_cv_header_stdc+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ @@ -5685,20 +5867,21 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ac_cv_header_stdc=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_header_stdc=no @@ -5790,37 +5973,40 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_try") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: program exited with status $ac_status" >&5 +$as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_header_stdc=no fi +rm -rf conftest.dSYM rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi fi -{ echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5 -echo "${ECHO_T}$ac_cv_header_stdc" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5 +$as_echo "$ac_cv_header_stdc" >&6; } if test $ac_cv_header_stdc = yes; then cat >>confdefs.h <<\_ACEOF @@ -5842,11 +6028,11 @@ fi for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ inttypes.h stdint.h unistd.h do -as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` -{ echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } +as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +{ $as_echo "$as_me:$LINENO: checking for $ac_header" >&5 +$as_echo_n "checking for $ac_header... " >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ @@ -5864,20 +6050,21 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then eval "$as_ac_Header=yes" else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_Header=no" @@ -5885,12 +6072,15 @@ fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -ac_res=`eval echo '${'$as_ac_Header'}'` - { echo "$as_me:$LINENO: result: $ac_res" >&5 -echo "${ECHO_T}$ac_res" >&6; } -if test `eval echo '${'$as_ac_Header'}'` = yes; then +ac_res=`eval 'as_val=${'$as_ac_Header'} + $as_echo "$as_val"'` + { $as_echo "$as_me:$LINENO: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +as_val=`eval 'as_val=${'$as_ac_Header'} + $as_echo "$as_val"'` + if test "x$as_val" = x""yes; then cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi @@ -5898,10 +6088,10 @@ fi done -{ echo "$as_me:$LINENO: checking for stdbool.h that conforms to C99" >&5 -echo $ECHO_N "checking for stdbool.h that conforms to C99... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for stdbool.h that conforms to C99" >&5 +$as_echo_n "checking for stdbool.h that conforms to C99... " >&6; } if test "${ac_cv_header_stdbool_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ @@ -5942,6 +6132,8 @@ cat >>conftest.$ac_ext <<_ACEOF char h[sizeof (_Bool)]; char i[sizeof s.t]; enum { j = false, k = true, l = false * true, m = true * 256 }; + /* The following fails for + HP aC++/ANSI C B3910B A.05.55 [Dec 04 2003]. */ _Bool n[m]; char o[sizeof n == m * sizeof n[0] ? 1 : -1]; char p[-1 - (_Bool) 0 < 0 && -1 - (bool) 0 < 0 ? 1 : -1]; @@ -5991,20 +6183,21 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ac_cv_header_stdbool_h=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_header_stdbool_h=no @@ -6012,28 +6205,26 @@ fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -{ echo "$as_me:$LINENO: result: $ac_cv_header_stdbool_h" >&5 -echo "${ECHO_T}$ac_cv_header_stdbool_h" >&6; } -{ echo "$as_me:$LINENO: checking for _Bool" >&5 -echo $ECHO_N "checking for _Bool... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_header_stdbool_h" >&5 +$as_echo "$ac_cv_header_stdbool_h" >&6; } +{ $as_echo "$as_me:$LINENO: checking for _Bool" >&5 +$as_echo_n "checking for _Bool... " >&6; } if test "${ac_cv_type__Bool+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF + ac_cv_type__Bool=no +cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default -typedef _Bool ac__type_new_; int main () { -if ((ac__type_new_ *) 0) - return 0; -if (sizeof (ac__type_new_)) - return 0; +if (sizeof (_Bool)) + return 0; ; return 0; } @@ -6044,30 +6235,73 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then - ac_cv_type__Bool=yes + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +int +main () +{ +if (sizeof ((_Bool))) + return 0; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_compile") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + : else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - ac_cv_type__Bool=no + ac_cv_type__Bool=yes +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -{ echo "$as_me:$LINENO: result: $ac_cv_type__Bool" >&5 -echo "${ECHO_T}$ac_cv_type__Bool" >&6; } -if test $ac_cv_type__Bool = yes; then +{ $as_echo "$as_me:$LINENO: result: $ac_cv_type__Bool" >&5 +$as_echo "$ac_cv_type__Bool" >&6; } +if test "x$ac_cv_type__Bool" = x""yes; then cat >>confdefs.h <<_ACEOF #define HAVE__BOOL 1 @@ -6084,10 +6318,10 @@ _ACEOF fi -{ echo "$as_me:$LINENO: checking for ANSI C header files" >&5 -echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for ANSI C header files" >&5 +$as_echo_n "checking for ANSI C header files... " >&6; } if test "${ac_cv_header_stdc+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ @@ -6114,20 +6348,21 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ac_cv_header_stdc=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_header_stdc=no @@ -6219,37 +6454,40 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_try") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: program exited with status $ac_status" >&5 +$as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_header_stdc=no fi +rm -rf conftest.dSYM rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi fi -{ echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5 -echo "${ECHO_T}$ac_cv_header_stdc" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5 +$as_echo "$ac_cv_header_stdc" >&6; } if test $ac_cv_header_stdc = yes; then cat >>confdefs.h <<\_ACEOF @@ -6258,10 +6496,10 @@ _ACEOF fi -{ echo "$as_me:$LINENO: checking whether time.h and sys/time.h may both be included" >&5 -echo $ECHO_N "checking whether time.h and sys/time.h may both be included... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking whether time.h and sys/time.h may both be included" >&5 +$as_echo_n "checking whether time.h and sys/time.h may both be included... " >&6; } if test "${ac_cv_header_time+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ @@ -6288,20 +6526,21 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ac_cv_header_time=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_header_time=no @@ -6309,8 +6548,8 @@ fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -{ echo "$as_me:$LINENO: result: $ac_cv_header_time" >&5 -echo "${ECHO_T}$ac_cv_header_time" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_header_time" >&5 +$as_echo "$ac_cv_header_time" >&6; } if test $ac_cv_header_time = yes; then cat >>confdefs.h <<\_ACEOF @@ -6336,20 +6575,21 @@ for ac_header in fcntl.h inttypes.h limits.h netdb.h netinet/in.h \ stddef.h stdlib.h string.h sys/param.h \ sys/socket.h sys/time.h unistd.h fenv.h do -as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` +as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then - { echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } + { $as_echo "$as_me:$LINENO: checking for $ac_header" >&5 +$as_echo_n "checking for $ac_header... " >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 fi -ac_res=`eval echo '${'$as_ac_Header'}'` - { echo "$as_me:$LINENO: result: $ac_res" >&5 -echo "${ECHO_T}$ac_res" >&6; } +ac_res=`eval 'as_val=${'$as_ac_Header'} + $as_echo "$as_val"'` + { $as_echo "$as_me:$LINENO: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } else # Is the header compilable? -{ echo "$as_me:$LINENO: checking $ac_header usability" >&5 -echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking $ac_header usability" >&5 +$as_echo_n "checking $ac_header usability... " >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF @@ -6365,32 +6605,33 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ac_header_compiler=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -{ echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 -echo "${ECHO_T}$ac_header_compiler" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +$as_echo "$ac_header_compiler" >&6; } # Is the header present? -{ echo "$as_me:$LINENO: checking $ac_header presence" >&5 -echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking $ac_header presence" >&5 +$as_echo_n "checking $ac_header presence... " >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF @@ -6404,69 +6645,73 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null && { test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || test ! -s conftest.err }; then ac_header_preproc=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext -{ echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 -echo "${ECHO_T}$ac_header_preproc" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +$as_echo "$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) - { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 -echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 -echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 +$as_echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) - { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 -echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 -echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 -echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 -echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 -echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 -echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 +$as_echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 +$as_echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 +$as_echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 +$as_echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 +$as_echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 +$as_echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ;; esac -{ echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for $ac_header" >&5 +$as_echo_n "checking for $ac_header... " >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi -ac_res=`eval echo '${'$as_ac_Header'}'` - { echo "$as_me:$LINENO: result: $ac_res" >&5 -echo "${ECHO_T}$ac_res" >&6; } +ac_res=`eval 'as_val=${'$as_ac_Header'} + $as_echo "$as_val"'` + { $as_echo "$as_me:$LINENO: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } fi -if test `eval echo '${'$as_ac_Header'}'` = yes; then +as_val=`eval 'as_val=${'$as_ac_Header'} + $as_echo "$as_val"'` + if test "x$as_val" = x""yes; then cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi @@ -6485,23 +6730,26 @@ done + for ac_header in sys/resource.h sys/utsname.h float.h pwd.h dlfcn.h link.h \ - mach-o/dyld.h ulimit.h dirent.h sys/ioctl.h sys/select.h + mach-o/dyld.h ulimit.h dirent.h sys/ioctl.h sys/select.h \ + sys/wait.h do -as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` +as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then - { echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } + { $as_echo "$as_me:$LINENO: checking for $ac_header" >&5 +$as_echo_n "checking for $ac_header... " >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 fi -ac_res=`eval echo '${'$as_ac_Header'}'` - { echo "$as_me:$LINENO: result: $ac_res" >&5 -echo "${ECHO_T}$ac_res" >&6; } +ac_res=`eval 'as_val=${'$as_ac_Header'} + $as_echo "$as_val"'` + { $as_echo "$as_me:$LINENO: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } else # Is the header compilable? -{ echo "$as_me:$LINENO: checking $ac_header usability" >&5 -echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking $ac_header usability" >&5 +$as_echo_n "checking $ac_header usability... " >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF @@ -6517,32 +6765,33 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ac_header_compiler=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -{ echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 -echo "${ECHO_T}$ac_header_compiler" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +$as_echo "$ac_header_compiler" >&6; } # Is the header present? -{ echo "$as_me:$LINENO: checking $ac_header presence" >&5 -echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking $ac_header presence" >&5 +$as_echo_n "checking $ac_header presence... " >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF @@ -6556,69 +6805,73 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null && { test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || test ! -s conftest.err }; then ac_header_preproc=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext -{ echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 -echo "${ECHO_T}$ac_header_preproc" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +$as_echo "$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) - { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 -echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 -echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 +$as_echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) - { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 -echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 -echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 -echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 -echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 -echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 -echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 +$as_echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 +$as_echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 +$as_echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 +$as_echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 +$as_echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 +$as_echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ;; esac -{ echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for $ac_header" >&5 +$as_echo_n "checking for $ac_header... " >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi -ac_res=`eval echo '${'$as_ac_Header'}'` - { echo "$as_me:$LINENO: result: $ac_res" >&5 -echo "${ECHO_T}$ac_res" >&6; } +ac_res=`eval 'as_val=${'$as_ac_Header'} + $as_echo "$as_val"'` + { $as_echo "$as_me:$LINENO: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } fi -if test `eval echo '${'$as_ac_Header'}'` = yes; then +as_val=`eval 'as_val=${'$as_ac_Header'} + $as_echo "$as_val"'` + if test "x$as_val" = x""yes; then cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi @@ -6627,10 +6880,10 @@ done -{ echo "$as_me:$LINENO: checking for an ANSI C-conforming const" >&5 -echo $ECHO_N "checking for an ANSI C-conforming const... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for an ANSI C-conforming const" >&5 +$as_echo_n "checking for an ANSI C-conforming const... " >&6; } if test "${ac_cv_c_const+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ @@ -6702,20 +6955,21 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ac_cv_c_const=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_c_const=no @@ -6723,19 +6977,19 @@ fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -{ echo "$as_me:$LINENO: result: $ac_cv_c_const" >&5 -echo "${ECHO_T}$ac_cv_c_const" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_c_const" >&5 +$as_echo "$ac_cv_c_const" >&6; } if test $ac_cv_c_const = no; then cat >>confdefs.h <<\_ACEOF -#define const +#define const /**/ _ACEOF fi - { echo "$as_me:$LINENO: checking for inline" >&5 -echo $ECHO_N "checking for inline... $ECHO_C" >&6; } + { $as_echo "$as_me:$LINENO: checking for inline" >&5 +$as_echo_n "checking for inline... " >&6; } if test "${ac_cv_c_inline+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else ac_cv_c_inline=no for ac_kw in inline __inline__ __inline; do @@ -6758,20 +7012,21 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ac_cv_c_inline=$ac_kw else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 @@ -6782,8 +7037,8 @@ rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done fi -{ echo "$as_me:$LINENO: result: $ac_cv_c_inline" >&5 -echo "${ECHO_T}$ac_cv_c_inline" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_c_inline" >&5 +$as_echo "$ac_cv_c_inline" >&6; } case $ac_cv_c_inline in @@ -6801,26 +7056,24 @@ _ACEOF ;; esac -{ echo "$as_me:$LINENO: checking for size_t" >&5 -echo $ECHO_N "checking for size_t... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for size_t" >&5 +$as_echo_n "checking for size_t... " >&6; } if test "${ac_cv_type_size_t+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF + ac_cv_type_size_t=no +cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default -typedef size_t ac__type_new_; int main () { -if ((ac__type_new_ *) 0) - return 0; -if (sizeof (ac__type_new_)) - return 0; +if (sizeof (size_t)) + return 0; ; return 0; } @@ -6831,30 +7084,73 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then - ac_cv_type_size_t=yes + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +int +main () +{ +if (sizeof ((size_t))) + return 0; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_compile") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + : else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - ac_cv_type_size_t=no + ac_cv_type_size_t=yes +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -{ echo "$as_me:$LINENO: result: $ac_cv_type_size_t" >&5 -echo "${ECHO_T}$ac_cv_type_size_t" >&6; } -if test $ac_cv_type_size_t = yes; then +{ $as_echo "$as_me:$LINENO: result: $ac_cv_type_size_t" >&5 +$as_echo "$ac_cv_type_size_t" >&6; } +if test "x$ac_cv_type_size_t" = x""yes; then : else @@ -6863,10 +7159,10 @@ cat >>confdefs.h <<_ACEOF _ACEOF fi - { echo "$as_me:$LINENO: checking whether struct tm is in sys/time.h or time.h" >&5 -echo $ECHO_N "checking whether struct tm is in sys/time.h or time.h... $ECHO_C" >&6; } + { $as_echo "$as_me:$LINENO: checking whether struct tm is in sys/time.h or time.h" >&5 +$as_echo_n "checking whether struct tm is in sys/time.h or time.h... " >&6; } if test "${ac_cv_struct_tm+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ @@ -6882,7 +7178,7 @@ main () { struct tm tm; int *p = &tm.tm_sec; - return !p; + return !p; ; return 0; } @@ -6893,20 +7189,21 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ac_cv_struct_tm=time.h else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_struct_tm=sys/time.h @@ -6914,8 +7211,8 @@ fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -{ echo "$as_me:$LINENO: result: $ac_cv_struct_tm" >&5 -echo "${ECHO_T}$ac_cv_struct_tm" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_struct_tm" >&5 +$as_echo "$ac_cv_struct_tm" >&6; } if test $ac_cv_struct_tm = sys/time.h; then cat >>confdefs.h <<\_ACEOF @@ -6924,10 +7221,10 @@ _ACEOF fi -{ echo "$as_me:$LINENO: checking for working volatile" >&5 -echo $ECHO_N "checking for working volatile... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for working volatile" >&5 +$as_echo_n "checking for working volatile... " >&6; } if test "${ac_cv_c_volatile+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ @@ -6953,20 +7250,21 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ac_cv_c_volatile=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_c_volatile=no @@ -6974,36 +7272,34 @@ fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -{ echo "$as_me:$LINENO: result: $ac_cv_c_volatile" >&5 -echo "${ECHO_T}$ac_cv_c_volatile" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_c_volatile" >&5 +$as_echo "$ac_cv_c_volatile" >&6; } if test $ac_cv_c_volatile = no; then cat >>confdefs.h <<\_ACEOF -#define volatile +#define volatile /**/ _ACEOF fi -{ echo "$as_me:$LINENO: checking for ptrdiff_t" >&5 -echo $ECHO_N "checking for ptrdiff_t... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for ptrdiff_t" >&5 +$as_echo_n "checking for ptrdiff_t... " >&6; } if test "${ac_cv_type_ptrdiff_t+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF + ac_cv_type_ptrdiff_t=no +cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default -typedef ptrdiff_t ac__type_new_; int main () { -if ((ac__type_new_ *) 0) - return 0; -if (sizeof (ac__type_new_)) - return 0; +if (sizeof (ptrdiff_t)) + return 0; ; return 0; } @@ -7014,30 +7310,73 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then - ac_cv_type_ptrdiff_t=yes + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +int +main () +{ +if (sizeof ((ptrdiff_t))) + return 0; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_compile") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + : else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - ac_cv_type_ptrdiff_t=no + ac_cv_type_ptrdiff_t=yes +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -{ echo "$as_me:$LINENO: result: $ac_cv_type_ptrdiff_t" >&5 -echo "${ECHO_T}$ac_cv_type_ptrdiff_t" >&6; } -if test $ac_cv_type_ptrdiff_t = yes; then +{ $as_echo "$as_me:$LINENO: result: $ac_cv_type_ptrdiff_t" >&5 +$as_echo "$ac_cv_type_ptrdiff_t" >&6; } +if test "x$ac_cv_type_ptrdiff_t" = x""yes; then cat >>confdefs.h <<_ACEOF #define HAVE_PTRDIFF_T 1 @@ -7046,10 +7385,10 @@ _ACEOF fi -{ echo "$as_me:$LINENO: checking for long long int" >&5 -echo $ECHO_N "checking for long long int... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for long long int" >&5 +$as_echo_n "checking for long long int... " >&6; } if test "${ac_cv_c_long_long+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else if test "$GCC" = yes; then ac_cv_c_long_long=yes @@ -7075,20 +7414,21 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ac_cv_c_long_long=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_c_long_long=no @@ -7097,8 +7437,8 @@ fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi fi -{ echo "$as_me:$LINENO: result: $ac_cv_c_long_long" >&5 -echo "${ECHO_T}$ac_cv_c_long_long" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_c_long_long" >&5 +$as_echo "$ac_cv_c_long_long" >&6; } if test $ac_cv_c_long_long = yes; then cat >>confdefs.h <<\_ACEOF @@ -7109,28 +7449,78 @@ _ACEOF -{ echo "$as_me:$LINENO: checking whether byte ordering is bigendian" >&5 -echo $ECHO_N "checking whether byte ordering is bigendian... $ECHO_C" >&6; } + + { $as_echo "$as_me:$LINENO: checking whether byte ordering is bigendian" >&5 +$as_echo_n "checking whether byte ordering is bigendian... " >&6; } if test "${ac_cv_c_bigendian+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else - # See if sys/param.h defines the BYTE_ORDER macro. -cat >conftest.$ac_ext <<_ACEOF + ac_cv_c_bigendian=unknown + # See if we're dealing with a universal compiler. + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#ifndef __APPLE_CC__ + not a universal capable compiler + #endif + typedef int dummy; + +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_compile") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + + # Check for potential -arch flags. It is not universal unless + # there are some -arch flags. Note that *ppc* also matches + # ppc64. This check is also rather less than ideal. + case "${CC} ${CFLAGS} ${CPPFLAGS} ${LDFLAGS}" in #( + *-arch*ppc*|*-arch*i386*|*-arch*x86_64*) ac_cv_c_bigendian=universal;; + esac +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + if test $ac_cv_c_bigendian = unknown; then + # See if sys/param.h defines the BYTE_ORDER macro. + cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include -#include + #include int main () { -#if ! (defined BYTE_ORDER && defined BIG_ENDIAN && defined LITTLE_ENDIAN \ - && BYTE_ORDER && BIG_ENDIAN && LITTLE_ENDIAN) - bogus endian macros -#endif +#if ! (defined BYTE_ORDER && defined BIG_ENDIAN \ + && defined LITTLE_ENDIAN && BYTE_ORDER && BIG_ENDIAN \ + && LITTLE_ENDIAN) + bogus endian macros + #endif ; return 0; @@ -7142,33 +7532,34 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then # It does; now see whether it defined to BIG_ENDIAN or not. -cat >conftest.$ac_ext <<_ACEOF + cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include -#include + #include int main () { #if BYTE_ORDER != BIG_ENDIAN - not big endian -#endif + not big endian + #endif ; return 0; @@ -7180,20 +7571,21 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ac_cv_c_bigendian=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_c_bigendian=no @@ -7201,29 +7593,31 @@ fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - # It does not; compile a test program. -if test "$cross_compiling" = yes; then - # try to guess the endianness by grepping values into an object file - ac_cv_c_bigendian=unknown - cat >conftest.$ac_ext <<_ACEOF + +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + fi + if test $ac_cv_c_bigendian = unknown; then + # See if defines _LITTLE_ENDIAN or _BIG_ENDIAN (e.g., Solaris). + cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ -short int ascii_mm[] = { 0x4249, 0x4765, 0x6E44, 0x6961, 0x6E53, 0x7953, 0 }; -short int ascii_ii[] = { 0x694C, 0x5454, 0x656C, 0x6E45, 0x6944, 0x6E61, 0 }; -void _ascii () { char *s = (char *) ascii_mm; s = (char *) ascii_ii; } -short int ebcdic_ii[] = { 0x89D3, 0xE3E3, 0x8593, 0x95C5, 0x89C4, 0x9581, 0 }; -short int ebcdic_mm[] = { 0xC2C9, 0xC785, 0x95C4, 0x8981, 0x95E2, 0xA8E2, 0 }; -void _ebcdic () { char *s = (char *) ebcdic_mm; s = (char *) ebcdic_ii; } +#include + int main () { - _ascii (); _ebcdic (); +#if ! (defined _LITTLE_ENDIAN || defined _BIG_ENDIAN) + bogus endian macros + #endif + ; return 0; } @@ -7234,30 +7628,139 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + # It does; now see whether it defined to _BIG_ENDIAN or not. + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include + +int +main () +{ +#ifndef _BIG_ENDIAN + not big endian + #endif + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_compile") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then - if grep BIGenDianSyS conftest.$ac_objext >/dev/null ; then ac_cv_c_bigendian=yes -fi -if grep LiTTleEnDian conftest.$ac_objext >/dev/null ; then - if test "$ac_cv_c_bigendian" = unknown; then - ac_cv_c_bigendian=no - else - # finding both strings is unlikely to happen, but who knows? - ac_cv_c_bigendian=unknown - fi -fi else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_c_bigendian=no +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + fi + if test $ac_cv_c_bigendian = unknown; then + # Compile a test program. + if test "$cross_compiling" = yes; then + # Try to guess by grepping values from an object file. + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +short int ascii_mm[] = + { 0x4249, 0x4765, 0x6E44, 0x6961, 0x6E53, 0x7953, 0 }; + short int ascii_ii[] = + { 0x694C, 0x5454, 0x656C, 0x6E45, 0x6944, 0x6E61, 0 }; + int use_ascii (int i) { + return ascii_mm[i] + ascii_ii[i]; + } + short int ebcdic_ii[] = + { 0x89D3, 0xE3E3, 0x8593, 0x95C5, 0x89C4, 0x9581, 0 }; + short int ebcdic_mm[] = + { 0xC2C9, 0xC785, 0x95C4, 0x8981, 0x95E2, 0xA8E2, 0 }; + int use_ebcdic (int i) { + return ebcdic_mm[i] + ebcdic_ii[i]; + } + extern int foo; + +int +main () +{ +return use_ascii (foo) == use_ebcdic (foo); + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_compile") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + if grep BIGenDianSyS conftest.$ac_objext >/dev/null; then + ac_cv_c_bigendian=yes + fi + if grep LiTTleEnDian conftest.$ac_objext >/dev/null ; then + if test "$ac_cv_c_bigendian" = unknown; then + ac_cv_c_bigendian=no + else + # finding both strings is unlikely to happen, but who knows? + ac_cv_c_bigendian=unknown + fi + fi +else + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 @@ -7276,14 +7779,14 @@ int main () { - /* Are we little or big endian? From Harbison&Steele. */ - union - { - long int l; - char c[sizeof (long int)]; - } u; - u.l = 1; - return u.c[sizeof (long int) - 1] == 1; + /* Are we little or big endian? From Harbison&Steele. */ + union + { + long int l; + char c[sizeof (long int)]; + } u; + u.l = 1; + return u.c[sizeof (long int) - 1] == 1; ; return 0; @@ -7295,54 +7798,61 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_try") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_c_bigendian=no else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: program exited with status $ac_status" >&5 +$as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_c_bigendian=yes fi +rm -rf conftest.dSYM rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi + fi fi - -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ echo "$as_me:$LINENO: result: $ac_cv_c_bigendian" >&5 -echo "${ECHO_T}$ac_cv_c_bigendian" >&6; } -case $ac_cv_c_bigendian in - yes) - -cat >>confdefs.h <<\_ACEOF +{ $as_echo "$as_me:$LINENO: result: $ac_cv_c_bigendian" >&5 +$as_echo "$ac_cv_c_bigendian" >&6; } + case $ac_cv_c_bigendian in #( + yes) + cat >>confdefs.h <<\_ACEOF #define WORDS_BIGENDIAN 1 _ACEOF - ;; - no) - ;; - *) - cat >>confdefs.h <<\_ACEOF +;; #( + no) + ;; #( + universal) + +cat >>confdefs.h <<\_ACEOF +#define AC_APPLE_UNIVERSAL_BUILD 1 +_ACEOF + + ;; #( + *) + cat >>confdefs.h <<\_ACEOF #define WORDS_BIGENDIAN /* EDIT! - Undefine if small endian */ _ACEOF ;; -esac + esac @@ -7351,15 +7861,17 @@ esac -{ echo "$as_me:$LINENO: checking appropiate type for fixnums" >&5 -echo $ECHO_N "checking appropiate type for fixnums... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking appropiate type for fixnums" >&5 +$as_echo_n "checking appropiate type for fixnums... " >&6; } if test -z "${CL_FIXNUM_TYPE}" ; then if test "$cross_compiling" = yes; then - { { echo "$as_me:$LINENO: error: cannot run test program while cross compiling + { { $as_echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +{ { $as_echo "$as_me:$LINENO: error: cannot run test program while cross compiling See \`config.log' for more details." >&5 -echo "$as_me: error: cannot run test program while cross compiling +$as_echo "$as_me: error: cannot run test program while cross compiling See \`config.log' for more details." >&2;} - { (exit 1); exit 1; }; } + { (exit 1); exit 1; }; }; } else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ @@ -7414,50 +7926,55 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_try") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "`cat conftestval`" else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: program exited with status $ac_status" >&5 +$as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi +rm -rf conftest.dSYM rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi if test -z "${CL_FIXNUM_TYPE}" ; then -{ { echo "$as_me:$LINENO: error: There is no appropiate integer type for the cl_fixnum type" >&5 -echo "$as_me: error: There is no appropiate integer type for the cl_fixnum type" >&2;} +{ { $as_echo "$as_me:$LINENO: error: There is no appropiate integer type for the cl_fixnum type" >&5 +$as_echo "$as_me: error: There is no appropiate integer type for the cl_fixnum type" >&2;} { (exit 1); exit 1; }; } fi -{ echo "$as_me:$LINENO: result: ${CL_FIXNUM_TYPE}" >&5 -echo "${ECHO_T}${CL_FIXNUM_TYPE}" >&6; } +{ $as_echo "$as_me:$LINENO: result: ${CL_FIXNUM_TYPE}" >&5 +$as_echo "${CL_FIXNUM_TYPE}" >&6; } -{ echo "$as_me:$LINENO: checking character sequence for end of line" >&5 -echo $ECHO_N "checking character sequence for end of line... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking character sequence for end of line" >&5 +$as_echo_n "checking character sequence for end of line... " >&6; } if test -z "${ECL_NEWLINE}" ; then if test "$cross_compiling" = yes; then - { { echo "$as_me:$LINENO: error: cannot run test program while cross compiling + { { $as_echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +{ { $as_echo "$as_me:$LINENO: error: cannot run test program while cross compiling See \`config.log' for more details." >&5 -echo "$as_me: error: cannot run test program while cross compiling +$as_echo "$as_me: error: cannot run test program while cross compiling See \`config.log' for more details." >&2;} - { (exit 1); exit 1; }; } + { (exit 1); exit 1; }; }; } else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ @@ -7502,59 +8019,62 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_try") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ECL_NEWLINE=`cat conftestval` else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: program exited with status $ac_status" >&5 +$as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi +rm -rf conftest.dSYM rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi case "${ECL_NEWLINE}" in - LF) { echo "$as_me:$LINENO: result: lf" >&5 -echo "${ECHO_T}lf" >&6; } ;; - CR) { echo "$as_me:$LINENO: result: cr" >&5 -echo "${ECHO_T}cr" >&6; }; + LF) { $as_echo "$as_me:$LINENO: result: lf" >&5 +$as_echo "lf" >&6; } ;; + CR) { $as_echo "$as_me:$LINENO: result: cr" >&5 +$as_echo "cr" >&6; }; cat >>confdefs.h <<\_ACEOF #define ECL_NEWLINE_IS_CR 1 _ACEOF ;; - CRLF) { echo "$as_me:$LINENO: result: cr+lf" >&5 -echo "${ECHO_T}cr+lf" >&6; }; + CRLF) { $as_echo "$as_me:$LINENO: result: cr+lf" >&5 +$as_echo "cr+lf" >&6; }; cat >>confdefs.h <<\_ACEOF #define ECL_NEWLINE_IS_CRLF 1 _ACEOF ;; - *) { { echo "$as_me:$LINENO: error: Unable to determine linefeed mode" >&5 -echo "$as_me: error: Unable to determine linefeed mode" >&2;} + *) { { $as_echo "$as_me:$LINENO: error: Unable to determine linefeed mode" >&5 +$as_echo "$as_me: error: Unable to determine linefeed mode" >&2;} { (exit 1); exit 1; }; } ;; esac -{ echo "$as_me:$LINENO: checking for _longjmp" >&5 -echo $ECHO_N "checking for _longjmp... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for _longjmp" >&5 +$as_echo_n "checking for _longjmp... " >&6; } if test "${ac_cv_func__longjmp+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ @@ -7607,32 +8127,36 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err - } && test -s conftest$ac_exeext && - $as_test_x conftest$ac_exeext; then + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + $as_test_x conftest$ac_exeext + }; then ac_cv_func__longjmp=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func__longjmp=no fi +rm -rf conftest.dSYM rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi -{ echo "$as_me:$LINENO: result: $ac_cv_func__longjmp" >&5 -echo "${ECHO_T}$ac_cv_func__longjmp" >&6; } -if test $ac_cv_func__longjmp = yes; then +{ $as_echo "$as_me:$LINENO: result: $ac_cv_func__longjmp" >&5 +$as_echo "$ac_cv_func__longjmp" >&6; } +if test "x$ac_cv_func__longjmp" = x""yes; then ECL_SETJMP="_setjmp";ECL_LONGJMP="_longjmp" else ECL_SETJMP="setjmp";ECL_LONGJMP="longjmp" @@ -7668,20 +8192,21 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ECL_FILE_CNT=1 else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 @@ -7714,20 +8239,21 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ECL_FILE_CNT=2 else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 @@ -7760,20 +8286,21 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ECL_FILE_CNT=3 else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 @@ -7783,8 +8310,8 @@ rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -{ echo "$as_me:$LINENO: checking whether we can dynamically build calls to C functions" >&5 -echo $ECHO_N "checking whether we can dynamically build calls to C functions... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking whether we can dynamically build calls to C functions" >&5 +$as_echo_n "checking whether we can dynamically build calls to C functions... " >&6; } case "${host_cpu}" in i686 | i586 | pentium* | athlon* ) EXTRA_OBJS="${EXTRA_OBJS} ffi_x86.o" @@ -7809,8 +8336,8 @@ _ACEOF dynamic_ffi=no ;; esac -{ echo "$as_me:$LINENO: result: ${dynamic_ffi}" >&5 -echo "${ECHO_T}${dynamic_ffi}" >&6; } +{ $as_echo "$as_me:$LINENO: result: ${dynamic_ffi}" >&5 +$as_echo "${dynamic_ffi}" >&6; } if test "$dynamic_ffi" = "yes" ; then cat >>confdefs.h <<\_ACEOF @@ -7819,49 +8346,47 @@ _ACEOF fi -{ echo "$as_me:$LINENO: checking for code to detect FP exceptions" >&5 -echo $ECHO_N "checking for code to detect FP exceptions... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for code to detect FP exceptions" >&5 +$as_echo_n "checking for code to detect FP exceptions... " >&6; } case "${host_cpu}" in i686 |i586 | pentium* | athlon* ) ECL_FPE_CODE="arch/fpe_x86.c" - { echo "$as_me:$LINENO: result: x86" >&5 -echo "${ECHO_T}x86" >&6; } + { $as_echo "$as_me:$LINENO: result: x86" >&5 +$as_echo "x86" >&6; } ;; x86_64* ) ECL_FPE_CODE="arch/fpe_x86.c" - { echo "$as_me:$LINENO: result: x86_64" >&5 -echo "${ECHO_T}x86_64" >&6; } + { $as_echo "$as_me:$LINENO: result: x86_64" >&5 +$as_echo "x86_64" >&6; } ;; *) ECL_FPE_CODE="arch/fpe_none.c" - { echo "$as_me:$LINENO: result: not available" >&5 -echo "${ECHO_T}not available" >&6; } + { $as_echo "$as_me:$LINENO: result: not available" >&5 +$as_echo "not available" >&6; } ;; esac if test "$enable_longdouble" != "no" ; then -{ echo "$as_me:$LINENO: checking for long double" >&5 -echo $ECHO_N "checking for long double... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for long double" >&5 +$as_echo_n "checking for long double... " >&6; } if test "${ac_cv_type_long_double+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF + ac_cv_type_long_double=no +cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default -typedef long double ac__type_new_; int main () { -if ((ac__type_new_ *) 0) - return 0; -if (sizeof (ac__type_new_)) - return 0; +if (sizeof (long double)) + return 0; ; return 0; } @@ -7872,30 +8397,73 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then - ac_cv_type_long_double=yes + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +int +main () +{ +if (sizeof ((long double))) + return 0; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_compile") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + : else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - ac_cv_type_long_double=no + ac_cv_type_long_double=yes +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -{ echo "$as_me:$LINENO: result: $ac_cv_type_long_double" >&5 -echo "${ECHO_T}$ac_cv_type_long_double" >&6; } -if test $ac_cv_type_long_double = yes; then +{ $as_echo "$as_me:$LINENO: result: $ac_cv_type_long_double" >&5 +$as_echo "$ac_cv_type_long_double" >&6; } +if test "x$ac_cv_type_long_double" = x""yes; then cat >>confdefs.h <<_ACEOF #define HAVE_LONG_DOUBLE 1 @@ -7906,12 +8474,13 @@ fi fi if test "$enable_c99complex" != "no" ; then -{ echo "$as_me:$LINENO: checking for double complex" >&5 -echo $ECHO_N "checking for double complex... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for double complex" >&5 +$as_echo_n "checking for double complex... " >&6; } if test "${ac_cv_type_double_complex+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF + ac_cv_type_double_complex=no +cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext @@ -7919,14 +8488,11 @@ cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include -typedef double complex ac__type_new_; int main () { -if ((ac__type_new_ *) 0) - return 0; -if (sizeof (ac__type_new_)) - return 0; +if (sizeof (double complex)) + return 0; ; return 0; } @@ -7937,30 +8503,74 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then - ac_cv_type_double_complex=yes + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include + +int +main () +{ +if (sizeof ((double complex))) + return 0; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_compile") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + : else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - ac_cv_type_double_complex=no + ac_cv_type_double_complex=yes +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -{ echo "$as_me:$LINENO: result: $ac_cv_type_double_complex" >&5 -echo "${ECHO_T}$ac_cv_type_double_complex" >&6; } -if test $ac_cv_type_double_complex = yes; then +{ $as_echo "$as_me:$LINENO: result: $ac_cv_type_double_complex" >&5 +$as_echo "$ac_cv_type_double_complex" >&6; } +if test "x$ac_cv_type_double_complex" = x""yes; then cat >>confdefs.h <<_ACEOF #define HAVE_DOUBLE_COMPLEX 1 @@ -7968,12 +8578,13 @@ _ACEOF fi -{ echo "$as_me:$LINENO: checking for float complex" >&5 -echo $ECHO_N "checking for float complex... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for float complex" >&5 +$as_echo_n "checking for float complex... " >&6; } if test "${ac_cv_type_float_complex+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF + ac_cv_type_float_complex=no +cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext @@ -7981,14 +8592,11 @@ cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include -typedef float complex ac__type_new_; int main () { -if ((ac__type_new_ *) 0) - return 0; -if (sizeof (ac__type_new_)) - return 0; +if (sizeof (float complex)) + return 0; ; return 0; } @@ -7999,30 +8607,74 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then - ac_cv_type_float_complex=yes + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include + +int +main () +{ +if (sizeof ((float complex))) + return 0; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_compile") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + : else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - ac_cv_type_float_complex=no + ac_cv_type_float_complex=yes +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -{ echo "$as_me:$LINENO: result: $ac_cv_type_float_complex" >&5 -echo "${ECHO_T}$ac_cv_type_float_complex" >&6; } -if test $ac_cv_type_float_complex = yes; then +{ $as_echo "$as_me:$LINENO: result: $ac_cv_type_float_complex" >&5 +$as_echo "$ac_cv_type_float_complex" >&6; } +if test "x$ac_cv_type_float_complex" = x""yes; then cat >>confdefs.h <<_ACEOF #define HAVE_FLOAT_COMPLEX 1 @@ -8034,15 +8686,17 @@ fi fi - { echo "$as_me:$LINENO: checking whether stack growns downwards" >&5 -echo $ECHO_N "checking whether stack growns downwards... $ECHO_C" >&6; } + { $as_echo "$as_me:$LINENO: checking whether stack growns downwards" >&5 +$as_echo_n "checking whether stack growns downwards... " >&6; } if test -z "${ECL_STACK_DIR}" ; then if test "$cross_compiling" = yes; then - { { echo "$as_me:$LINENO: error: cannot run test program while cross compiling + { { $as_echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +{ { $as_echo "$as_me:$LINENO: error: cannot run test program while cross compiling See \`config.log' for more details." >&5 -echo "$as_me: error: cannot run test program while cross compiling +$as_echo "$as_me: error: cannot run test program while cross compiling See \`config.log' for more details." >&2;} - { (exit 1); exit 1; }; } + { (exit 1); exit 1; }; }; } else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ @@ -8075,53 +8729,56 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_try") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ECL_STACK_DIR=down else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: program exited with status $ac_status" >&5 +$as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ECL_STACK_DIR=up fi +rm -rf conftest.dSYM rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi case "${ECL_STACK_DIR}" in - down|DOWN) { echo "$as_me:$LINENO: result: yes" >&5 -echo "${ECHO_T}yes" >&6; }; + down|DOWN) { $as_echo "$as_me:$LINENO: result: yes" >&5 +$as_echo "yes" >&6; }; cat >>confdefs.h <<\_ACEOF #define ECL_DOWN_STACK 1 _ACEOF ;; - up|UP) { echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6; } ;; - *) { { echo "$as_me:$LINENO: error: Unable to determine stack growth direction" >&5 -echo "$as_me: error: Unable to determine stack growth direction" >&2;} + up|UP) { $as_echo "$as_me:$LINENO: result: no" >&5 +$as_echo "no" >&6; } ;; + *) { { $as_echo "$as_me:$LINENO: error: Unable to determine stack growth direction" >&5 +$as_echo "$as_me: error: Unable to determine stack growth direction" >&2;} { (exit 1); exit 1; }; } esac -{ echo "$as_me:$LINENO: checking whether closedir returns void" >&5 -echo $ECHO_N "checking whether closedir returns void... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking whether closedir returns void" >&5 +$as_echo_n "checking whether closedir returns void... " >&6; } if test "${ac_cv_func_closedir_void+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else if test "$cross_compiling" = yes; then ac_cv_func_closedir_void=yes @@ -8152,36 +8809,39 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_try") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_closedir_void=no else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: program exited with status $ac_status" >&5 +$as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_func_closedir_void=yes fi +rm -rf conftest.dSYM rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi -{ echo "$as_me:$LINENO: result: $ac_cv_func_closedir_void" >&5 -echo "${ECHO_T}$ac_cv_func_closedir_void" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_func_closedir_void" >&5 +$as_echo "$ac_cv_func_closedir_void" >&6; } if test $ac_cv_func_closedir_void = yes; then cat >>confdefs.h <<\_ACEOF @@ -8190,10 +8850,10 @@ _ACEOF fi -{ echo "$as_me:$LINENO: checking for error_at_line" >&5 -echo $ECHO_N "checking for error_at_line... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for error_at_line" >&5 +$as_echo_n "checking for error_at_line... " >&6; } if test "${ac_cv_lib_error_at_line+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ @@ -8216,31 +8876,35 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err - } && test -s conftest$ac_exeext && - $as_test_x conftest$ac_exeext; then + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + $as_test_x conftest$ac_exeext + }; then ac_cv_lib_error_at_line=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_error_at_line=no fi +rm -rf conftest.dSYM rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi -{ echo "$as_me:$LINENO: result: $ac_cv_lib_error_at_line" >&5 -echo "${ECHO_T}$ac_cv_lib_error_at_line" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_lib_error_at_line" >&5 +$as_echo "$ac_cv_lib_error_at_line" >&6; } if test $ac_cv_lib_error_at_line = no; then case " $LIBOBJS " in *" error.$ac_objext "* ) ;; @@ -8250,26 +8914,24 @@ esac fi -{ echo "$as_me:$LINENO: checking for pid_t" >&5 -echo $ECHO_N "checking for pid_t... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for pid_t" >&5 +$as_echo_n "checking for pid_t... " >&6; } if test "${ac_cv_type_pid_t+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF + ac_cv_type_pid_t=no +cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default -typedef pid_t ac__type_new_; int main () { -if ((ac__type_new_ *) 0) - return 0; -if (sizeof (ac__type_new_)) - return 0; +if (sizeof (pid_t)) + return 0; ; return 0; } @@ -8280,30 +8942,73 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then - ac_cv_type_pid_t=yes + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +int +main () +{ +if (sizeof ((pid_t))) + return 0; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_compile") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + : else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - ac_cv_type_pid_t=no + ac_cv_type_pid_t=yes +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -{ echo "$as_me:$LINENO: result: $ac_cv_type_pid_t" >&5 -echo "${ECHO_T}$ac_cv_type_pid_t" >&6; } -if test $ac_cv_type_pid_t = yes; then +{ $as_echo "$as_me:$LINENO: result: $ac_cv_type_pid_t" >&5 +$as_echo "$ac_cv_type_pid_t" >&6; } +if test "x$ac_cv_type_pid_t" = x""yes; then : else @@ -8316,20 +9021,21 @@ fi for ac_header in vfork.h do -as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` +as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then - { echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } + { $as_echo "$as_me:$LINENO: checking for $ac_header" >&5 +$as_echo_n "checking for $ac_header... " >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 fi -ac_res=`eval echo '${'$as_ac_Header'}'` - { echo "$as_me:$LINENO: result: $ac_res" >&5 -echo "${ECHO_T}$ac_res" >&6; } +ac_res=`eval 'as_val=${'$as_ac_Header'} + $as_echo "$as_val"'` + { $as_echo "$as_me:$LINENO: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } else # Is the header compilable? -{ echo "$as_me:$LINENO: checking $ac_header usability" >&5 -echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking $ac_header usability" >&5 +$as_echo_n "checking $ac_header usability... " >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF @@ -8345,32 +9051,33 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ac_header_compiler=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -{ echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 -echo "${ECHO_T}$ac_header_compiler" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +$as_echo "$ac_header_compiler" >&6; } # Is the header present? -{ echo "$as_me:$LINENO: checking $ac_header presence" >&5 -echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking $ac_header presence" >&5 +$as_echo_n "checking $ac_header presence... " >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF @@ -8384,69 +9091,73 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null && { test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || test ! -s conftest.err }; then ac_header_preproc=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext -{ echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 -echo "${ECHO_T}$ac_header_preproc" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +$as_echo "$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) - { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 -echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 -echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 +$as_echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) - { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 -echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 -echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 -echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 -echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 -echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 -echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 +$as_echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 +$as_echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 +$as_echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 +$as_echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 +$as_echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 +$as_echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ;; esac -{ echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for $ac_header" >&5 +$as_echo_n "checking for $ac_header... " >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi -ac_res=`eval echo '${'$as_ac_Header'}'` - { echo "$as_me:$LINENO: result: $ac_res" >&5 -echo "${ECHO_T}$ac_res" >&6; } +ac_res=`eval 'as_val=${'$as_ac_Header'} + $as_echo "$as_val"'` + { $as_echo "$as_me:$LINENO: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } fi -if test `eval echo '${'$as_ac_Header'}'` = yes; then +as_val=`eval 'as_val=${'$as_ac_Header'} + $as_echo "$as_val"'` + if test "x$as_val" = x""yes; then cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi @@ -8457,11 +9168,11 @@ done for ac_func in fork vfork do -as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` -{ echo "$as_me:$LINENO: checking for $ac_func" >&5 -echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } +as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` +{ $as_echo "$as_me:$LINENO: checking for $ac_func" >&5 +$as_echo_n "checking for $ac_func... " >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ @@ -8514,45 +9225,52 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err - } && test -s conftest$ac_exeext && - $as_test_x conftest$ac_exeext; then + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + $as_test_x conftest$ac_exeext + }; then eval "$as_ac_var=yes" else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi +rm -rf conftest.dSYM rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi -ac_res=`eval echo '${'$as_ac_var'}'` - { echo "$as_me:$LINENO: result: $ac_res" >&5 -echo "${ECHO_T}$ac_res" >&6; } -if test `eval echo '${'$as_ac_var'}'` = yes; then +ac_res=`eval 'as_val=${'$as_ac_var'} + $as_echo "$as_val"'` + { $as_echo "$as_me:$LINENO: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +as_val=`eval 'as_val=${'$as_ac_var'} + $as_echo "$as_val"'` + if test "x$as_val" = x""yes; then cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done if test "x$ac_cv_func_fork" = xyes; then - { echo "$as_me:$LINENO: checking for working fork" >&5 -echo $ECHO_N "checking for working fork... $ECHO_C" >&6; } + { $as_echo "$as_me:$LINENO: checking for working fork" >&5 +$as_echo_n "checking for working fork... " >&6; } if test "${ac_cv_func_fork_works+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else if test "$cross_compiling" = yes; then ac_cv_func_fork_works=cross @@ -8581,36 +9299,39 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_try") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_fork_works=yes else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: program exited with status $ac_status" >&5 +$as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_func_fork_works=no fi +rm -rf conftest.dSYM rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi -{ echo "$as_me:$LINENO: result: $ac_cv_func_fork_works" >&5 -echo "${ECHO_T}$ac_cv_func_fork_works" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_func_fork_works" >&5 +$as_echo "$ac_cv_func_fork_works" >&6; } else ac_cv_func_fork_works=$ac_cv_func_fork @@ -8625,15 +9346,15 @@ if test "x$ac_cv_func_fork_works" = xcross; then ac_cv_func_fork_works=yes ;; esac - { echo "$as_me:$LINENO: WARNING: result $ac_cv_func_fork_works guessed because of cross compilation" >&5 -echo "$as_me: WARNING: result $ac_cv_func_fork_works guessed because of cross compilation" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: result $ac_cv_func_fork_works guessed because of cross compilation" >&5 +$as_echo "$as_me: WARNING: result $ac_cv_func_fork_works guessed because of cross compilation" >&2;} fi ac_cv_func_vfork_works=$ac_cv_func_vfork if test "x$ac_cv_func_vfork" = xyes; then - { echo "$as_me:$LINENO: checking for working vfork" >&5 -echo $ECHO_N "checking for working vfork... $ECHO_C" >&6; } + { $as_echo "$as_me:$LINENO: checking for working vfork" >&5 +$as_echo_n "checking for working vfork... " >&6; } if test "${ac_cv_func_vfork_works+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else if test "$cross_compiling" = yes; then ac_cv_func_vfork_works=cross @@ -8740,42 +9461,45 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_try") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_vfork_works=yes else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: program exited with status $ac_status" >&5 +$as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_func_vfork_works=no fi +rm -rf conftest.dSYM rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi -{ echo "$as_me:$LINENO: result: $ac_cv_func_vfork_works" >&5 -echo "${ECHO_T}$ac_cv_func_vfork_works" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_func_vfork_works" >&5 +$as_echo "$ac_cv_func_vfork_works" >&6; } fi; if test "x$ac_cv_func_fork_works" = xcross; then ac_cv_func_vfork_works=$ac_cv_func_vfork - { echo "$as_me:$LINENO: WARNING: result $ac_cv_func_vfork_works guessed because of cross compilation" >&5 -echo "$as_me: WARNING: result $ac_cv_func_vfork_works guessed because of cross compilation" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: result $ac_cv_func_vfork_works guessed because of cross compilation" >&5 +$as_echo "$as_me: WARNING: result $ac_cv_func_vfork_works guessed because of cross compilation" >&2;} fi if test "x$ac_cv_func_vfork_works" = xyes; then @@ -8800,10 +9524,10 @@ _ACEOF fi if test $ac_cv_c_compiler_gnu = yes; then - { echo "$as_me:$LINENO: checking whether $CC needs -traditional" >&5 -echo $ECHO_N "checking whether $CC needs -traditional... $ECHO_C" >&6; } + { $as_echo "$as_me:$LINENO: checking whether $CC needs -traditional" >&5 +$as_echo_n "checking whether $CC needs -traditional... " >&6; } if test "${ac_cv_prog_gcc_traditional+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else ac_pattern="Autoconf.*'x'" cat >conftest.$ac_ext <<_ACEOF @@ -8842,8 +9566,8 @@ rm -f conftest* fi fi -{ echo "$as_me:$LINENO: result: $ac_cv_prog_gcc_traditional" >&5 -echo "${ECHO_T}$ac_cv_prog_gcc_traditional" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_prog_gcc_traditional" >&5 +$as_echo "$ac_cv_prog_gcc_traditional" >&6; } if test $ac_cv_prog_gcc_traditional = yes; then CC="$CC -traditional" fi @@ -8852,20 +9576,21 @@ fi for ac_header in stdlib.h do -as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` +as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then - { echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } + { $as_echo "$as_me:$LINENO: checking for $ac_header" >&5 +$as_echo_n "checking for $ac_header... " >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 fi -ac_res=`eval echo '${'$as_ac_Header'}'` - { echo "$as_me:$LINENO: result: $ac_res" >&5 -echo "${ECHO_T}$ac_res" >&6; } +ac_res=`eval 'as_val=${'$as_ac_Header'} + $as_echo "$as_val"'` + { $as_echo "$as_me:$LINENO: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } else # Is the header compilable? -{ echo "$as_me:$LINENO: checking $ac_header usability" >&5 -echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking $ac_header usability" >&5 +$as_echo_n "checking $ac_header usability... " >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF @@ -8881,32 +9606,33 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ac_header_compiler=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -{ echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 -echo "${ECHO_T}$ac_header_compiler" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +$as_echo "$ac_header_compiler" >&6; } # Is the header present? -{ echo "$as_me:$LINENO: checking $ac_header presence" >&5 -echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking $ac_header presence" >&5 +$as_echo_n "checking $ac_header presence... " >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF @@ -8920,79 +9646,83 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null && { test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || test ! -s conftest.err }; then ac_header_preproc=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext -{ echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 -echo "${ECHO_T}$ac_header_preproc" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +$as_echo "$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) - { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 -echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 -echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 +$as_echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) - { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 -echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 -echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 -echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 -echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 -echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 -echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 +$as_echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 +$as_echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 +$as_echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 +$as_echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 +$as_echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 +$as_echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ;; esac -{ echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for $ac_header" >&5 +$as_echo_n "checking for $ac_header... " >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi -ac_res=`eval echo '${'$as_ac_Header'}'` - { echo "$as_me:$LINENO: result: $ac_res" >&5 -echo "${ECHO_T}$ac_res" >&6; } +ac_res=`eval 'as_val=${'$as_ac_Header'} + $as_echo "$as_val"'` + { $as_echo "$as_me:$LINENO: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } fi -if test `eval echo '${'$as_ac_Header'}'` = yes; then +as_val=`eval 'as_val=${'$as_ac_Header'} + $as_echo "$as_val"'` + if test "x$as_val" = x""yes; then cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done -{ echo "$as_me:$LINENO: checking for GNU libc compatible malloc" >&5 -echo $ECHO_N "checking for GNU libc compatible malloc... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for GNU libc compatible malloc" >&5 +$as_echo_n "checking for GNU libc compatible malloc... " >&6; } if test "${ac_cv_func_malloc_0_nonnull+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else if test "$cross_compiling" = yes; then ac_cv_func_malloc_0_nonnull=no @@ -9023,36 +9753,39 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_try") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_malloc_0_nonnull=yes else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: program exited with status $ac_status" >&5 +$as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_func_malloc_0_nonnull=no fi +rm -rf conftest.dSYM rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi -{ echo "$as_me:$LINENO: result: $ac_cv_func_malloc_0_nonnull" >&5 -echo "${ECHO_T}$ac_cv_func_malloc_0_nonnull" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_func_malloc_0_nonnull" >&5 +$as_echo "$ac_cv_func_malloc_0_nonnull" >&6; } if test $ac_cv_func_malloc_0_nonnull = yes; then cat >>confdefs.h <<\_ACEOF @@ -9079,10 +9812,10 @@ fi -{ echo "$as_me:$LINENO: checking for working memcmp" >&5 -echo $ECHO_N "checking for working memcmp... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for working memcmp" >&5 +$as_echo_n "checking for working memcmp... " >&6; } if test "${ac_cv_func_memcmp_working+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else if test "$cross_compiling" = yes; then ac_cv_func_memcmp_working=no @@ -9132,36 +9865,39 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_try") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_memcmp_working=yes else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: program exited with status $ac_status" >&5 +$as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_func_memcmp_working=no fi +rm -rf conftest.dSYM rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi -{ echo "$as_me:$LINENO: result: $ac_cv_func_memcmp_working" >&5 -echo "${ECHO_T}$ac_cv_func_memcmp_working" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_func_memcmp_working" >&5 +$as_echo "$ac_cv_func_memcmp_working" >&6; } test $ac_cv_func_memcmp_working = no && case " $LIBOBJS " in *" memcmp.$ac_objext "* ) ;; *) LIBOBJS="$LIBOBJS memcmp.$ac_objext" @@ -9173,20 +9909,21 @@ esac for ac_header in stdlib.h unistd.h do -as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` +as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then - { echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } + { $as_echo "$as_me:$LINENO: checking for $ac_header" >&5 +$as_echo_n "checking for $ac_header... " >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 fi -ac_res=`eval echo '${'$as_ac_Header'}'` - { echo "$as_me:$LINENO: result: $ac_res" >&5 -echo "${ECHO_T}$ac_res" >&6; } +ac_res=`eval 'as_val=${'$as_ac_Header'} + $as_echo "$as_val"'` + { $as_echo "$as_me:$LINENO: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } else # Is the header compilable? -{ echo "$as_me:$LINENO: checking $ac_header usability" >&5 -echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking $ac_header usability" >&5 +$as_echo_n "checking $ac_header usability... " >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF @@ -9202,32 +9939,33 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ac_header_compiler=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -{ echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 -echo "${ECHO_T}$ac_header_compiler" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +$as_echo "$ac_header_compiler" >&6; } # Is the header present? -{ echo "$as_me:$LINENO: checking $ac_header presence" >&5 -echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking $ac_header presence" >&5 +$as_echo_n "checking $ac_header presence... " >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF @@ -9241,69 +9979,73 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null && { test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || test ! -s conftest.err }; then ac_header_preproc=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext -{ echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 -echo "${ECHO_T}$ac_header_preproc" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +$as_echo "$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) - { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 -echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 -echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 +$as_echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) - { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 -echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 -echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 -echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 -echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 -echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 -echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 +$as_echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 +$as_echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 +$as_echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 +$as_echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 +$as_echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 +$as_echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ;; esac -{ echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for $ac_header" >&5 +$as_echo_n "checking for $ac_header... " >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi -ac_res=`eval echo '${'$as_ac_Header'}'` - { echo "$as_me:$LINENO: result: $ac_res" >&5 -echo "${ECHO_T}$ac_res" >&6; } +ac_res=`eval 'as_val=${'$as_ac_Header'} + $as_echo "$as_val"'` + { $as_echo "$as_me:$LINENO: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } fi -if test `eval echo '${'$as_ac_Header'}'` = yes; then +as_val=`eval 'as_val=${'$as_ac_Header'} + $as_echo "$as_val"'` + if test "x$as_val" = x""yes; then cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi @@ -9313,11 +10055,11 @@ done for ac_func in getpagesize do -as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` -{ echo "$as_me:$LINENO: checking for $ac_func" >&5 -echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } +as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` +{ $as_echo "$as_me:$LINENO: checking for $ac_func" >&5 +$as_echo_n "checking for $ac_func... " >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ @@ -9370,44 +10112,51 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err - } && test -s conftest$ac_exeext && - $as_test_x conftest$ac_exeext; then + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + $as_test_x conftest$ac_exeext + }; then eval "$as_ac_var=yes" else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi +rm -rf conftest.dSYM rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi -ac_res=`eval echo '${'$as_ac_var'}'` - { echo "$as_me:$LINENO: result: $ac_res" >&5 -echo "${ECHO_T}$ac_res" >&6; } -if test `eval echo '${'$as_ac_var'}'` = yes; then +ac_res=`eval 'as_val=${'$as_ac_var'} + $as_echo "$as_val"'` + { $as_echo "$as_me:$LINENO: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +as_val=`eval 'as_val=${'$as_ac_var'} + $as_echo "$as_val"'` + if test "x$as_val" = x""yes; then cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done -{ echo "$as_me:$LINENO: checking for working mmap" >&5 -echo $ECHO_N "checking for working mmap... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for working mmap" >&5 +$as_echo_n "checking for working mmap... " >&6; } if test "${ac_cv_func_mmap_fixed_mapped+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else if test "$cross_compiling" = yes; then ac_cv_func_mmap_fixed_mapped=no @@ -9551,36 +10300,39 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_try") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_mmap_fixed_mapped=yes else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: program exited with status $ac_status" >&5 +$as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_func_mmap_fixed_mapped=no fi +rm -rf conftest.dSYM rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi -{ echo "$as_me:$LINENO: result: $ac_cv_func_mmap_fixed_mapped" >&5 -echo "${ECHO_T}$ac_cv_func_mmap_fixed_mapped" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_func_mmap_fixed_mapped" >&5 +$as_echo "$ac_cv_func_mmap_fixed_mapped" >&6; } if test $ac_cv_func_mmap_fixed_mapped = yes; then cat >>confdefs.h <<\_ACEOF @@ -9593,20 +10345,21 @@ rm -f conftest.mmap for ac_header in stdlib.h do -as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` +as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then - { echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } + { $as_echo "$as_me:$LINENO: checking for $ac_header" >&5 +$as_echo_n "checking for $ac_header... " >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 fi -ac_res=`eval echo '${'$as_ac_Header'}'` - { echo "$as_me:$LINENO: result: $ac_res" >&5 -echo "${ECHO_T}$ac_res" >&6; } +ac_res=`eval 'as_val=${'$as_ac_Header'} + $as_echo "$as_val"'` + { $as_echo "$as_me:$LINENO: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } else # Is the header compilable? -{ echo "$as_me:$LINENO: checking $ac_header usability" >&5 -echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking $ac_header usability" >&5 +$as_echo_n "checking $ac_header usability... " >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF @@ -9622,32 +10375,33 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ac_header_compiler=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -{ echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 -echo "${ECHO_T}$ac_header_compiler" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +$as_echo "$ac_header_compiler" >&6; } # Is the header present? -{ echo "$as_me:$LINENO: checking $ac_header presence" >&5 -echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking $ac_header presence" >&5 +$as_echo_n "checking $ac_header presence... " >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF @@ -9661,79 +10415,83 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null && { test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || test ! -s conftest.err }; then ac_header_preproc=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext -{ echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 -echo "${ECHO_T}$ac_header_preproc" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +$as_echo "$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) - { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 -echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 -echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 +$as_echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) - { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 -echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 -echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 -echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 -echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 -echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 -echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 +$as_echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 +$as_echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 +$as_echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 +$as_echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 +$as_echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 +$as_echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ;; esac -{ echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for $ac_header" >&5 +$as_echo_n "checking for $ac_header... " >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi -ac_res=`eval echo '${'$as_ac_Header'}'` - { echo "$as_me:$LINENO: result: $ac_res" >&5 -echo "${ECHO_T}$ac_res" >&6; } +ac_res=`eval 'as_val=${'$as_ac_Header'} + $as_echo "$as_val"'` + { $as_echo "$as_me:$LINENO: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } fi -if test `eval echo '${'$as_ac_Header'}'` = yes; then +as_val=`eval 'as_val=${'$as_ac_Header'} + $as_echo "$as_val"'` + if test "x$as_val" = x""yes; then cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done -{ echo "$as_me:$LINENO: checking for GNU libc compatible realloc" >&5 -echo $ECHO_N "checking for GNU libc compatible realloc... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for GNU libc compatible realloc" >&5 +$as_echo_n "checking for GNU libc compatible realloc... " >&6; } if test "${ac_cv_func_realloc_0_nonnull+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else if test "$cross_compiling" = yes; then ac_cv_func_realloc_0_nonnull=no @@ -9764,36 +10522,39 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_try") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_realloc_0_nonnull=yes else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: program exited with status $ac_status" >&5 +$as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_func_realloc_0_nonnull=no fi +rm -rf conftest.dSYM rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi -{ echo "$as_me:$LINENO: result: $ac_cv_func_realloc_0_nonnull" >&5 -echo "${ECHO_T}$ac_cv_func_realloc_0_nonnull" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_func_realloc_0_nonnull" >&5 +$as_echo "$ac_cv_func_realloc_0_nonnull" >&6; } if test $ac_cv_func_realloc_0_nonnull = yes; then cat >>confdefs.h <<\_ACEOF @@ -9824,20 +10585,21 @@ fi for ac_header in sys/select.h sys/socket.h do -as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` +as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then - { echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } + { $as_echo "$as_me:$LINENO: checking for $ac_header" >&5 +$as_echo_n "checking for $ac_header... " >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 fi -ac_res=`eval echo '${'$as_ac_Header'}'` - { echo "$as_me:$LINENO: result: $ac_res" >&5 -echo "${ECHO_T}$ac_res" >&6; } +ac_res=`eval 'as_val=${'$as_ac_Header'} + $as_echo "$as_val"'` + { $as_echo "$as_me:$LINENO: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } else # Is the header compilable? -{ echo "$as_me:$LINENO: checking $ac_header usability" >&5 -echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking $ac_header usability" >&5 +$as_echo_n "checking $ac_header usability... " >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF @@ -9853,32 +10615,33 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ac_header_compiler=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -{ echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 -echo "${ECHO_T}$ac_header_compiler" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +$as_echo "$ac_header_compiler" >&6; } # Is the header present? -{ echo "$as_me:$LINENO: checking $ac_header presence" >&5 -echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking $ac_header presence" >&5 +$as_echo_n "checking $ac_header presence... " >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF @@ -9892,79 +10655,83 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null && { test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || test ! -s conftest.err }; then ac_header_preproc=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext -{ echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 -echo "${ECHO_T}$ac_header_preproc" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +$as_echo "$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) - { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 -echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 -echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 +$as_echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) - { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 -echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 -echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 -echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 -echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 -echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 -echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 +$as_echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 +$as_echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 +$as_echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 +$as_echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 +$as_echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 +$as_echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ;; esac -{ echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for $ac_header" >&5 +$as_echo_n "checking for $ac_header... " >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi -ac_res=`eval echo '${'$as_ac_Header'}'` - { echo "$as_me:$LINENO: result: $ac_res" >&5 -echo "${ECHO_T}$ac_res" >&6; } +ac_res=`eval 'as_val=${'$as_ac_Header'} + $as_echo "$as_val"'` + { $as_echo "$as_me:$LINENO: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } fi -if test `eval echo '${'$as_ac_Header'}'` = yes; then +as_val=`eval 'as_val=${'$as_ac_Header'} + $as_echo "$as_val"'` + if test "x$as_val" = x""yes; then cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done -{ echo "$as_me:$LINENO: checking types of arguments for select" >&5 -echo $ECHO_N "checking types of arguments for select... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking types of arguments for select" >&5 +$as_echo_n "checking types of arguments for select... " >&6; } if test "${ac_cv_func_select_args+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else for ac_arg234 in 'fd_set *' 'int *' 'void *'; do for ac_arg1 in 'int' 'size_t' 'unsigned long int' 'unsigned int'; do @@ -9999,20 +10766,21 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ac_cv_func_select_args="$ac_arg1,$ac_arg234,$ac_arg5"; break 3 else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 @@ -10026,8 +10794,8 @@ done : ${ac_cv_func_select_args='int,int *,struct timeval *'} fi -{ echo "$as_me:$LINENO: result: $ac_cv_func_select_args" >&5 -echo "${ECHO_T}$ac_cv_func_select_args" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_func_select_args" >&5 +$as_echo "$ac_cv_func_select_args" >&6; } ac_save_IFS=$IFS; IFS=',' set dummy `echo "$ac_cv_func_select_args" | sed 's/\*/\*/g'` IFS=$ac_save_IFS @@ -10049,10 +10817,10 @@ _ACEOF rm -f conftest* -{ echo "$as_me:$LINENO: checking return type of signal handlers" >&5 -echo $ECHO_N "checking return type of signal handlers... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking return type of signal handlers" >&5 +$as_echo_n "checking return type of signal handlers... " >&6; } if test "${ac_cv_type_signal+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ @@ -10077,20 +10845,21 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ac_cv_type_signal=int else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_signal=void @@ -10098,18 +10867,18 @@ fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -{ echo "$as_me:$LINENO: result: $ac_cv_type_signal" >&5 -echo "${ECHO_T}$ac_cv_type_signal" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_type_signal" >&5 +$as_echo "$ac_cv_type_signal" >&6; } cat >>confdefs.h <<_ACEOF #define RETSIGTYPE $ac_cv_type_signal _ACEOF -{ echo "$as_me:$LINENO: checking whether lstat dereferences a symlink specified with a trailing slash" >&5 -echo $ECHO_N "checking whether lstat dereferences a symlink specified with a trailing slash... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking whether lstat dereferences a symlink specified with a trailing slash" >&5 +$as_echo_n "checking whether lstat dereferences a symlink specified with a trailing slash... " >&6; } if test "${ac_cv_func_lstat_dereferences_slashed_symlink+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else rm -f conftest.sym conftest.file echo >conftest.file @@ -10142,29 +10911,32 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_try") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_lstat_dereferences_slashed_symlink=yes else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: program exited with status $ac_status" >&5 +$as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_func_lstat_dereferences_slashed_symlink=no fi +rm -rf conftest.dSYM rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi @@ -10177,8 +10949,8 @@ fi rm -f conftest.sym conftest.file fi -{ echo "$as_me:$LINENO: result: $ac_cv_func_lstat_dereferences_slashed_symlink" >&5 -echo "${ECHO_T}$ac_cv_func_lstat_dereferences_slashed_symlink" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_func_lstat_dereferences_slashed_symlink" >&5 +$as_echo "$ac_cv_func_lstat_dereferences_slashed_symlink" >&6; } test $ac_cv_func_lstat_dereferences_slashed_symlink = yes && @@ -10196,10 +10968,10 @@ esac fi -{ echo "$as_me:$LINENO: checking whether stat accepts an empty string" >&5 -echo $ECHO_N "checking whether stat accepts an empty string... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking whether stat accepts an empty string" >&5 +$as_echo_n "checking whether stat accepts an empty string... " >&6; } if test "${ac_cv_func_stat_empty_string_bug+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else if test "$cross_compiling" = yes; then ac_cv_func_stat_empty_string_bug=yes @@ -10226,36 +10998,39 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_try") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_stat_empty_string_bug=no else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: program exited with status $ac_status" >&5 +$as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_func_stat_empty_string_bug=yes fi +rm -rf conftest.dSYM rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi -{ echo "$as_me:$LINENO: result: $ac_cv_func_stat_empty_string_bug" >&5 -echo "${ECHO_T}$ac_cv_func_stat_empty_string_bug" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_func_stat_empty_string_bug" >&5 +$as_echo "$ac_cv_func_stat_empty_string_bug" >&6; } if test $ac_cv_func_stat_empty_string_bug = yes; then case " $LIBOBJS " in *" stat.$ac_objext "* ) ;; @@ -10270,10 +11045,10 @@ _ACEOF fi -{ echo "$as_me:$LINENO: checking for working strtod" >&5 -echo $ECHO_N "checking for working strtod... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for working strtod" >&5 +$as_echo_n "checking for working strtod... " >&6; } if test "${ac_cv_func_strtod+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else if test "$cross_compiling" = yes; then ac_cv_func_strtod=no @@ -10321,36 +11096,39 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_try") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_strtod=yes else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: program exited with status $ac_status" >&5 +$as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_func_strtod=no fi +rm -rf conftest.dSYM rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi -{ echo "$as_me:$LINENO: result: $ac_cv_func_strtod" >&5 -echo "${ECHO_T}$ac_cv_func_strtod" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_func_strtod" >&5 +$as_echo "$ac_cv_func_strtod" >&6; } if test $ac_cv_func_strtod = no; then case " $LIBOBJS " in *" strtod.$ac_objext "* ) ;; @@ -10358,10 +11136,10 @@ if test $ac_cv_func_strtod = no; then ;; esac -{ echo "$as_me:$LINENO: checking for pow" >&5 -echo $ECHO_N "checking for pow... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for pow" >&5 +$as_echo_n "checking for pow... " >&6; } if test "${ac_cv_func_pow+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ @@ -10414,37 +11192,41 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err - } && test -s conftest$ac_exeext && - $as_test_x conftest$ac_exeext; then + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + $as_test_x conftest$ac_exeext + }; then ac_cv_func_pow=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_pow=no fi +rm -rf conftest.dSYM rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi -{ echo "$as_me:$LINENO: result: $ac_cv_func_pow" >&5 -echo "${ECHO_T}$ac_cv_func_pow" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_func_pow" >&5 +$as_echo "$ac_cv_func_pow" >&6; } if test $ac_cv_func_pow = no; then - { echo "$as_me:$LINENO: checking for pow in -lm" >&5 -echo $ECHO_N "checking for pow in -lm... $ECHO_C" >&6; } + { $as_echo "$as_me:$LINENO: checking for pow in -lm" >&5 +$as_echo_n "checking for pow in -lm... " >&6; } if test "${ac_cv_lib_m_pow+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lm $LIBS" @@ -10476,37 +11258,41 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err - } && test -s conftest$ac_exeext && - $as_test_x conftest$ac_exeext; then + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + $as_test_x conftest$ac_exeext + }; then ac_cv_lib_m_pow=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_m_pow=no fi +rm -rf conftest.dSYM rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi -{ echo "$as_me:$LINENO: result: $ac_cv_lib_m_pow" >&5 -echo "${ECHO_T}$ac_cv_lib_m_pow" >&6; } -if test $ac_cv_lib_m_pow = yes; then +{ $as_echo "$as_me:$LINENO: result: $ac_cv_lib_m_pow" >&5 +$as_echo "$ac_cv_lib_m_pow" >&6; } +if test "x$ac_cv_lib_m_pow" = x""yes; then POW_LIB=-lm else - { echo "$as_me:$LINENO: WARNING: cannot find library containing definition of pow" >&5 -echo "$as_me: WARNING: cannot find library containing definition of pow" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: cannot find library containing definition of pow" >&5 +$as_echo "$as_me: WARNING: cannot find library containing definition of pow" >&2;} fi fi @@ -10532,11 +11318,11 @@ for ac_func in floor getcwd gethostbyaddr gethostbyname getpagesize \ memmove memset mkdir putenv socket sqrt \ strcasecmp strchr strerror strtol do -as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` -{ echo "$as_me:$LINENO: checking for $ac_func" >&5 -echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } +as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` +{ $as_echo "$as_me:$LINENO: checking for $ac_func" >&5 +$as_echo_n "checking for $ac_func... " >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ @@ -10589,35 +11375,42 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err - } && test -s conftest$ac_exeext && - $as_test_x conftest$ac_exeext; then + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + $as_test_x conftest$ac_exeext + }; then eval "$as_ac_var=yes" else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi +rm -rf conftest.dSYM rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi -ac_res=`eval echo '${'$as_ac_var'}'` - { echo "$as_me:$LINENO: result: $ac_res" >&5 -echo "${ECHO_T}$ac_res" >&6; } -if test `eval echo '${'$as_ac_var'}'` = yes; then +ac_res=`eval 'as_val=${'$as_ac_var'} + $as_echo "$as_val"'` + { $as_echo "$as_me:$LINENO: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +as_val=`eval 'as_val=${'$as_ac_var'} + $as_echo "$as_val"'` + if test "x$as_val" = x""yes; then cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi @@ -10642,11 +11435,11 @@ for ac_func in nanosleep alarm times select setenv putenv \ lstat mkstemp sigprocmask isatty feenableexcept tzset \ gettimeofday getrusage do -as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` -{ echo "$as_me:$LINENO: checking for $ac_func" >&5 -echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } +as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` +{ $as_echo "$as_me:$LINENO: checking for $ac_func" >&5 +$as_echo_n "checking for $ac_func... " >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ @@ -10699,35 +11492,42 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err - } && test -s conftest$ac_exeext && - $as_test_x conftest$ac_exeext; then + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + $as_test_x conftest$ac_exeext + }; then eval "$as_ac_var=yes" else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi +rm -rf conftest.dSYM rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi -ac_res=`eval echo '${'$as_ac_var'}'` - { echo "$as_me:$LINENO: result: $ac_res" >&5 -echo "${ECHO_T}$ac_res" >&6; } -if test `eval echo '${'$as_ac_var'}'` = yes; then +ac_res=`eval 'as_val=${'$as_ac_var'} + $as_echo "$as_val"'` + { $as_echo "$as_me:$LINENO: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +as_val=`eval 'as_val=${'$as_ac_var'} + $as_echo "$as_val"'` + if test "x$as_val" = x""yes; then cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi @@ -10754,11 +11554,11 @@ done for ac_func in expf logf sqrtf cosf sinf tanf sinhf coshf tanhf \ floorf ceilf fabsf frexpf ldexpf log1p log1pf log1pl do -as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` -{ echo "$as_me:$LINENO: checking for $ac_func" >&5 -echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } +as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` +{ $as_echo "$as_me:$LINENO: checking for $ac_func" >&5 +$as_echo_n "checking for $ac_func... " >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ @@ -10811,35 +11611,42 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err - } && test -s conftest$ac_exeext && - $as_test_x conftest$ac_exeext; then + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + $as_test_x conftest$ac_exeext + }; then eval "$as_ac_var=yes" else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi +rm -rf conftest.dSYM rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi -ac_res=`eval echo '${'$as_ac_var'}'` - { echo "$as_me:$LINENO: result: $ac_res" >&5 -echo "${ECHO_T}$ac_res" >&6; } -if test `eval echo '${'$as_ac_var'}'` = yes; then +ac_res=`eval 'as_val=${'$as_ac_var'} + $as_echo "$as_val"'` + { $as_echo "$as_me:$LINENO: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +as_val=`eval 'as_val=${'$as_ac_var'} + $as_echo "$as_val"'` + if test "x$as_val" = x""yes; then cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi @@ -10851,11 +11658,11 @@ done for ac_func in sched_yield uname fseeko do -as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` -{ echo "$as_me:$LINENO: checking for $ac_func" >&5 -echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } +as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` +{ $as_echo "$as_me:$LINENO: checking for $ac_func" >&5 +$as_echo_n "checking for $ac_func... " >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ @@ -10908,41 +11715,141 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err - } && test -s conftest$ac_exeext && - $as_test_x conftest$ac_exeext; then + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + $as_test_x conftest$ac_exeext + }; then eval "$as_ac_var=yes" else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi +rm -rf conftest.dSYM rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi -ac_res=`eval echo '${'$as_ac_var'}'` - { echo "$as_me:$LINENO: result: $ac_res" >&5 -echo "${ECHO_T}$ac_res" >&6; } -if test `eval echo '${'$as_ac_var'}'` = yes; then +ac_res=`eval 'as_val=${'$as_ac_var'} + $as_echo "$as_val"'` + { $as_echo "$as_me:$LINENO: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +as_val=`eval 'as_val=${'$as_ac_var'} + $as_echo "$as_val"'` + if test "x$as_val" = x""yes; then cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done +{ $as_echo "$as_me:$LINENO: checking for mprotect" >&5 +$as_echo_n "checking for mprotect... " >&6; } +if test "${ac_cv_func_mprotect+set}" = set; then + $as_echo_n "(cached) " >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +/* Define mprotect to an innocuous variant, in case declares mprotect. + For example, HP-UX 11i declares gettimeofday. */ +#define mprotect innocuous_mprotect + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char mprotect (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef mprotect + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char mprotect (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined __stub_mprotect || defined __stub___mprotect +choke me +#endif + +int +main () +{ +return mprotect (); + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext conftest$ac_exeext +if { (ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_link") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + $as_test_x conftest$ac_exeext + }; then + ac_cv_func_mprotect=yes +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_func_mprotect=no +fi + +rm -rf conftest.dSYM +rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ + conftest$ac_exeext conftest.$ac_ext +fi +{ $as_echo "$as_me:$LINENO: result: $ac_cv_func_mprotect" >&5 +$as_echo "$ac_cv_func_mprotect" >&6; } +if test "x$ac_cv_func_mprotect" = x""yes; then + cat >>confdefs.h <<\_ACEOF +#define ECL_USE_MPROTECT 1 +_ACEOF + +fi + + if test ${with_cxx} = "no" ; then @@ -11097,8 +12004,8 @@ fi case "${enable_boehm}" in included) - { echo "$as_me:$LINENO: Configuring included Boehm GC library:" >&5 -echo "$as_me: Configuring included Boehm GC library:" >&6;} + { $as_echo "$as_me:$LINENO: Configuring included Boehm GC library:" >&5 +$as_echo "$as_me: Configuring included Boehm GC library:" >&6;} test -d gc && rm -rf gc if mkdir gc; then (destdir=`${PWDCMD}`; cd gc; \ @@ -11108,24 +12015,24 @@ echo "$as_me: Configuring included Boehm GC library:" >&6;} --host=${host_alias} ${boehm_configure_flags}) ECL_BOEHM_GC_HEADER='ecl/gc/gc.h' else - { { echo "$as_me:$LINENO: error: Unable to create 'gc' directory" >&5 -echo "$as_me: error: Unable to create 'gc' directory" >&2;} + { { $as_echo "$as_me:$LINENO: error: Unable to create 'gc' directory" >&5 +$as_echo "$as_me: error: Unable to create 'gc' directory" >&2;} { (exit 1); exit 1; }; } fi ;; system) if test "${ac_cv_header_gc_h+set}" = set; then - { echo "$as_me:$LINENO: checking for gc.h" >&5 -echo $ECHO_N "checking for gc.h... $ECHO_C" >&6; } + { $as_echo "$as_me:$LINENO: checking for gc.h" >&5 +$as_echo_n "checking for gc.h... " >&6; } if test "${ac_cv_header_gc_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 fi -{ echo "$as_me:$LINENO: result: $ac_cv_header_gc_h" >&5 -echo "${ECHO_T}$ac_cv_header_gc_h" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_header_gc_h" >&5 +$as_echo "$ac_cv_header_gc_h" >&6; } else # Is the header compilable? -{ echo "$as_me:$LINENO: checking gc.h usability" >&5 -echo $ECHO_N "checking gc.h usability... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking gc.h usability" >&5 +$as_echo_n "checking gc.h usability... " >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF @@ -11141,32 +12048,33 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ac_header_compiler=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -{ echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 -echo "${ECHO_T}$ac_header_compiler" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +$as_echo "$ac_header_compiler" >&6; } # Is the header present? -{ echo "$as_me:$LINENO: checking gc.h presence" >&5 -echo $ECHO_N "checking gc.h presence... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking gc.h presence" >&5 +$as_echo_n "checking gc.h presence... " >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF @@ -11180,83 +12088,84 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null && { test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || test ! -s conftest.err }; then ac_header_preproc=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext -{ echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 -echo "${ECHO_T}$ac_header_preproc" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +$as_echo "$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) - { echo "$as_me:$LINENO: WARNING: gc.h: accepted by the compiler, rejected by the preprocessor!" >&5 -echo "$as_me: WARNING: gc.h: accepted by the compiler, rejected by the preprocessor!" >&2;} - { echo "$as_me:$LINENO: WARNING: gc.h: proceeding with the compiler's result" >&5 -echo "$as_me: WARNING: gc.h: proceeding with the compiler's result" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: gc.h: accepted by the compiler, rejected by the preprocessor!" >&5 +$as_echo "$as_me: WARNING: gc.h: accepted by the compiler, rejected by the preprocessor!" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: gc.h: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: gc.h: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) - { echo "$as_me:$LINENO: WARNING: gc.h: present but cannot be compiled" >&5 -echo "$as_me: WARNING: gc.h: present but cannot be compiled" >&2;} - { echo "$as_me:$LINENO: WARNING: gc.h: check for missing prerequisite headers?" >&5 -echo "$as_me: WARNING: gc.h: check for missing prerequisite headers?" >&2;} - { echo "$as_me:$LINENO: WARNING: gc.h: see the Autoconf documentation" >&5 -echo "$as_me: WARNING: gc.h: see the Autoconf documentation" >&2;} - { echo "$as_me:$LINENO: WARNING: gc.h: section \"Present But Cannot Be Compiled\"" >&5 -echo "$as_me: WARNING: gc.h: section \"Present But Cannot Be Compiled\"" >&2;} - { echo "$as_me:$LINENO: WARNING: gc.h: proceeding with the preprocessor's result" >&5 -echo "$as_me: WARNING: gc.h: proceeding with the preprocessor's result" >&2;} - { echo "$as_me:$LINENO: WARNING: gc.h: in the future, the compiler will take precedence" >&5 -echo "$as_me: WARNING: gc.h: in the future, the compiler will take precedence" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: gc.h: present but cannot be compiled" >&5 +$as_echo "$as_me: WARNING: gc.h: present but cannot be compiled" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: gc.h: check for missing prerequisite headers?" >&5 +$as_echo "$as_me: WARNING: gc.h: check for missing prerequisite headers?" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: gc.h: see the Autoconf documentation" >&5 +$as_echo "$as_me: WARNING: gc.h: see the Autoconf documentation" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: gc.h: section \"Present But Cannot Be Compiled\"" >&5 +$as_echo "$as_me: WARNING: gc.h: section \"Present But Cannot Be Compiled\"" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: gc.h: proceeding with the preprocessor's result" >&5 +$as_echo "$as_me: WARNING: gc.h: proceeding with the preprocessor's result" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: gc.h: in the future, the compiler will take precedence" >&5 +$as_echo "$as_me: WARNING: gc.h: in the future, the compiler will take precedence" >&2;} ;; esac -{ echo "$as_me:$LINENO: checking for gc.h" >&5 -echo $ECHO_N "checking for gc.h... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for gc.h" >&5 +$as_echo_n "checking for gc.h... " >&6; } if test "${ac_cv_header_gc_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else ac_cv_header_gc_h=$ac_header_preproc fi -{ echo "$as_me:$LINENO: result: $ac_cv_header_gc_h" >&5 -echo "${ECHO_T}$ac_cv_header_gc_h" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_header_gc_h" >&5 +$as_echo "$ac_cv_header_gc_h" >&6; } fi -if test $ac_cv_header_gc_h = yes; then +if test "x$ac_cv_header_gc_h" = x""yes; then ECL_BOEHM_GC_HEADER='gc.h' fi if test -z "$ECL_BOEHM_GC_HEADER"; then if test "${ac_cv_header_gc_gc_h+set}" = set; then - { echo "$as_me:$LINENO: checking for gc/gc.h" >&5 -echo $ECHO_N "checking for gc/gc.h... $ECHO_C" >&6; } + { $as_echo "$as_me:$LINENO: checking for gc/gc.h" >&5 +$as_echo_n "checking for gc/gc.h... " >&6; } if test "${ac_cv_header_gc_gc_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 fi -{ echo "$as_me:$LINENO: result: $ac_cv_header_gc_gc_h" >&5 -echo "${ECHO_T}$ac_cv_header_gc_gc_h" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_header_gc_gc_h" >&5 +$as_echo "$ac_cv_header_gc_gc_h" >&6; } else # Is the header compilable? -{ echo "$as_me:$LINENO: checking gc/gc.h usability" >&5 -echo $ECHO_N "checking gc/gc.h usability... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking gc/gc.h usability" >&5 +$as_echo_n "checking gc/gc.h usability... " >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF @@ -11272,32 +12181,33 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ac_header_compiler=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -{ echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 -echo "${ECHO_T}$ac_header_compiler" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +$as_echo "$ac_header_compiler" >&6; } # Is the header present? -{ echo "$as_me:$LINENO: checking gc/gc.h presence" >&5 -echo $ECHO_N "checking gc/gc.h presence... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking gc/gc.h presence" >&5 +$as_echo_n "checking gc/gc.h presence... " >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF @@ -11311,89 +12221,90 @@ case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null && { test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || test ! -s conftest.err }; then ac_header_preproc=yes else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext -{ echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 -echo "${ECHO_T}$ac_header_preproc" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +$as_echo "$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) - { echo "$as_me:$LINENO: WARNING: gc/gc.h: accepted by the compiler, rejected by the preprocessor!" >&5 -echo "$as_me: WARNING: gc/gc.h: accepted by the compiler, rejected by the preprocessor!" >&2;} - { echo "$as_me:$LINENO: WARNING: gc/gc.h: proceeding with the compiler's result" >&5 -echo "$as_me: WARNING: gc/gc.h: proceeding with the compiler's result" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: gc/gc.h: accepted by the compiler, rejected by the preprocessor!" >&5 +$as_echo "$as_me: WARNING: gc/gc.h: accepted by the compiler, rejected by the preprocessor!" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: gc/gc.h: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: gc/gc.h: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) - { echo "$as_me:$LINENO: WARNING: gc/gc.h: present but cannot be compiled" >&5 -echo "$as_me: WARNING: gc/gc.h: present but cannot be compiled" >&2;} - { echo "$as_me:$LINENO: WARNING: gc/gc.h: check for missing prerequisite headers?" >&5 -echo "$as_me: WARNING: gc/gc.h: check for missing prerequisite headers?" >&2;} - { echo "$as_me:$LINENO: WARNING: gc/gc.h: see the Autoconf documentation" >&5 -echo "$as_me: WARNING: gc/gc.h: see the Autoconf documentation" >&2;} - { echo "$as_me:$LINENO: WARNING: gc/gc.h: section \"Present But Cannot Be Compiled\"" >&5 -echo "$as_me: WARNING: gc/gc.h: section \"Present But Cannot Be Compiled\"" >&2;} - { echo "$as_me:$LINENO: WARNING: gc/gc.h: proceeding with the preprocessor's result" >&5 -echo "$as_me: WARNING: gc/gc.h: proceeding with the preprocessor's result" >&2;} - { echo "$as_me:$LINENO: WARNING: gc/gc.h: in the future, the compiler will take precedence" >&5 -echo "$as_me: WARNING: gc/gc.h: in the future, the compiler will take precedence" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: gc/gc.h: present but cannot be compiled" >&5 +$as_echo "$as_me: WARNING: gc/gc.h: present but cannot be compiled" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: gc/gc.h: check for missing prerequisite headers?" >&5 +$as_echo "$as_me: WARNING: gc/gc.h: check for missing prerequisite headers?" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: gc/gc.h: see the Autoconf documentation" >&5 +$as_echo "$as_me: WARNING: gc/gc.h: see the Autoconf documentation" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: gc/gc.h: section \"Present But Cannot Be Compiled\"" >&5 +$as_echo "$as_me: WARNING: gc/gc.h: section \"Present But Cannot Be Compiled\"" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: gc/gc.h: proceeding with the preprocessor's result" >&5 +$as_echo "$as_me: WARNING: gc/gc.h: proceeding with the preprocessor's result" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: gc/gc.h: in the future, the compiler will take precedence" >&5 +$as_echo "$as_me: WARNING: gc/gc.h: in the future, the compiler will take precedence" >&2;} ;; esac -{ echo "$as_me:$LINENO: checking for gc/gc.h" >&5 -echo $ECHO_N "checking for gc/gc.h... $ECHO_C" >&6; } +{ $as_echo "$as_me:$LINENO: checking for gc/gc.h" >&5 +$as_echo_n "checking for gc/gc.h... " >&6; } if test "${ac_cv_header_gc_gc_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo_n "(cached) " >&6 else ac_cv_header_gc_gc_h=$ac_header_preproc fi -{ echo "$as_me:$LINENO: result: $ac_cv_header_gc_gc_h" >&5 -echo "${ECHO_T}$ac_cv_header_gc_gc_h" >&6; } +{ $as_echo "$as_me:$LINENO: result: $ac_cv_header_gc_gc_h" >&5 +$as_echo "$ac_cv_header_gc_gc_h" >&6; } fi -if test $ac_cv_header_gc_gc_h = yes; then +if test "x$ac_cv_header_gc_gc_h" = x""yes; then ECL_BOEHM_GC_HEADER='gc/gc.h' fi fi if test -z "$ECL_BOEHM_GC_HEADER"; then - { { echo "$as_me:$LINENO: error: Boehm-Weiser garbage collector's headers not found" >&5 -echo "$as_me: error: Boehm-Weiser garbage collector's headers not found" >&2;} + { { $as_echo "$as_me:$LINENO: error: Boehm-Weiser garbage collector's headers not found" >&5 +$as_echo "$as_me: error: Boehm-Weiser garbage collector's headers not found" >&2;} { (exit 1); exit 1; }; } fi ;; no) ECL_BOEHM_GC_HEADER='none';; *) - { { echo "$as_me:$LINENO: error: Not a valid argument for --enable-boehm $enable_boehm" >&5 -echo "$as_me: error: Not a valid argument for --enable-boehm $enable_boehm" >&2;} + { { $as_echo "$as_me:$LINENO: error: Not a valid argument for --enable-boehm $enable_boehm" >&5 +$as_echo "$as_me: error: Not a valid argument for --enable-boehm $enable_boehm" >&2;} { (exit 1); exit 1; }; };; esac if test "${with_gmp}" = "no" ; then - { echo "$as_me:$LINENO: Not using GMP library at all. Are you sure?" >&5 -echo "$as_me: Not using GMP library at all. Are you sure?" >&6;} + { $as_echo "$as_me:$LINENO: Not using GMP library at all. Are you sure?" >&5 +$as_echo "$as_me: Not using GMP library at all. Are you sure?" >&6;} EXTRA_OBJS="${EXTRA_OBJS} big_ll.o" ECL_GMP_HEADER='nofile' else @@ -11405,8 +12316,8 @@ _ACEOF EXTRA_OBJS="${EXTRA_OBJS} big.o" ECL_GMP_HEADER='gmp.h' if test "${with_system_gmp}" = "no" ; then - { echo "$as_me:$LINENO: Configuring included GMP library:" >&5 -echo "$as_me: Configuring included GMP library:" >&6;} + { $as_echo "$as_me:$LINENO: Configuring included GMP library:" >&5 +$as_echo "$as_me: Configuring included GMP library:" >&6;} test -d gmp && rm -rf gmp if test -z "$gmp_build"; then gmp_build="${build_alias}" @@ -11453,11 +12364,12 @@ _ACEOF case $ac_val in #( *${as_nl}*) case $ac_var in #( - *_cv_*) { echo "$as_me:$LINENO: WARNING: Cache variable $ac_var contains a newline." >&5 -echo "$as_me: WARNING: Cache variable $ac_var contains a newline." >&2;} ;; + *_cv_*) { $as_echo "$as_me:$LINENO: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( *) $as_unset $ac_var ;; esac ;; esac @@ -11490,12 +12402,12 @@ echo "$as_me: WARNING: Cache variable $ac_var contains a newline." >&2;} ;; if diff "$cache_file" confcache >/dev/null 2>&1; then :; else if test -w "$cache_file"; then test "x$cache_file" != "x/dev/null" && - { echo "$as_me:$LINENO: updating cache $cache_file" >&5 -echo "$as_me: updating cache $cache_file" >&6;} + { $as_echo "$as_me:$LINENO: updating cache $cache_file" >&5 +$as_echo "$as_me: updating cache $cache_file" >&6;} cat confcache >$cache_file else - { echo "$as_me:$LINENO: not updating unwritable cache $cache_file" >&5 -echo "$as_me: not updating unwritable cache $cache_file" >&6;} + { $as_echo "$as_me:$LINENO: not updating unwritable cache $cache_file" >&5 +$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;} fi fi rm -f confcache @@ -11511,7 +12423,7 @@ ac_ltlibobjs= for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue # 1. Remove the extension, and $U if already installed. ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' - ac_i=`echo "$ac_i" | sed "$ac_script"` + ac_i=`$as_echo "$ac_i" | sed "$ac_script"` # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR # will be set to the directory where LIBOBJS objects are built. ac_libobjs="$ac_libobjs \${LIBOBJDIR}$ac_i\$U.$ac_objext" @@ -11523,12 +12435,14 @@ LTLIBOBJS=$ac_ltlibobjs + : ${CONFIG_STATUS=./config.status} +ac_write_fail=0 ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" -{ echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5 -echo "$as_me: creating $CONFIG_STATUS" >&6;} -cat >$CONFIG_STATUS <<_ACEOF +{ $as_echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5 +$as_echo "$as_me: creating $CONFIG_STATUS" >&6;} +cat >$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 #! $SHELL # Generated by $as_me. # Run this file to recreate the current configuration. @@ -11541,7 +12455,7 @@ ac_cs_silent=false SHELL=\${CONFIG_SHELL-$SHELL} _ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## @@ -11551,7 +12465,7 @@ DUALCASE=1; export DUALCASE # for MKS sh if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: - # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST @@ -11573,17 +12487,45 @@ as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +if (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then - echo "#! /bin/sh" >conf$$.sh - echo "exit 0" >>conf$$.sh - chmod +x conf$$.sh - if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then - PATH_SEPARATOR=';' - else - PATH_SEPARATOR=: - fi - rm -f conf$$.sh + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } fi # Support unset when possible. @@ -11599,8 +12541,6 @@ fi # there to prevent editors from complaining about space-tab. # (If _AS_PATH_WALK were called with IFS unset, it would disable word # splitting by setting IFS to empty value.) -as_nl=' -' IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. @@ -11623,7 +12563,7 @@ if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then - echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 { (exit 1); exit 1; } fi @@ -11636,17 +12576,10 @@ PS2='> ' PS4='+ ' # NLS nuisances. -for as_var in \ - LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ - LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ - LC_TELEPHONE LC_TIME -do - if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then - eval $as_var=C; export $as_var - else - ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var - fi -done +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1 && @@ -11668,7 +12601,7 @@ as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || -echo X/"$0" | +$as_echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q @@ -11719,7 +12652,7 @@ $as_unset CDPATH s/-\n.*// ' >$as_me.lineno && chmod +x "$as_me.lineno" || - { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 + { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems @@ -11747,7 +12680,6 @@ case `echo -n x` in *) ECHO_N='-n';; esac - if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr @@ -11760,19 +12692,22 @@ if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir - mkdir conf$$.dir + mkdir conf$$.dir 2>/dev/null fi -echo >conf$$.file -if ln -s conf$$.file conf$$ 2>/dev/null; then - as_ln_s='ln -s' - # ... but there are two gotchas: - # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. - # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. - # In both cases, we have to default to `cp -p'. - ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -p'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -p' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else as_ln_s='cp -p' -elif ln conf$$.file conf$$ 2>/dev/null; then - as_ln_s=ln + fi else as_ln_s='cp -p' fi @@ -11797,10 +12732,10 @@ else as_test_x=' eval sh -c '\'' if test -d "$1"; then - test -d "$1/."; + test -d "$1/."; else case $1 in - -*)set "./$1";; + -*)set "./$1";; esac; case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in ???[sx]*):;;*)false;;esac;fi @@ -11823,7 +12758,7 @@ exec 6>&1 # values after options handling. ac_log=" This file was extended by ecl $as_me 8.10.0, which was -generated by GNU Autoconf 2.61. Invocation command line was +generated by GNU Autoconf 2.63. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS @@ -11836,29 +12771,39 @@ on `(hostname || uname -n) 2>/dev/null | sed 1q` _ACEOF -cat >>$CONFIG_STATUS <<_ACEOF +case $ac_config_files in *" +"*) set x $ac_config_files; shift; ac_config_files=$*;; +esac + +case $ac_config_headers in *" +"*) set x $ac_config_headers; shift; ac_config_headers=$*;; +esac + + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 # Files that config.status was made for. config_files="$ac_config_files" config_headers="$ac_config_headers" _ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 ac_cs_usage="\ \`$as_me' instantiates files from templates according to the current configuration. -Usage: $0 [OPTIONS] [FILE]... +Usage: $0 [OPTION]... [FILE]... -h, --help print this help, then exit -V, --version print version number and configuration settings, then exit - -q, --quiet do not print progress messages + -q, --quiet, --silent + do not print progress messages -d, --debug don't remove temporary files --recheck update $as_me by reconfiguring in the same conditions - --file=FILE[:TEMPLATE] - instantiate the configuration file FILE - --header=FILE[:TEMPLATE] - instantiate the configuration header FILE + --file=FILE[:TEMPLATE] + instantiate the configuration file FILE + --header=FILE[:TEMPLATE] + instantiate the configuration header FILE Configuration files: $config_files @@ -11869,24 +12814,24 @@ $config_headers Report bugs to ." _ACEOF -cat >>$CONFIG_STATUS <<_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_version="\\ ecl config.status 8.10.0 -configured by $0, generated by GNU Autoconf 2.61, - with options \\"`echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\" +configured by $0, generated by GNU Autoconf 2.63, + with options \\"`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\" -Copyright (C) 2006 Free Software Foundation, Inc. +Copyright (C) 2008 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." ac_pwd='$ac_pwd' srcdir='$srcdir' INSTALL='$INSTALL' +test -n "\$AWK" || AWK=awk _ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF -# If no file are specified by the user, then we need to provide default -# value. By we need to know if files were specified by the user. +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# The default lists apply if the user does not specify any file. ac_need_defaults=: while test $# != 0 do @@ -11908,30 +12853,36 @@ do -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) ac_cs_recheck=: ;; --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) - echo "$ac_cs_version"; exit ;; + $as_echo "$ac_cs_version"; exit ;; --debug | --debu | --deb | --de | --d | -d ) debug=: ;; --file | --fil | --fi | --f ) $ac_shift - CONFIG_FILES="$CONFIG_FILES $ac_optarg" + case $ac_optarg in + *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + CONFIG_FILES="$CONFIG_FILES '$ac_optarg'" ac_need_defaults=false;; --header | --heade | --head | --hea ) $ac_shift - CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg" + case $ac_optarg in + *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + CONFIG_HEADERS="$CONFIG_HEADERS '$ac_optarg'" ac_need_defaults=false;; --he | --h) # Conflict between --help and --header - { echo "$as_me: error: ambiguous option: $1 + { $as_echo "$as_me: error: ambiguous option: $1 Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; };; --help | --hel | -h ) - echo "$ac_cs_usage"; exit ;; + $as_echo "$ac_cs_usage"; exit ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil | --si | --s) ac_cs_silent=: ;; # This is an error. - -*) { echo "$as_me: error: unrecognized option: $1 + -*) { $as_echo "$as_me: error: unrecognized option: $1 Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; } ;; @@ -11950,30 +12901,32 @@ if $ac_cs_silent; then fi _ACEOF -cat >>$CONFIG_STATUS <<_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 if \$ac_cs_recheck; then - echo "running CONFIG_SHELL=$SHELL $SHELL $0 "$ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6 - CONFIG_SHELL=$SHELL + set X '$SHELL' '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion + shift + \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6 + CONFIG_SHELL='$SHELL' export CONFIG_SHELL - exec $SHELL "$0"$ac_configure_args \$ac_configure_extra_args --no-create --no-recursion + exec "\$@" fi _ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 exec 5>>config.log { echo sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX ## Running $as_me. ## _ASBOX - echo "$ac_log" + $as_echo "$ac_log" } >&5 _ACEOF -cat >>$CONFIG_STATUS <<_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 _ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # Handling of arguments. for ac_config_target in $ac_config_targets @@ -11996,8 +12949,8 @@ do "cmp/cmpdefs.pre") CONFIG_FILES="$CONFIG_FILES cmp/cmpdefs.pre:cmp/cmpdefs.lsp" ;; "ecl/config.h") CONFIG_HEADERS="$CONFIG_HEADERS ecl/config.h:ecl/configpre.h" ;; - *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 -echo "$as_me: error: invalid argument: $ac_config_target" >&2;} + *) { { $as_echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 +$as_echo "$as_me: error: invalid argument: $ac_config_target" >&2;} { (exit 1); exit 1; }; };; esac done @@ -12037,225 +12990,143 @@ $debug || (umask 077 && mkdir "$tmp") } || { - echo "$me: cannot create a temporary directory in ." >&2 + $as_echo "$as_me: cannot create a temporary directory in ." >&2 { (exit 1); exit 1; } } -# -# Set up the sed scripts for CONFIG_FILES section. -# - -# No need to generate the scripts if there are no CONFIG_FILES. -# This happens for instance when ./config.status config.h +# Set up the scripts for CONFIG_FILES section. +# No need to generate them if there are no CONFIG_FILES. +# This happens for instance with `./config.status config.h'. if test -n "$CONFIG_FILES"; then + +ac_cr=' ' +ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' /dev/null` +if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then + ac_cs_awk_cr='\\r' +else + ac_cs_awk_cr=$ac_cr +fi + +echo 'BEGIN {' >"$tmp/subs1.awk" && _ACEOF - +{ + echo "cat >conf$$subs.awk <<_ACEOF" && + echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && + echo "_ACEOF" +} >conf$$subs.sh || + { { $as_echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5 +$as_echo "$as_me: error: could not make $CONFIG_STATUS" >&2;} + { (exit 1); exit 1; }; } +ac_delim_num=`echo "$ac_subst_vars" | grep -c '$'` ac_delim='%!_!# ' for ac_last_try in false false false false false :; do - cat >conf$$subs.sed <<_ACEOF -SHELL!$SHELL$ac_delim -PATH_SEPARATOR!$PATH_SEPARATOR$ac_delim -PACKAGE_NAME!$PACKAGE_NAME$ac_delim -PACKAGE_TARNAME!$PACKAGE_TARNAME$ac_delim -PACKAGE_VERSION!$PACKAGE_VERSION$ac_delim -PACKAGE_STRING!$PACKAGE_STRING$ac_delim -PACKAGE_BUGREPORT!$PACKAGE_BUGREPORT$ac_delim -exec_prefix!$exec_prefix$ac_delim -prefix!$prefix$ac_delim -program_transform_name!$program_transform_name$ac_delim -bindir!$bindir$ac_delim -sbindir!$sbindir$ac_delim -libexecdir!$libexecdir$ac_delim -datarootdir!$datarootdir$ac_delim -datadir!$datadir$ac_delim -sysconfdir!$sysconfdir$ac_delim -sharedstatedir!$sharedstatedir$ac_delim -localstatedir!$localstatedir$ac_delim -includedir!$includedir$ac_delim -oldincludedir!$oldincludedir$ac_delim -docdir!$docdir$ac_delim -infodir!$infodir$ac_delim -htmldir!$htmldir$ac_delim -dvidir!$dvidir$ac_delim -pdfdir!$pdfdir$ac_delim -psdir!$psdir$ac_delim -libdir!$libdir$ac_delim -localedir!$localedir$ac_delim -mandir!$mandir$ac_delim -DEFS!$DEFS$ac_delim -ECHO_C!$ECHO_C$ac_delim -ECHO_N!$ECHO_N$ac_delim -ECHO_T!$ECHO_T$ac_delim -LIBS!$LIBS$ac_delim -build_alias!$build_alias$ac_delim -host_alias!$host_alias$ac_delim -target_alias!$target_alias$ac_delim -ecldir!$ecldir$ac_delim -buildir!$buildir$ac_delim -ECL_CFLAGS!$ECL_CFLAGS$ac_delim -DEBUG_CFLAGS!$DEBUG_CFLAGS$ac_delim -GMP_CFLAGS!$GMP_CFLAGS$ac_delim -GMP_LDFLAGS!$GMP_LDFLAGS$ac_delim -FASL_LIBS!$FASL_LIBS$ac_delim -CORE_LIBS!$CORE_LIBS$ac_delim -SHARED_LDFLAGS!$SHARED_LDFLAGS$ac_delim -BUNDLE_LDFLAGS!$BUNDLE_LDFLAGS$ac_delim -EXTRA_OBJS!$EXTRA_OBJS$ac_delim -TARGETS!$TARGETS$ac_delim -SUBDIRS!$SUBDIRS$ac_delim -LIBRARIES!$LIBRARIES$ac_delim -LSP_LIBRARIES!$LSP_LIBRARIES$ac_delim -LSP_FEATURES!$LSP_FEATURES$ac_delim -build!$build$ac_delim -build_cpu!$build_cpu$ac_delim -build_vendor!$build_vendor$ac_delim -build_os!$build_os$ac_delim -host!$host$ac_delim -host_cpu!$host_cpu$ac_delim -host_vendor!$host_vendor$ac_delim -host_os!$host_os$ac_delim -CC!$CC$ac_delim -CFLAGS!$CFLAGS$ac_delim -LDFLAGS!$LDFLAGS$ac_delim -CPPFLAGS!$CPPFLAGS$ac_delim -ac_ct_CC!$ac_ct_CC$ac_delim -EXEEXT!$EXEEXT$ac_delim -OBJEXT!$OBJEXT$ac_delim -CXX!$CXX$ac_delim -CXXFLAGS!$CXXFLAGS$ac_delim -ac_ct_CXX!$ac_ct_CXX$ac_delim -CPP!$CPP$ac_delim -RANLIB!$RANLIB$ac_delim -INSTALL_PROGRAM!$INSTALL_PROGRAM$ac_delim -INSTALL_SCRIPT!$INSTALL_SCRIPT$ac_delim -INSTALL_DATA!$INSTALL_DATA$ac_delim -LN_S!$LN_S$ac_delim -SET_MAKE!$SET_MAKE$ac_delim -true_srcdir!$true_srcdir$ac_delim -true_builddir!$true_builddir$ac_delim -CP!$CP$ac_delim -RM!$RM$ac_delim -MV!$MV$ac_delim -EXE_SUFFIX!$EXE_SUFFIX$ac_delim -ARCHITECTURE!$ARCHITECTURE$ac_delim -SOFTWARE_TYPE!$SOFTWARE_TYPE$ac_delim -SOFTWARE_VERSION!$SOFTWARE_VERSION$ac_delim -MACHINE_VERSION!$MACHINE_VERSION$ac_delim -LDRPATH!$LDRPATH$ac_delim -LIBPREFIX!$LIBPREFIX$ac_delim -LIBEXT!$LIBEXT$ac_delim -SHAREDEXT!$SHAREDEXT$ac_delim -SHAREDPREFIX!$SHAREDPREFIX$ac_delim -INSTALL_TARGET!$INSTALL_TARGET$ac_delim -thehost!$thehost$ac_delim -INFOEXT!$INFOEXT$ac_delim -INSTALL_INFO!$INSTALL_INFO$ac_delim -_ACEOF + . ./conf$$subs.sh || + { { $as_echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5 +$as_echo "$as_me: error: could not make $CONFIG_STATUS" >&2;} + { (exit 1); exit 1; }; } - if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 97; then + ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` + if test $ac_delim_n = $ac_delim_num; then break elif $ac_last_try; then - { { echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5 -echo "$as_me: error: could not make $CONFIG_STATUS" >&2;} + { { $as_echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5 +$as_echo "$as_me: error: could not make $CONFIG_STATUS" >&2;} { (exit 1); exit 1; }; } else ac_delim="$ac_delim!$ac_delim _$ac_delim!! " fi done +rm -f conf$$subs.sh -ac_eof=`sed -n '/^CEOF[0-9]*$/s/CEOF/0/p' conf$$subs.sed` -if test -n "$ac_eof"; then - ac_eof=`echo "$ac_eof" | sort -nru | sed 1q` - ac_eof=`expr $ac_eof + 1` -fi - -cat >>$CONFIG_STATUS <<_ACEOF -cat >"\$tmp/subs-1.sed" <<\CEOF$ac_eof -/@[a-zA-Z_][a-zA-Z_0-9]*@/!b +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +cat >>"\$tmp/subs1.awk" <<\\_ACAWK && _ACEOF -sed ' -s/[,\\&]/\\&/g; s/@/@|#_!!_#|/g -s/^/s,@/; s/!/@,|#_!!_#|/ -:n -t n -s/'"$ac_delim"'$/,g/; t -s/$/\\/; p -N; s/^.*\n//; s/[,\\&]/\\&/g; s/@/@|#_!!_#|/g; b n -' >>$CONFIG_STATUS >$CONFIG_STATUS <<_ACEOF -CEOF$ac_eof +sed -n ' +h +s/^/S["/; s/!.*/"]=/ +p +g +s/^[^!]*!// +:repl +t repl +s/'"$ac_delim"'$// +t delim +:nl +h +s/\(.\{148\}\).*/\1/ +t more1 +s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ +p +n +b repl +:more1 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t nl +:delim +h +s/\(.\{148\}\).*/\1/ +t more2 +s/["\\]/\\&/g; s/^/"/; s/$/"/ +p +b +:more2 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t delim +' >$CONFIG_STATUS || ac_write_fail=1 +rm -f conf$$subs.awk +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACAWK +cat >>"\$tmp/subs1.awk" <<_ACAWK && + for (key in S) S_is_set[key] = 1 + FS = "" + +} +{ + line = $ 0 + nfields = split(line, field, "@") + substed = 0 + len = length(field[1]) + for (i = 2; i < nfields; i++) { + key = field[i] + keylen = length(key) + if (S_is_set[key]) { + value = S[key] + line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) + len += length(value) + length(field[++i]) + substed = 1 + } else + len += 1 + keylen + } + + print line +} + +_ACAWK _ACEOF - - -ac_delim='%!_!# ' -for ac_last_try in false false false false false :; do - cat >conf$$subs.sed <<_ACEOF -SONAME3!$SONAME3$ac_delim -SONAME2!$SONAME2$ac_delim -SONAME1!$SONAME1$ac_delim -SONAME!$SONAME$ac_delim -SONAME_LDFLAGS!$SONAME_LDFLAGS$ac_delim -XMKMF!$XMKMF$ac_delim -GREP!$GREP$ac_delim -EGREP!$EGREP$ac_delim -CL_FIXNUM_TYPE!$CL_FIXNUM_TYPE$ac_delim -CL_FIXNUM_BITS!$CL_FIXNUM_BITS$ac_delim -CL_FIXNUM_MAX!$CL_FIXNUM_MAX$ac_delim -CL_FIXNUM_MIN!$CL_FIXNUM_MIN$ac_delim -ECL_SETJMP!$ECL_SETJMP$ac_delim -ECL_LONGJMP!$ECL_LONGJMP$ac_delim -ECL_FILE_CNT!$ECL_FILE_CNT$ac_delim -ECL_FPE_CODE!$ECL_FPE_CODE$ac_delim -LIBOBJS!$LIBOBJS$ac_delim -POW_LIB!$POW_LIB$ac_delim -ECL_CC!$ECL_CC$ac_delim -CLX_INFO!$CLX_INFO$ac_delim -ECL_BOEHM_GC_HEADER!$ECL_BOEHM_GC_HEADER$ac_delim -ECL_GMP_HEADER!$ECL_GMP_HEADER$ac_delim -LTLIBOBJS!$LTLIBOBJS$ac_delim -_ACEOF - - if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 23; then - break - elif $ac_last_try; then - { { echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5 -echo "$as_me: error: could not make $CONFIG_STATUS" >&2;} +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then + sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" +else + cat +fi < "$tmp/subs1.awk" > "$tmp/subs.awk" \ + || { { $as_echo "$as_me:$LINENO: error: could not setup config files machinery" >&5 +$as_echo "$as_me: error: could not setup config files machinery" >&2;} { (exit 1); exit 1; }; } - else - ac_delim="$ac_delim!$ac_delim _$ac_delim!! " - fi -done - -ac_eof=`sed -n '/^CEOF[0-9]*$/s/CEOF/0/p' conf$$subs.sed` -if test -n "$ac_eof"; then - ac_eof=`echo "$ac_eof" | sort -nru | sed 1q` - ac_eof=`expr $ac_eof + 1` -fi - -cat >>$CONFIG_STATUS <<_ACEOF -cat >"\$tmp/subs-2.sed" <<\CEOF$ac_eof -/@[a-zA-Z_][a-zA-Z_0-9]*@/!b end _ACEOF -sed ' -s/[,\\&]/\\&/g; s/@/@|#_!!_#|/g -s/^/s,@/; s/!/@,|#_!!_#|/ -:n -t n -s/'"$ac_delim"'$/,g/; t -s/$/\\/; p -N; s/^.*\n//; s/[,\\&]/\\&/g; s/@/@|#_!!_#|/g; b n -' >>$CONFIG_STATUS >$CONFIG_STATUS <<_ACEOF -:end -s/|#_!!_#|//g -CEOF$ac_eof -_ACEOF - # VPATH may cause trouble with some makes, so we remove $(srcdir), # ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and @@ -12272,19 +13143,133 @@ s/^[^=]*=[ ]*$// }' fi -cat >>$CONFIG_STATUS <<\_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 fi # test -n "$CONFIG_FILES" +# Set up the scripts for CONFIG_HEADERS section. +# No need to generate them if there are no CONFIG_HEADERS. +# This happens for instance with `./config.status Makefile'. +if test -n "$CONFIG_HEADERS"; then +cat >"$tmp/defines.awk" <<\_ACAWK || +BEGIN { +_ACEOF -for ac_tag in :F $CONFIG_FILES :H $CONFIG_HEADERS +# Transform confdefs.h into an awk script `defines.awk', embedded as +# here-document in config.status, that substitutes the proper values into +# config.h.in to produce config.h. + +# Create a delimiter string that does not exist in confdefs.h, to ease +# handling of long lines. +ac_delim='%!_!# ' +for ac_last_try in false false :; do + ac_t=`sed -n "/$ac_delim/p" confdefs.h` + if test -z "$ac_t"; then + break + elif $ac_last_try; then + { { $as_echo "$as_me:$LINENO: error: could not make $CONFIG_HEADERS" >&5 +$as_echo "$as_me: error: could not make $CONFIG_HEADERS" >&2;} + { (exit 1); exit 1; }; } + else + ac_delim="$ac_delim!$ac_delim _$ac_delim!! " + fi +done + +# For the awk script, D is an array of macro values keyed by name, +# likewise P contains macro parameters if any. Preserve backslash +# newline sequences. + +ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]* +sed -n ' +s/.\{148\}/&'"$ac_delim"'/g +t rset +:rset +s/^[ ]*#[ ]*define[ ][ ]*/ / +t def +d +:def +s/\\$// +t bsnl +s/["\\]/\\&/g +s/^ \('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/P["\1"]="\2"\ +D["\1"]=" \3"/p +s/^ \('"$ac_word_re"'\)[ ]*\(.*\)/D["\1"]=" \2"/p +d +:bsnl +s/["\\]/\\&/g +s/^ \('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/P["\1"]="\2"\ +D["\1"]=" \3\\\\\\n"\\/p +t cont +s/^ \('"$ac_word_re"'\)[ ]*\(.*\)/D["\1"]=" \2\\\\\\n"\\/p +t cont +d +:cont +n +s/.\{148\}/&'"$ac_delim"'/g +t clear +:clear +s/\\$// +t bsnlc +s/["\\]/\\&/g; s/^/"/; s/$/"/p +d +:bsnlc +s/["\\]/\\&/g; s/^/"/; s/$/\\\\\\n"\\/p +b cont +' >$CONFIG_STATUS || ac_write_fail=1 + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 + for (key in D) D_is_set[key] = 1 + FS = "" +} +/^[\t ]*#[\t ]*(define|undef)[\t ]+$ac_word_re([\t (]|\$)/ { + line = \$ 0 + split(line, arg, " ") + if (arg[1] == "#") { + defundef = arg[2] + mac1 = arg[3] + } else { + defundef = substr(arg[1], 2) + mac1 = arg[2] + } + split(mac1, mac2, "(") #) + macro = mac2[1] + prefix = substr(line, 1, index(line, defundef) - 1) + if (D_is_set[macro]) { + # Preserve the white space surrounding the "#". + print prefix "define", macro P[macro] D[macro] + next + } else { + # Replace #undef with comments. This is necessary, for example, + # in the case of _POSIX_SOURCE, which is predefined and required + # on some systems where configure will not decide to define it. + if (defundef == "undef") { + print "/*", prefix defundef, macro, "*/" + next + } + } +} +{ print } +_ACAWK +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 + { { $as_echo "$as_me:$LINENO: error: could not setup config headers machinery" >&5 +$as_echo "$as_me: error: could not setup config headers machinery" >&2;} + { (exit 1); exit 1; }; } +fi # test -n "$CONFIG_HEADERS" + + +eval set X " :F $CONFIG_FILES :H $CONFIG_HEADERS " +shift +for ac_tag do case $ac_tag in :[FHLC]) ac_mode=$ac_tag; continue;; esac case $ac_mode$ac_tag in :[FHL]*:*);; - :L* | :C*:*) { { echo "$as_me:$LINENO: error: Invalid tag $ac_tag." >&5 -echo "$as_me: error: Invalid tag $ac_tag." >&2;} + :L* | :C*:*) { { $as_echo "$as_me:$LINENO: error: invalid tag $ac_tag" >&5 +$as_echo "$as_me: error: invalid tag $ac_tag" >&2;} { (exit 1); exit 1; }; };; :[FH]-) ac_tag=-:-;; :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; @@ -12313,26 +13298,38 @@ echo "$as_me: error: Invalid tag $ac_tag." >&2;} [\\/$]*) false;; *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; esac || - { { echo "$as_me:$LINENO: error: cannot find input file: $ac_f" >&5 -echo "$as_me: error: cannot find input file: $ac_f" >&2;} + { { $as_echo "$as_me:$LINENO: error: cannot find input file: $ac_f" >&5 +$as_echo "$as_me: error: cannot find input file: $ac_f" >&2;} { (exit 1); exit 1; }; };; esac - ac_file_inputs="$ac_file_inputs $ac_f" + case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac + ac_file_inputs="$ac_file_inputs '$ac_f'" done # Let's still pretend it is `configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ - configure_input="Generated from "`IFS=: - echo $* | sed 's|^[^:]*/||;s|:[^:]*/|, |g'`" by configure." + configure_input='Generated from '` + $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' + `' by configure.' if test x"$ac_file" != x-; then configure_input="$ac_file. $configure_input" - { echo "$as_me:$LINENO: creating $ac_file" >&5 -echo "$as_me: creating $ac_file" >&6;} + { $as_echo "$as_me:$LINENO: creating $ac_file" >&5 +$as_echo "$as_me: creating $ac_file" >&6;} fi + # Neutralize special characters interpreted by sed in replacement strings. + case $configure_input in #( + *\&* | *\|* | *\\* ) + ac_sed_conf_input=`$as_echo "$configure_input" | + sed 's/[\\\\&|]/\\\\&/g'`;; #( + *) ac_sed_conf_input=$configure_input;; + esac case $ac_tag in - *:-:* | *:-) cat >"$tmp/stdin";; + *:-:* | *:-) cat >"$tmp/stdin" \ + || { { $as_echo "$as_me:$LINENO: error: could not create $ac_file" >&5 +$as_echo "$as_me: error: could not create $ac_file" >&2;} + { (exit 1); exit 1; }; } ;; esac ;; esac @@ -12342,7 +13339,7 @@ $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || -echo X"$ac_file" | +$as_echo X"$ac_file" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q @@ -12368,7 +13365,7 @@ echo X"$ac_file" | as_dirs= while :; do case $as_dir in #( - *\'*) as_qdir=`echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #( + *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( *) as_qdir=$as_dir;; esac as_dirs="'$as_qdir' $as_dirs" @@ -12377,7 +13374,7 @@ $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || -echo X"$as_dir" | +$as_echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q @@ -12398,17 +13395,17 @@ echo X"$as_dir" | test -d "$as_dir" && break done test -z "$as_dirs" || eval "mkdir $as_dirs" - } || test -d "$as_dir" || { { echo "$as_me:$LINENO: error: cannot create directory $as_dir" >&5 -echo "$as_me: error: cannot create directory $as_dir" >&2;} + } || test -d "$as_dir" || { { $as_echo "$as_me:$LINENO: error: cannot create directory $as_dir" >&5 +$as_echo "$as_me: error: cannot create directory $as_dir" >&2;} { (exit 1); exit 1; }; }; } ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) - ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` # A ".." for each directory in $ac_dir_suffix. - ac_top_builddir_sub=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,/..,g;s,/,,'` + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; @@ -12448,12 +13445,13 @@ ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix esac _ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # If the template does not know about datarootdir, expand it. # FIXME: This hack should be removed a few years after 2.60. ac_datarootdir_hack=; ac_datarootdir_seen= -case `sed -n '/datarootdir/ { +ac_sed_dataroot=' +/datarootdir/ { p q } @@ -12462,13 +13460,14 @@ case `sed -n '/datarootdir/ { /@infodir@/p /@localedir@/p /@mandir@/p -' $ac_file_inputs` in +' +case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in *datarootdir*) ac_datarootdir_seen=yes;; *@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) - { echo "$as_me:$LINENO: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 -echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 +$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} _ACEOF -cat >>$CONFIG_STATUS <<_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_datarootdir_hack=' s&@datadir@&$datadir&g s&@docdir@&$docdir&g @@ -12482,15 +13481,16 @@ _ACEOF # Neutralize VPATH when `$srcdir' = `.'. # Shell code in configure.ac might set extrasub. # FIXME: do we really want to maintain this feature? -cat >>$CONFIG_STATUS <<_ACEOF - sed "$ac_vpsub +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_sed_extra="$ac_vpsub $extrasub _ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 :t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b -s&@configure_input@&$configure_input&;t t +s|@configure_input@|$ac_sed_conf_input|;t t s&@top_builddir@&$ac_top_builddir_sub&;t t +s&@top_build_prefix@&$ac_top_build_prefix&;t t s&@srcdir@&$ac_srcdir&;t t s&@abs_srcdir@&$ac_abs_srcdir&;t t s&@top_srcdir@&$ac_top_srcdir&;t t @@ -12500,119 +13500,58 @@ s&@abs_builddir@&$ac_abs_builddir&;t t s&@abs_top_builddir@&$ac_abs_top_builddir&;t t s&@INSTALL@&$ac_INSTALL&;t t $ac_datarootdir_hack -" $ac_file_inputs | sed -f "$tmp/subs-1.sed" | sed -f "$tmp/subs-2.sed" >$tmp/out +" +eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$tmp/subs.awk" >$tmp/out \ + || { { $as_echo "$as_me:$LINENO: error: could not create $ac_file" >&5 +$as_echo "$as_me: error: could not create $ac_file" >&2;} + { (exit 1); exit 1; }; } test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && { ac_out=`sed -n '/\${datarootdir}/p' "$tmp/out"`; test -n "$ac_out"; } && { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' "$tmp/out"`; test -z "$ac_out"; } && - { echo "$as_me:$LINENO: WARNING: $ac_file contains a reference to the variable \`datarootdir' + { $as_echo "$as_me:$LINENO: WARNING: $ac_file contains a reference to the variable \`datarootdir' which seems to be undefined. Please make sure it is defined." >&5 -echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' +$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' which seems to be undefined. Please make sure it is defined." >&2;} rm -f "$tmp/stdin" case $ac_file in - -) cat "$tmp/out"; rm -f "$tmp/out";; - *) rm -f "$ac_file"; mv "$tmp/out" $ac_file;; - esac + -) cat "$tmp/out" && rm -f "$tmp/out";; + *) rm -f "$ac_file" && mv "$tmp/out" "$ac_file";; + esac \ + || { { $as_echo "$as_me:$LINENO: error: could not create $ac_file" >&5 +$as_echo "$as_me: error: could not create $ac_file" >&2;} + { (exit 1); exit 1; }; } ;; :H) # # CONFIG_HEADER # -_ACEOF - -# Transform confdefs.h into a sed script `conftest.defines', that -# substitutes the proper values into config.h.in to produce config.h. -rm -f conftest.defines conftest.tail -# First, append a space to every undef/define line, to ease matching. -echo 's/$/ /' >conftest.defines -# Then, protect against being on the right side of a sed subst, or in -# an unquoted here document, in config.status. If some macros were -# called several times there might be several #defines for the same -# symbol, which is useless. But do not sort them, since the last -# AC_DEFINE must be honored. -ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]* -# These sed commands are passed to sed as "A NAME B PARAMS C VALUE D", where -# NAME is the cpp macro being defined, VALUE is the value it is being given. -# PARAMS is the parameter list in the macro definition--in most cases, it's -# just an empty string. -ac_dA='s,^\\([ #]*\\)[^ ]*\\([ ]*' -ac_dB='\\)[ (].*,\\1define\\2' -ac_dC=' ' -ac_dD=' ,' - -uniq confdefs.h | - sed -n ' - t rset - :rset - s/^[ ]*#[ ]*define[ ][ ]*// - t ok - d - :ok - s/[\\&,]/\\&/g - s/^\('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/ '"$ac_dA"'\1'"$ac_dB"'\2'"${ac_dC}"'\3'"$ac_dD"'/p - s/^\('"$ac_word_re"'\)[ ]*\(.*\)/'"$ac_dA"'\1'"$ac_dB$ac_dC"'\2'"$ac_dD"'/p - ' >>conftest.defines - -# Remove the space that was appended to ease matching. -# Then replace #undef with comments. This is necessary, for -# example, in the case of _POSIX_SOURCE, which is predefined and required -# on some systems where configure will not decide to define it. -# (The regexp can be short, since the line contains either #define or #undef.) -echo 's/ $// -s,^[ #]*u.*,/* & */,' >>conftest.defines - -# Break up conftest.defines: -ac_max_sed_lines=50 - -# First sed command is: sed -f defines.sed $ac_file_inputs >"$tmp/out1" -# Second one is: sed -f defines.sed "$tmp/out1" >"$tmp/out2" -# Third one will be: sed -f defines.sed "$tmp/out2" >"$tmp/out1" -# et cetera. -ac_in='$ac_file_inputs' -ac_out='"$tmp/out1"' -ac_nxt='"$tmp/out2"' - -while : -do - # Write a here document: - cat >>$CONFIG_STATUS <<_ACEOF - # First, check the format of the line: - cat >"\$tmp/defines.sed" <<\\CEOF -/^[ ]*#[ ]*undef[ ][ ]*$ac_word_re[ ]*\$/b def -/^[ ]*#[ ]*define[ ][ ]*$ac_word_re[( ]/b def -b -:def -_ACEOF - sed ${ac_max_sed_lines}q conftest.defines >>$CONFIG_STATUS - echo 'CEOF - sed -f "$tmp/defines.sed"' "$ac_in >$ac_out" >>$CONFIG_STATUS - ac_in=$ac_out; ac_out=$ac_nxt; ac_nxt=$ac_in - sed 1,${ac_max_sed_lines}d conftest.defines >conftest.tail - grep . conftest.tail >/dev/null || break - rm -f conftest.defines - mv conftest.tail conftest.defines -done -rm -f conftest.defines conftest.tail - -echo "ac_result=$ac_in" >>$CONFIG_STATUS -cat >>$CONFIG_STATUS <<\_ACEOF if test x"$ac_file" != x-; then - echo "/* $configure_input */" >"$tmp/config.h" - cat "$ac_result" >>"$tmp/config.h" - if diff $ac_file "$tmp/config.h" >/dev/null 2>&1; then - { echo "$as_me:$LINENO: $ac_file is unchanged" >&5 -echo "$as_me: $ac_file is unchanged" >&6;} + { + $as_echo "/* $configure_input */" \ + && eval '$AWK -f "$tmp/defines.awk"' "$ac_file_inputs" + } >"$tmp/config.h" \ + || { { $as_echo "$as_me:$LINENO: error: could not create $ac_file" >&5 +$as_echo "$as_me: error: could not create $ac_file" >&2;} + { (exit 1); exit 1; }; } + if diff "$ac_file" "$tmp/config.h" >/dev/null 2>&1; then + { $as_echo "$as_me:$LINENO: $ac_file is unchanged" >&5 +$as_echo "$as_me: $ac_file is unchanged" >&6;} else - rm -f $ac_file - mv "$tmp/config.h" $ac_file + rm -f "$ac_file" + mv "$tmp/config.h" "$ac_file" \ + || { { $as_echo "$as_me:$LINENO: error: could not create $ac_file" >&5 +$as_echo "$as_me: error: could not create $ac_file" >&2;} + { (exit 1); exit 1; }; } fi else - echo "/* $configure_input */" - cat "$ac_result" + $as_echo "/* $configure_input */" \ + && eval '$AWK -f "$tmp/defines.awk"' "$ac_file_inputs" \ + || { { $as_echo "$as_me:$LINENO: error: could not create -" >&5 +$as_echo "$as_me: error: could not create -" >&2;} + { (exit 1); exit 1; }; } fi - rm -f "$tmp/out12" ;; @@ -12626,6 +13565,11 @@ _ACEOF chmod +x $CONFIG_STATUS ac_clean_files=$ac_clean_files_save +test $ac_write_fail = 0 || + { { $as_echo "$as_me:$LINENO: error: write failure creating $CONFIG_STATUS" >&5 +$as_echo "$as_me: error: write failure creating $CONFIG_STATUS" >&2;} + { (exit 1); exit 1; }; } + # configure is writing to config.log, and then calls config.status. # config.status does its own redirection, appending to config.log. @@ -12647,4 +13591,8 @@ if test "$no_create" != yes; then # would make configure fail if this is the last instruction. $ac_cs_success || { (exit 1); exit 1; } fi +if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then + { $as_echo "$as_me:$LINENO: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 +$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} +fi diff --git a/src/configure.in b/src/configure.in index 44b845eda..3423901ef 100644 --- a/src/configure.in +++ b/src/configure.in @@ -532,6 +532,8 @@ AC_CHECK_FUNCS( [expf logf sqrtf cosf sinf tanf sinhf coshf tanhf] \ AC_CHECK_FUNCS( [sched_yield uname fseeko] ) +AC_CHECK_FUNC( [mprotect], AC_DEFINE(ECL_USE_MPROTECT) ) + dnl ===================================================================== dnl Checks for system services diff --git a/src/h/config.h.in b/src/h/config.h.in index 7dd1102f3..5bbc36ed4 100644 --- a/src/h/config.h.in +++ b/src/h/config.h.in @@ -82,6 +82,9 @@ /* Stack grows downwards */ #undef ECL_DOWN_STACK +/* Use mprotect for fast interrupt dispatch */ +#undef ECL_USE_MPROTECT + /* * C TYPES AND SYSTEM LIMITS */ diff --git a/src/h/external.h b/src/h/external.h index 1eb1178b6..c20ccfef7 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -124,6 +124,7 @@ typedef struct cl_env_struct { #if defined(ECL_THREADS) # ifdef WITH___THREAD # define cl_env (*cl_env_p) +# define ecl_process_env() cl_env_p extern __thread cl_env_ptr cl_env_p; # else # define cl_env (*ecl_process_env()) @@ -131,6 +132,7 @@ typedef struct cl_env_struct { # endif #else # define cl_env (*cl_env_p) +# define ecl_process_env() cl_env_p extern cl_env_ptr cl_env_p; #endif @@ -1552,12 +1554,23 @@ extern ECL_API cl_object si_get_library_pathname(void); /* unixint.c */ -#define ECL_DISABLE_INTERRUPTS(env) ((env)->disable_interrupts=1) -#define ECL_ENABLE_INTERRUPTS(env) ((env)->disable_interrupts=0) -#define ECL_ATOMIC(env,stmt) (ECL_DISABLE_INTERRUPTS(env),(stmt),ECL_ENABLE_INTERRUPTS(env)) +#ifdef ECL_USE_MPROTECT +#define ecl_disable_interrupts_env(env) ((env)->disable_interrupts=1) +#define ecl_enable_interrupts_env(env) ((env)->disable_interrupts=0) +#else +#define ecl_disable_interrupts_env(env) ((env)->disable_interrupts=1) +#define ecl_enable_interrupts_env(env) (((env)->disable_interrupts^=1) && (ecl_check_pending_interrupts(),0)) +#endif +#define ecl_disable_interrupts() ecl_disable_interrupts_env(&cl_env) +#define ecl_enable_interrupts() ecl_enable_interrupts_env(&cl_env) +#define ECL_PSEUDO_ATOMIC_ENV(env,stmt) (ecl_disable_interrupts_env(env),(stmt),ecl_enable_interrupts_env(env)) +#define ECL_PSEUDO_ATOMIC(stmt) (ecl_disable_interrupts(),(stmt),ecl_enable_interrupts()) extern ECL_API cl_object si_catch_signal(cl_object signal, cl_object state); extern ECL_API cl_object si_check_pending_interrupts(void); +extern ECL_API cl_object si_disable_interrupts(void); +extern ECL_API cl_object si_enable_interrupts(void); extern ECL_API cl_object si_trap_fpe(cl_object condition, cl_object flag); +extern ECL_API void ecl_check_pending_interrupts(void); /* unixsys.c */ diff --git a/src/h/internal.h b/src/h/internal.h index e63573cd7..588b16553 100644 --- a/src/h/internal.h +++ b/src/h/internal.h @@ -51,6 +51,8 @@ extern void init_threads(cl_env_ptr); extern void ecl_init_env(cl_env_ptr); extern void init_lib_LSP(cl_object); +extern cl_env_ptr _ecl_alloc_env(void); + /* alloc.d/alloc_2.d */ extern cl_object ecl_alloc_bytecodes(cl_index data_size, cl_index code_size); From 3305c9c0fd7d09b0e5cd55c4e64b1e1c98f8555d Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Fri, 10 Oct 2008 16:34:50 +0200 Subject: [PATCH 03/60] I/O now retries the operation which was interrupted by a signal. --- src/c/file.d | 113 ++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 81 insertions(+), 32 deletions(-) diff --git a/src/c/file.d b/src/c/file.d index 4d3d86335..4562e32ab 100644 --- a/src/c/file.d +++ b/src/c/file.d @@ -23,6 +23,9 @@ */ #include +#include +#include +#include #include #include #include @@ -373,12 +376,29 @@ not_a_character_stream(cl_object s) @':datum', cl_stream_element_type(s)); } +static int +restartable_io_error(cl_object strm) +{ + cl_env_ptr the_env = &cl_env; + volatile int old_errno = errno; + clearerr((FILE*)strm->stream.file); + ecl_enable_interrupts(); + if (errno == EINTR) { + return 1; + } else { + FElibc_error("Read or write operation to stream ~S signaled an error.", + 1, strm); + return 0; + } +} + static void io_error(cl_object strm) { cl_env_ptr the_env = &cl_env; FILE *f = strm->stream.file; - if (f) ECL_PSEUDO_ATOMIC_ENV(the_env, clearerr(f)); + clearerr(f); + ecl_enable_interrupts(); FElibc_error("Read or write operation to stream ~S signaled an error.", 1, strm); } @@ -395,7 +415,7 @@ wsock_error( const char *err_msg, cl_object strm ) { char *msg; cl_object msg_obj; - ecl_disable_interrupts(); + /* ecl_disable_interrupts(); ** done by caller */ { FormatMessage( FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER, 0, WSAGetLastError(), 0, ( void* )&msg, 0, NULL ); @@ -598,16 +618,20 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, ecl_enable_interrupts_env(the_env); return x; CANNOT_OPEN: + ecl_enable_interrupts_env(the_env); FEcannot_open(fn); return Cnil; INVALID_OPTION: + ecl_enable_interrupts_env(the_env); FEerror("Invalid value op option ~A: ~A", 2, x, fn); return Cnil; INVALID_HEADER: + ecl_enable_interrupts_env(the_env); FEerror("~S has an invalid binary header ~S", 2, fn, MAKE_FIXNUM(binary_header)); return Cnil; INVALID_MODE: + ecl_enable_interrupts_env(the_env); FEerror("Illegal stream mode ~S", 1, MAKE_FIXNUM(smm)); return Cnil; } @@ -648,8 +672,10 @@ static void flush_output_stream_binary(cl_object strm); ecl_force_output(strm); if (!strm->stream.char_stream_p && strm->stream.header != 0xFF) { /* write header */ + ecl_disable_interrupts(); if (ecl_fseeko(fp, 0, SEEK_SET) != 0) io_error(strm); + ecl_enable_interrupts(); ecl_write_byte8(strm->stream.header, strm); } } @@ -740,23 +766,30 @@ ecl_write_byte8(int c, cl_object strm) case smm_output: case smm_io: { FILE *fp = (FILE *)strm->stream.file; + int code; if (fp == NULL) wrong_file_handler(strm); - if (putc(c, fp) == EOF) - io_error(strm); + ecl_disable_interrupts(); + do { + code = putc(c, fp); + } while (code== EOF && restartable_io_error(strm)); + ecl_enable_interrupts(); break; } #if defined(ECL_WSOCK) case smm_io_wsock: case smm_output_wsock: { int fp = (int)strm->stream.file; - if ( fp == INVALID_SOCKET ) - wrong_file_handler( strm ); - else - { - char ch = ( char )c; - if ( send( fp, &ch, 1, 0 ) == SOCKET_ERROR ) - wsock_error( "Cannot write char to Windows Socket ~S.~%~A", strm ); + if (fp == INVALID_SOCKET) { + wrong_file_handler(strm); + } else { + char ch = (char)c; + ecl_disable_interrupts(); + if (send( fp, &ch, 1, 0) == SOCKET_ERROR) { + wsock_error("Cannot write char to Windows" + "Socket ~S.~%~A", strm); + } + ecl_enable_interrupts(); } break; } @@ -882,9 +915,11 @@ ecl_read_byte8(cl_object strm) FILE *fp = (FILE*)strm->stream.file; if (fp == NULL) wrong_file_handler(strm); - c = getc(fp); - if (c == EOF && ferror(fp)) - io_error(strm); + ecl_disable_interrupts(); + do { + c = getc(fp); + } while (c == EOF && ferror(fp) && restartable_io_error(strm)); + ecl_enable_interrupts(); break; } #if defined(ECL_WSOCK) @@ -964,7 +999,9 @@ flush_output_stream_binary(cl_object strm) FILE *fp = (FILE*)strm->stream.file; /* do we need to merge with existing byte? */ - ecl_off_t current_offset = ecl_ftello(fp), diff_offset; + ecl_off_t current_offset, diff_offset; + ecl_disable_interrupts(); + current_offset = ecl_ftello(fp); if (ecl_fseeko(fp, 0, SEEK_END) != 0) io_error(strm); switch ((diff_offset = ecl_ftello(fp)-current_offset)) { @@ -979,6 +1016,7 @@ flush_output_stream_binary(cl_object strm) } if (ecl_fseeko(fp, current_offset, SEEK_SET) != 0) io_error(strm); + ecl_enable_interrupts(); /* do merging, if required */ if (do_merging){ @@ -1012,7 +1050,9 @@ flush_output_stream_binary(cl_object strm) /* flush byte w/o changing file pointer */ ecl_write_byte8(b, strm); + ecl_disable_interrupts(); ecl_fseeko(fp, -1, SEEK_CUR); + ecl_enable_interrupts(); } } @@ -1186,17 +1226,10 @@ BEGIN: wrong_file_handler(strm); if (cl_env.disable_interrupts) printf("Cannot disable interrupts twice.\n"); ecl_disable_interrupts_env(the_env); - { + do { c = getc(fp); - if (the_env->interrupt_pending) { - printf("Clearing file errors\n"); - clearerr(fp); - } - } + } while ((c == EOF) && ferror(fp) && restartable_io_error(strm)); ecl_enable_interrupts_env(the_env); - if (cl_env.disable_interrupts) printf("Interrupts are not reenabled.\n"); - if (c == EOF && ferror(fp)) - io_error(strm); break; } #if defined(ECL_WSOCK) @@ -1310,10 +1343,12 @@ BEGIN: not_a_character_stream(strm); if (fp == NULL) wrong_file_handler(strm); - c = getc(fp); - if (c == EOF && ferror(fp)) - io_error(strm); + ecl_disable_interrupts(); + do { + c = getc(fp); + } while (c == EOF && ferror(fp) && restartable_io_error(strm)); ungetc(c, fp); + ecl_enable_interrupts(); break; #if defined(ECL_WSOCK) @@ -1329,9 +1364,11 @@ BEGIN: c = (unsigned char)CHAR_CODE(CAR(strm->stream.object0)); } else { char ch; + ecl_disable_interrupts(); if ( recv( fp, &ch, 1, MSG_PEEK ) == SOCKET_ERROR ) wsock_error( "Cannot peek char from Windows socket ~S.~%~A", strm ); c = ( unsigned char )ch; + ecl_enable_interrupts(); } } break; @@ -1498,7 +1535,8 @@ BEGIN: switch ((enum ecl_smmode)strm->stream.mode) { case smm_io: io_stream_begin_write(strm); - case smm_output: + case smm_output: { + int outcome; if (!strm->stream.char_stream_p) not_a_character_stream(strm); if (c == '\n') @@ -1509,10 +1547,13 @@ BEGIN: strm->stream.int1++; if (fp == NULL) wrong_file_handler(strm); - if (putc(c, fp) == EOF) - io_error(strm); + ecl_disable_interrupts(); + do { + outcome = putc(c, fp); + } while (outcome == EOF && restartable_io_error(strm)); + ecl_enable_interrupts(); break; - + } #if defined(ECL_WSOCK) case smm_io_wsock: case smm_output_wsock: @@ -1529,8 +1570,10 @@ BEGIN: else { char ch = ( char )c; + ecl_disable_interrupts(); if ( send( ( int )fp, &ch, 1, 0 ) == SOCKET_ERROR ) wsock_error( "Cannot write char to Windows Socket ~S.~%~A", strm ); + ecl_enable_interrupts(); } break; #endif @@ -1738,10 +1781,12 @@ si_do_read_sequence(cl_object seq, cl_object stream, cl_object s, cl_object e) io_stream_begin_write(stream); } toread = end - start; + ecl_enable_interrupts(); n = fread(seq->vector.self.ch + start, sizeof(char), toread, stream->stream.file); - if (n < toread && ferror((FILE*)stream->stream.file)) + if (n < toread && ferror((FILE*)stream->stream.file)) { io_error(stream); + } start += n; } else if (t == t_stream && stream->stream.mode == smm_two_way) { stream = stream->stream.object0; @@ -1785,8 +1830,10 @@ BEGIN: if ((strm->stream.byte_size & 7) && strm->stream.buffer_state == -1) { flush_output_stream_binary(strm); } + ecl_disable_interrupts(); if (fflush(fp) == EOF) io_error(strm); + ecl_enable_interrupts(); break; } #if defined(ECL_WSOCK) @@ -2105,9 +2152,11 @@ BEGIN: FD_ZERO( &fds ); FD_SET( ( int )fp, &fds ); + ecl_disable_interrupts(); result = select( 0, &fds, NULL, NULL, &tv ); if ( result == SOCKET_ERROR ) wsock_error( "Cannot listen on Windows socket ~S.~%~A", strm ); + ecl_enable_interrupts(); return ( result > 0 ? ECL_LISTEN_AVAILABLE : ECL_LISTEN_NO_CHAR ); } } From 8ad4ad98a3f68d48bfd7b1b15345da47dc5ca755 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Fri, 10 Oct 2008 17:08:14 +0200 Subject: [PATCH 04/60] Interrupts are now deferred for all I/O operations --- src/c/file.d | 148 ++++++++++++++++++++++++++++++--------------------- 1 file changed, 87 insertions(+), 61 deletions(-) diff --git a/src/c/file.d b/src/c/file.d index 4562e32ab..6bdc6e740 100644 --- a/src/c/file.d +++ b/src/c/file.d @@ -381,6 +381,7 @@ restartable_io_error(cl_object strm) { cl_env_ptr the_env = &cl_env; volatile int old_errno = errno; + /* ecl_disable_interrupts(); ** done by caller */ clearerr((FILE*)strm->stream.file); ecl_enable_interrupts(); if (errno == EINTR) { @@ -397,6 +398,7 @@ io_error(cl_object strm) { cl_env_ptr the_env = &cl_env; FILE *f = strm->stream.file; + /* ecl_disable_interrupts(); ** done by caller */ clearerr(f); ecl_enable_interrupts(); FElibc_error("Read or write operation to stream ~S signaled an error.", @@ -690,8 +692,10 @@ static void flush_output_stream_binary(cl_object strm); case smm_input_wsock: case smm_output_wsock: case smm_io_wsock: - if ( closesocket( ( int )strm->stream.file ) != 0 ) + ecl_disable_interrupts(); + if (closesocket( ( int )strm->stream.file ) != 0) wsock_error( "Cannot close Windows Socket ~S~%~A.", strm ); + ecl_enable_interrupts(); #if !defined(GBC_BOEHM) cl_dealloc(strm->stream.buffer); strm->stream.file = NULL; @@ -785,7 +789,7 @@ ecl_write_byte8(int c, cl_object strm) } else { char ch = (char)c; ecl_disable_interrupts(); - if (send( fp, &ch, 1, 0) == SOCKET_ERROR) { + if (send(fp, &ch, 1, 0) == SOCKET_ERROR) { wsock_error("Cannot write char to Windows" "Socket ~S.~%~A", strm); } @@ -926,19 +930,22 @@ ecl_read_byte8(cl_object strm) case smm_io_wsock: case smm_input_wsock: { int fp = (int)strm->stream.file; - if ( fp == INVALID_SOCKET ) - wrong_file_handler( strm ); - else - { + if (fp == INVALID_SOCKET) { + wrong_file_handler(strm); + } else { /* check for unread chars first */ if (CONSP(strm->stream.object0)) { c = (unsigned char)CHAR_CODE(CAR(strm->stream.object0)); strm->stream.object0 = CDR(strm->stream.object0); } else { char ch; - if ( recv( fp, &ch, 1, 0 ) == SOCKET_ERROR ) - wsock_error( "Cannot read char from Windows socket ~S.~%~A", strm ); - c = ( unsigned char )ch; + ecl_disable_interrupts(); + if (recv(fp, &ch, 1, 0) == SOCKET_ERROR) + wsock_error("Cannot read char from " + "Windows socket ~S.~%~A", + strm); + ecl_enable_interrupts(); + c = (unsigned char)ch; } } break; @@ -1026,12 +1033,15 @@ flush_output_stream_binary(cl_object strm) if (c != EOF) b |= (unsigned char)(c & ~MAKE_BIT_MASK(nb)); /* rewind stream */ + ecl_disable_interrupts(); if (ecl_fseeko(fp, -1, SEEK_CUR) != 0) io_error(strm); + ecl_enable_interrupts(); } else { /* write-only stream: need to reopen the file for reading * * the byte to merge, then reopen it back for writing */ cl_object fn = si_coerce_to_filename(strm->stream.object1); + ecl_disable_interrupts(); if (freopen(fn->base_string.self, OPEN_R, fp) == NULL || ecl_fseeko(fp, current_offset, SEEK_SET) != 0) io_error(strm); @@ -1042,6 +1052,7 @@ flush_output_stream_binary(cl_object strm) strm->stream.file = fdopen(open(fn->base_string.self, O_WRONLY), OPEN_W); if (strm->stream.file == NULL || ecl_fseeko(fp, current_offset, SEEK_SET) != 0) io_error(strm); + ecl_enable_interrupts(); } } else { /* No merging occurs -> header must be overwritten */ @@ -1224,12 +1235,11 @@ BEGIN: not_a_character_stream(strm); if (fp == NULL) wrong_file_handler(strm); - if (cl_env.disable_interrupts) printf("Cannot disable interrupts twice.\n"); - ecl_disable_interrupts_env(the_env); + ecl_disable_interrupts(); do { c = getc(fp); } while ((c == EOF) && ferror(fp) && restartable_io_error(strm)); - ecl_enable_interrupts_env(the_env); + ecl_enable_interrupts(); break; } #if defined(ECL_WSOCK) @@ -1238,17 +1248,21 @@ BEGIN: int fp = (int)strm->stream.file; if (!strm->stream.char_stream_p) not_a_character_stream(strm); - if ( fp == INVALID_SOCKET ) - wrong_file_handler( strm ); - else { + if (fp == INVALID_SOCKET) { + wrong_file_handler(strm); + } else { if (CONSP(strm->stream.object0)) { c = (unsigned char)CHAR_CODE(CAR(strm->stream.object0)); strm->stream.object0 = CDR(strm->stream.object0); } else { char ch; - if ( recv( fp, &ch, 1, 0 ) == SOCKET_ERROR ) - wsock_error( "Cannot read char from Windows socket ~S.~%~A", strm ); - c = ( unsigned char )ch; + ecl_disable_interrupts(); + if (recv(fp, &ch, 1, 0) == SOCKET_ERROR) + wsock_error("Cannot read char from " + "Windows socket ~S.~%~A", + strm); + c = (unsigned char)ch; + ecl_enable_interrupts(); } } break; @@ -1357,17 +1371,19 @@ BEGIN: int fp = strm->stream.file; if (!strm->stream.char_stream_p) not_a_character_stream(strm); - if ( fp == INVALID_SOCKET ) - wrong_file_handler( strm ); - else { + if (fp == INVALID_SOCKET) { + wrong_file_handler(strm); + } else { if (CONSP(strm->stream.object0)) { c = (unsigned char)CHAR_CODE(CAR(strm->stream.object0)); } else { char ch; ecl_disable_interrupts(); - if ( recv( fp, &ch, 1, MSG_PEEK ) == SOCKET_ERROR ) - wsock_error( "Cannot peek char from Windows socket ~S.~%~A", strm ); - c = ( unsigned char )ch; + if (recv(fp, &ch, 1, MSG_PEEK) == SOCKET_ERROR) + wsock_error("Cannot peek char from " + "Windows socket ~S.~%~A", + strm); + c = (unsigned char)ch; ecl_enable_interrupts(); } } @@ -1459,9 +1475,11 @@ BEGIN: not_a_character_stream(strm); if (fp == NULL) wrong_file_handler(strm); + ecl_disable_interrupts(); ungetc(c, fp); if (c == EOF) io_error(strm); + ecl_enable_interrupts(); /* --strm->stream.int0; useless in smm_io, Beppe */ break; @@ -1565,14 +1583,14 @@ BEGIN: strm->stream.int1 = (strm->stream.int1&~07) + 8; else strm->stream.int1++; - if ( ( int )fp == INVALID_SOCKET ) - wrong_file_handler( strm ); - else - { - char ch = ( char )c; + if ((int)fp == INVALID_SOCKET) { + wrong_file_handler(strm); + } else { + char ch = (char)c; ecl_disable_interrupts(); - if ( send( ( int )fp, &ch, 1, 0 ) == SOCKET_ERROR ) - wsock_error( "Cannot write char to Windows Socket ~S.~%~A", strm ); + if (send((int)fp, &ch, 1, 0) == SOCKET_ERROR) + wsock_error("Cannot write char to Windows " + "Socket ~S.~%~A", strm); ecl_enable_interrupts(); } break; @@ -1689,14 +1707,16 @@ si_do_write_sequence(cl_object seq, cl_object stream, cl_object s, cl_object e) (stream->stream.mode == smm_io || stream->stream.mode == smm_output)) { - size_t towrite = end - start; + size_t towrite = end - start, written; if (stream->stream.mode == smm_io) { io_stream_begin_write(stream); } - if (fwrite(seq->vector.self.ch + start, sizeof(char), - towrite, (FILE*)stream->stream.file) < towrite) { - io_error(stream); - } + ecl_disable_interrupts(); + do { + written = fwrite(seq->vector.self.ch + start, sizeof(char), + towrite, (FILE*)stream->stream.file); + } while ((written < towrite) && restartable_io_error(stream)); + ecl_enable_interrupts(); } else if (t == t_stream && stream->stream.mode == smm_two_way) { stream = stream->stream.object1; goto AGAIN; @@ -1776,17 +1796,18 @@ si_do_read_sequence(cl_object seq, cl_object stream, cl_object s, cl_object e) (stream->stream.mode == smm_io || stream->stream.mode == smm_input)) { + FILE *fp = (FILE*)stream->stream.file; size_t toread, n; if (stream->stream.mode == smm_io) { io_stream_begin_write(stream); } toread = end - start; + ecl_disable_interrupts(); + do { + n = fread(seq->vector.self.ch + start, sizeof(char), + toread, fp); + } while (n < toread && ferror(fp) && restartable_io_error(stream)); ecl_enable_interrupts(); - n = fread(seq->vector.self.ch + start, sizeof(char), - toread, stream->stream.file); - if (n < toread && ferror((FILE*)stream->stream.file)) { - io_error(stream); - } start += n; } else if (t == t_stream && stream->stream.mode == smm_two_way) { stream = stream->stream.object0; @@ -1831,8 +1852,8 @@ BEGIN: flush_output_stream_binary(strm); } ecl_disable_interrupts(); - if (fflush(fp) == EOF) - io_error(strm); + while ((fflush(fp) == EOF) && restartable_io_error(strm)) + (void)0; ecl_enable_interrupts(); break; } @@ -1913,7 +1934,7 @@ BEGIN: /* flush at least the unread chars */ strm->stream.object0 = Cnil; /* do not do anything (yet) */ - printf( "Trying to clear input on windows socket stream!\n" ); + printf("Trying to clear input on windows socket stream!\n"); break; #endif @@ -1978,7 +1999,7 @@ BEGIN: case smm_io_wsock: case smm_output_wsock: /* do not do anything (yet) */ - printf( "Trying to clear output windows socket stream\n!" ); + printf("Trying to clear output windows socket stream\n!"); break; #endif @@ -2139,25 +2160,26 @@ BEGIN: case smm_io_wsock: case smm_input_wsock: fp = (FILE*)strm->stream.file; - if ( ( int )fp == INVALID_SOCKET ) - wrong_file_handler( strm ); - else - { - if (CONSP(strm->stream.object0)) + if ((int)fp == INVALID_SOCKET) { + wrong_file_handler(strm); + } else { + if (CONSP(strm->stream.object0)) { return ECL_LISTEN_AVAILABLE; - else { + } else { struct timeval tv = { 0, 0 }; fd_set fds; int result; - - FD_ZERO( &fds ); - FD_SET( ( int )fp, &fds ); + FD_ZERO(&fds); + FD_SET((int)fp, &fds); ecl_disable_interrupts(); - result = select( 0, &fds, NULL, NULL, &tv ); - if ( result == SOCKET_ERROR ) - wsock_error( "Cannot listen on Windows socket ~S.~%~A", strm ); + result = select(0, &fds, NULL, NULL, &tv); + if (result == SOCKET_ERROR) + wsock_error("Cannot listen on Windows " + "socket ~S.~%~A", strm); ecl_enable_interrupts(); - return ( result > 0 ? ECL_LISTEN_AVAILABLE : ECL_LISTEN_NO_CHAR ); + return (result > 0 ? + ECL_LISTEN_AVAILABLE : + ECL_LISTEN_NO_CHAR); } } #endif @@ -2227,9 +2249,11 @@ BEGIN: FILE *fp = (FILE*)strm->stream.file; if (fp == NULL) wrong_file_handler(strm); + ecl_disable_interrupts(); offset = ecl_ftello(fp); if (offset < 0) io_error(strm); + ecl_enable_interrupts(); if (sizeof(ecl_off_t) == sizeof(long)) { output = ecl_make_integer(offset); } else { @@ -3032,14 +3056,16 @@ ecl_make_stream_from_fd(cl_object fname, int fd, enum ecl_smmode smm) default: FEerror("make_stream: wrong mode", 0); } + ecl_disable_interrupts(); #if defined(ECL_WSOCK) - if ( smm == smm_input_wsock || smm == smm_output_wsock || smm == smm_io_wsock ) - fp = ( FILE* )fd; + if (smm == smm_input_wsock || smm == smm_output_wsock || smm == smm_io_wsock) + fp = (FILE*)fd; else - fp = fdopen( fd, mode ); + fp = fdopen(fd, mode); #else fp = fdopen(fd, mode); #endif + ecl_enable_interrupts(); return ecl_make_stream_from_FILE(fname, fp, smm); } From 5bda4b4f6160babab31304c78253887f45822510 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Fri, 10 Oct 2008 22:36:15 +0200 Subject: [PATCH 05/60] All allocation functions are now in the ECL library and they now have the ecl_* prefix. Old names are kept in macro form. --- src/CHANGELOG | 4 ++ src/c/alloc.d | 20 +++--- src/c/alloc_2.d | 139 +++++++++++++++++++--------------------- src/c/arch/ffi_x86.d | 2 +- src/c/arch/ffi_x86_64.d | 4 +- src/c/array.d | 32 ++++----- src/c/big.d | 16 ++--- src/c/big_ll.d | 10 +-- src/c/cfun.d | 6 +- src/c/compiler.d | 6 +- src/c/ffi.d | 12 ++-- src/c/file.d | 28 ++++---- src/c/gfun.d | 4 +- src/c/hash.d | 8 +-- src/c/instance.d | 2 +- src/c/interpreter.d | 4 +- src/c/load.d | 2 +- src/c/main.d | 8 +-- src/c/num_arith.d | 14 ++-- src/c/num_log.d | 2 +- src/c/num_rand.d | 2 +- src/c/number.d | 20 +++--- src/c/package.d | 6 +- src/c/pathname.d | 4 +- src/c/read.d | 36 +++++------ src/c/sequence.d | 4 +- src/c/stacks.d | 12 ++-- src/c/string.d | 10 +-- src/c/structure.d | 8 +-- src/c/symbol.d | 2 +- src/c/threads.d | 8 +-- src/c/threads_win32.d | 10 +-- src/c/unixfsys.d | 2 +- src/h/external.h | 39 +++++++---- 34 files changed, 247 insertions(+), 239 deletions(-) diff --git a/src/CHANGELOG b/src/CHANGELOG index ab2e586b1..ed438ba7c 100644 --- a/src/CHANGELOG +++ b/src/CHANGELOG @@ -70,6 +70,10 @@ ECL 8.9.0: - *DEFAULT-PATHNAME-DEFAULTS* is initialized to the value of EXT:GETCWD. + - In an effort to convert all functions to the ecl_* prefix, we are deprecating + names while keeping the old definitions as macros. Look at external.h for + the list of already deprecated names. + * Embedding: - ECL now implements a more transparent interface for setting and querying diff --git a/src/c/alloc.d b/src/c/alloc.d index 0617c172b..03c7b775b 100644 --- a/src/c/alloc.d +++ b/src/c/alloc.d @@ -224,7 +224,7 @@ add_page_to_freelist(cl_ptr p, struct typemanager *tm) } cl_object -cl_alloc_object(cl_type t) +ecl_alloc_object(cl_type t) { register cl_object obj; register struct typemanager *tm; @@ -519,20 +519,20 @@ Use ALLOCATE to expand the space.", } cl_object -cl_alloc_instance(cl_index slots) +ecl_alloc_instance(cl_index slots) { - cl_object i = cl_alloc_object(t_instance); + cl_object i = ecl_alloc_object(t_instance); if (slots >= ECL_SLOTS_LIMIT) FEerror("Limit on instance size exceeded: ~S slots requested.", 1, MAKE_FIXNUM(slots)); /* INV: slots > 0 */ - i->instance.slots = (cl_object*)cl_alloc(sizeof(cl_object) * slots); + i->instance.slots = (cl_object*)ecl_alloc(sizeof(cl_object) * slots); i->instance.length = slots; return i; } void * -cl_alloc(cl_index n) +ecl_alloc(cl_index n) { volatile cl_ptr p; struct contblock **cbpp; @@ -620,15 +620,15 @@ cl_dealloc(void *p, cl_index s) * required for the block. */ void * -cl_alloc_align(cl_index size, cl_index align) +ecl_alloc_align(cl_index size, cl_index align) { void *output; start_critical_section(); align--; if (align) - output = (void*)(((cl_index)cl_alloc(size + align) + align - 1) & ~align); + output = (void*)(((cl_index)ecl_alloc(size + align) + align - 1) & ~align); else - output = cl_alloc(size); + output = ecl_alloc(size); end_critical_section(); return output; } @@ -895,7 +895,7 @@ malloc(size_t size) init_alloc(); x = alloc_simple_base_string(size-1); - x->base_string.self = (char *)cl_alloc(size); + x->base_string.self = (char *)ecl_alloc(size); malloc_list = ecl_cons(x, malloc_list); return(x->base_string.self); } @@ -933,7 +933,7 @@ realloc(void *ptr, size_t size) return(ptr); } else { j = x->base_string.dim; - x->base_string.self = (char *)cl_alloc(size); + x->base_string.self = (char *)ecl_alloc(size); x->base_string.fillp = x->base_string.dim = size; memcpy(x->base_string.self, ptr, j); cl_dealloc(ptr, j); diff --git a/src/c/alloc_2.d b/src/c/alloc_2.d index c00147dfa..eaf941641 100644 --- a/src/c/alloc_2.d +++ b/src/c/alloc_2.d @@ -44,7 +44,7 @@ static void finalize_queued(); static size_t type_size[t_end]; cl_object -cl_alloc_object(cl_type t) +ecl_alloc_object(cl_type t) { cl_object obj; @@ -126,7 +126,10 @@ cl_alloc_object(cl_type t) cl_object ecl_cons(cl_object a, cl_object d) { - struct ecl_cons *obj = GC_MALLOC(sizeof(struct ecl_cons)); + struct ecl_cons *obj; + ecl_disable_interrupts(); + obj = GC_MALLOC(sizeof(struct ecl_cons)); + ecl_enable_interrupts(); #ifdef ECL_SMALL_CONS obj->car = a; obj->cdr = d; @@ -142,7 +145,10 @@ ecl_cons(cl_object a, cl_object d) cl_object ecl_list1(cl_object a) { - struct ecl_cons *obj = GC_MALLOC(sizeof(struct ecl_cons)); + struct ecl_cons *obj; + ecl_disable_interrupts(); + obj = GC_MALLOC(sizeof(struct ecl_cons)); + ecl_enable_interrupts(); #ifdef ECL_SMALL_CONS obj->car = a; obj->cdr = Cnil; @@ -156,11 +162,11 @@ ecl_list1(cl_object a) } cl_object -cl_alloc_instance(cl_index slots) +ecl_alloc_instance(cl_index slots) { cl_object i; - i = cl_alloc_object(t_instance); - i->instance.slots = (cl_object *)cl_alloc(sizeof(cl_object) * slots); + i = ecl_alloc_object(t_instance); + i->instance.slots = (cl_object *)ecl_alloc(sizeof(cl_object) * slots); i->instance.length = slots; return i; } @@ -168,13 +174,47 @@ cl_alloc_instance(cl_index slots) void * ecl_alloc_uncollectable(size_t size) { - return GC_MALLOC_UNCOLLECTABLE(size); + void *output; + ecl_disable_interrupts(); + output = GC_MALLOC_UNCOLLECTABLE(size); + ecl_enable_interrupts(); + return output; } void ecl_free_uncollectable(void *pointer) { + ecl_disable_interrupts(); GC_FREE(pointer); + ecl_enable_interrupts(); +} + +void * +ecl_alloc(cl_index n) +{ + void *output; + ecl_disable_interrupts(); + output = GC_MALLOC_IGNORE_OFF_PAGE(n); + ecl_enable_interrupts(); + return output; +} + +void * +ecl_alloc_atomic(cl_index n) +{ + void *output; + ecl_disable_interrupts(); + output = GC_MALLOC_ATOMIC_IGNORE_OFF_PAGE(n); + ecl_enable_interrupts(); + return output; +} + +void +cl_dealloc(void *ptr) +{ + ecl_disable_interrupts(); + GC_FREE(ptr); + ecl_enable_interrupts(); } static int alloc_initialized = FALSE; @@ -289,18 +329,22 @@ standard_finalizer(cl_object o) break; #ifdef ECL_THREADS case t_lock: + ecl_disable_interrupts(); #if defined(_MSC_VER) || defined(mingw32) CloseHandle(o->lock.mutex); #else pthread_mutex_destroy(&o->lock.mutex); #endif + ecl_enable_interrupts(); break; case t_condition_variable: + ecl_disable_interrupts(); #if defined(_MSC_VER) || defined(mingw32) CloseHandle(o->condition_variable.cv); #else pthread_cond_destroy(&o->condition_variable.cv); #endif + ecl_enable_interrupts(); break; #endif default:; @@ -342,7 +386,9 @@ queueing_finalizer(cl_object o, cl_object finalizer) GC_finalization_proc ofn; void *odata; cl_core.to_be_finalized = aux; + ecl_disable_interrupts(); GC_register_finalizer_no_order(aux, (GC_finalization_proc*)group_finalizer, NULL, &ofn, &odata); + ecl_enable_interrupts(); } else { ECL_RPLACD(aux, ECL_CONS_CDR(l)); ECL_RPLACD(l, aux); @@ -357,6 +403,7 @@ si_get_finalizer(cl_object o) cl_object output; GC_finalization_proc ofn; void *odata; + ecl_disable_interrupts(); GC_register_finalizer_no_order(o, (GC_finalization_proc)0, 0, &ofn, &odata); if (ofn == 0) { output = Cnil; @@ -366,6 +413,7 @@ si_get_finalizer(cl_object o) output = Cnil; } GC_register_finalizer_no_order(o, ofn, odata, &ofn, &odata); + ecl_enable_interrupts(); @(return output) } @@ -374,11 +422,13 @@ si_set_finalizer(cl_object o, cl_object finalizer) { GC_finalization_proc ofn; void *odata; + ecl_disable_interrupts(); if (finalizer == Cnil) { GC_register_finalizer_no_order(o, (GC_finalization_proc)0, 0, &ofn, &odata); } else { GC_register_finalizer_no_order(o, (GC_finalization_proc)queueing_finalizer, finalizer, &ofn, &odata); } + ecl_enable_interrupts(); @(return) } @@ -392,9 +442,9 @@ si_gc_stats(cl_object enable) cl_core.bytes_consed = MAKE_FIXNUM(0); cl_core.gc_counter = MAKE_FIXNUM(0); #else - cl_core.bytes_consed = cl_alloc_object(t_bignum); + cl_core.bytes_consed = ecl_alloc_object(t_bignum); mpz_init2(cl_core.bytes_consed->big.big_num, 128); - cl_core.gc_counter = cl_alloc_object(t_bignum); + cl_core.gc_counter = ecl_alloc_object(t_bignum); mpz_init2(cl_core.gc_counter->big.big_num, 128); #endif } @@ -531,71 +581,6 @@ stacks_scanner() (*old_GC_push_other_roots)(); } -/********************************************************** - * MALLOC SUBSTITUTION * - **********************************************************/ - -#if 0 && defined(NEED_MALLOC) -#undef malloc -#undef calloc -#undef free -#undef cfree -#undef realloc - -void * -malloc(size_t size) -{ - return GC_MALLOC(size); -} - -void -free(void *ptr) -{ - GC_free(ptr); -} - -void * -realloc(void *ptr, size_t size) -{ - return GC_realloc(ptr, size); -} - -void * -calloc(size_t nelem, size_t elsize) -{ - char *ptr; - size_t i; - ptr = GC_MALLOC(i = nelem*elsize); - memset(ptr, 0 , i); - return ptr; -} - -void -cfree(void *ptr) -{ - GC_free(ptr); -} - -#define ALLOC_ALIGNED(f, size, align) \ - ((align) <= 4 ? (int)(f)(size) : \ - ((align) * (((unsigned)(f)(size + (size ? (align) - 1 : 0)) + (align) - 1)/(align)))) - -void * -memalign(size_t align, size_t size) -{ - return (void *)ALLOC_ALIGNED(GC_MALLOC, size, align); -} - -# ifdef WANT_VALLOC -char * -valloc(size_t size) -{ - return memalign(getpagesize(), size); -} -# endif /* WANT_VALLOC */ -#endif /* NEED_MALLOC */ - - /********************************************************** * GARBAGE COLLECTION * **********************************************************/ @@ -603,20 +588,26 @@ valloc(size_t size) void ecl_register_root(cl_object *p) { + ecl_disable_interrupts(); GC_add_roots((char*)p, (char*)(p+1)); + ecl_enable_interrupts(); } cl_object si_gc(cl_object area) { + ecl_disable_interrupts(); GC_gcollect(); + ecl_enable_interrupts(); @(return) } cl_object si_gc_dump() { + ecl_disable_interrupts(); GC_dump(); + ecl_enable_interrupts(); @(return) } diff --git a/src/c/arch/ffi_x86.d b/src/c/arch/ffi_x86.d index d86534c8e..cc8131a3e 100644 --- a/src/c/arch/ffi_x86.d +++ b/src/c/arch/ffi_x86.d @@ -207,7 +207,7 @@ ecl_dynamic_callback_make(cl_object data, enum ecl_ffi_calling_convention cc_typ * nop 90 * nop 90 */ - char *buf = (char*)cl_alloc_atomic_align(sizeof(char)*16, 4); + char *buf = (char*)ecl_alloc_atomic_align(sizeof(char)*16, 4); *(char*) (buf+0) = 0x54; *(char*) (buf+1) = 0x68; *(long*) (buf+2) = (long)data; diff --git a/src/c/arch/ffi_x86_64.d b/src/c/arch/ffi_x86_64.d index 56c75c023..75c679866 100644 --- a/src/c/arch/ffi_x86_64.d +++ b/src/c/arch/ffi_x86_64.d @@ -31,7 +31,7 @@ struct ecl_fficall_reg * ecl_fficall_prepare_extra(struct ecl_fficall_reg *registers) { if (registers == 0) { - registers = cl_alloc_atomic_align(sizeof(*registers), sizeof(long)); + registers = ecl_alloc_atomic_align(sizeof(*registers), sizeof(long)); } registers->int_registers_size = 0; registers->fp_registers_size = 0; @@ -276,7 +276,7 @@ ecl_dynamic_callback_make(cl_object data, enum ecl_ffi_calling_convention cc_typ * nop 90 * nop 90 */ - char *buf = (char*)cl_alloc_atomic_align(sizeof(char)*32, 8); + char *buf = (char*)ecl_alloc_atomic_align(sizeof(char)*32, 8); *(char*) (buf+0) = 0x55; *(char*) (buf+1) = 0x54; *(short*)(buf+2) = 0xb848; diff --git a/src/c/array.d b/src/c/array.d index 0bb0cece3..c722e288d 100644 --- a/src/c/array.d +++ b/src/c/array.d @@ -335,12 +335,12 @@ si_make_pure_array(cl_object etype, cl_object dims, cl_object adj, FEerror(":FILL-POINTER may not be specified for an array of rank ~D", 1, MAKE_FIXNUM(r)); } - x = cl_alloc_object(t_array); + x = ecl_alloc_object(t_array); x->array.displaced = Cnil; x->array.self.t = NULL; /* for GC sake */ x->array.rank = r; x->array.elttype = (short)ecl_symbol_to_elttype(etype); - x->array.dims = (cl_index *)cl_alloc_atomic_align(sizeof(cl_index)*r, sizeof(cl_index)); + x->array.dims = (cl_index *)ecl_alloc_atomic_align(sizeof(cl_index)*r, sizeof(cl_index)); for (i = 0, s = 1; i < r; i++, dims = ECL_CONS_CDR(dims)) { j = ecl_fixnum_in_range(@'make-array', "dimension", ECL_CONS_CAR(dims), 0, ADIMLIM); @@ -374,15 +374,15 @@ si_make_vector(cl_object etype, cl_object dim, cl_object adj, aet = ecl_symbol_to_elttype(etype); d = ecl_fixnum_in_range(@'make-array',"dimension",dim,0,ADIMLIM); if (aet == aet_bc) { - x = cl_alloc_object(t_base_string); + x = ecl_alloc_object(t_base_string); } else if (aet == aet_bit) { - x = cl_alloc_object(t_bitvector); + x = ecl_alloc_object(t_bitvector); #ifdef ECL_UNICODE } else if (aet == aet_ch) { - x = cl_alloc_object(t_string); + x = ecl_alloc_object(t_string); #endif } else { - x = cl_alloc_object(t_vector); + x = ecl_alloc_object(t_vector); x->vector.elttype = (short)aet; } x->vector.self.t = NULL; /* for GC sake */ @@ -424,7 +424,7 @@ ecl_array_allocself(cl_object x) /* assign self field only after it has been filled, for GC sake */ case aet_object: { cl_object *elts; - elts = (cl_object *)cl_alloc_align(sizeof(cl_object)*d, sizeof(cl_object)); + elts = (cl_object *)ecl_alloc_align(sizeof(cl_object)*d, sizeof(cl_object)); for (i = 0; i < d; i++) elts[i] = Cnil; x->array.self.t = elts; @@ -433,7 +433,7 @@ ecl_array_allocself(cl_object x) #ifdef ECL_UNICODE case aet_ch: { cl_object *elts; - elts = (cl_object *)cl_alloc_align(sizeof(cl_object)*d, sizeof(cl_object)); + elts = (cl_object *)ecl_alloc_align(sizeof(cl_object)*d, sizeof(cl_object)); for (i = 0; i < d; i++) elts[i] = CODE_CHAR(' '); x->string.self = elts; @@ -442,7 +442,7 @@ ecl_array_allocself(cl_object x) #endif case aet_bc: { char *elts; - elts = (char *)cl_alloc_atomic(d+1); + elts = (char *)ecl_alloc_atomic(d+1); for (i = 0; i < d; i++) elts[i] = ' '; elts[d] = '\0'; @@ -452,7 +452,7 @@ ecl_array_allocself(cl_object x) case aet_bit: { byte *elts; d = (d+(CHAR_BIT-1))/CHAR_BIT; - elts = (byte *)cl_alloc_atomic(d); + elts = (byte *)ecl_alloc_atomic(d); for (i = 0; i < d; i++) elts[i] = '\0'; x->vector.offset = 0; @@ -461,7 +461,7 @@ ecl_array_allocself(cl_object x) } case aet_fix: { cl_fixnum *elts; - elts = (cl_fixnum *)cl_alloc_atomic_align(sizeof(*elts)*d, sizeof(*elts)); + elts = (cl_fixnum *)ecl_alloc_atomic_align(sizeof(*elts)*d, sizeof(*elts)); for (i = 0; i < d; i++) elts[i] = 0; x->array.self.fix = elts; @@ -469,7 +469,7 @@ ecl_array_allocself(cl_object x) } case aet_index: { cl_fixnum *elts; - elts = (cl_fixnum *)cl_alloc_atomic_align(sizeof(*elts)*d, sizeof(*elts)); + elts = (cl_fixnum *)ecl_alloc_atomic_align(sizeof(*elts)*d, sizeof(*elts)); for (i = 0; i < d; i++) elts[i] = 0; x->array.self.fix = elts; @@ -477,7 +477,7 @@ ecl_array_allocself(cl_object x) } case aet_sf: { float *elts; - elts = (float *)cl_alloc_atomic_align(sizeof(*elts)*d, sizeof(*elts)); + elts = (float *)ecl_alloc_atomic_align(sizeof(*elts)*d, sizeof(*elts)); for (i = 0; i < d; i++) elts[i] = 0.0; x->array.self.sf = elts; @@ -485,7 +485,7 @@ ecl_array_allocself(cl_object x) } case aet_df: { double *elts; - elts = (double *)cl_alloc_atomic_align(sizeof(*elts)*d, sizeof(*elts)); + elts = (double *)ecl_alloc_atomic_align(sizeof(*elts)*d, sizeof(*elts)); for (i = 0; i < d; i++) elts[i] = 0.0; x->array.self.df = elts; @@ -493,7 +493,7 @@ ecl_array_allocself(cl_object x) } case aet_b8: { uint8_t *elts; - elts = (uint8_t *)cl_alloc_atomic_align(sizeof(*elts)*d, sizeof(*elts)); + elts = (uint8_t *)ecl_alloc_atomic_align(sizeof(*elts)*d, sizeof(*elts)); for (i = 0; i < d; i++) elts[i] = 0; x->array.self.b8 = elts; @@ -501,7 +501,7 @@ ecl_array_allocself(cl_object x) } case aet_i8: { int8_t *elts; - elts = (int8_t *)cl_alloc_atomic_align(sizeof(*elts)*d, sizeof(*elts)); + elts = (int8_t *)ecl_alloc_atomic_align(sizeof(*elts)*d, sizeof(*elts)); for (i = 0; i < d; i++) elts[i] = 0; x->array.self.i8 = elts; diff --git a/src/c/big.d b/src/c/big.d index 393448ccd..ab2d4116a 100644 --- a/src/c/big.d +++ b/src/c/big.d @@ -76,7 +76,7 @@ big_register_free(cl_object x) cl_object big_register_copy(cl_object old) { - cl_object new_big = cl_alloc_object(t_bignum); + cl_object new_big = ecl_alloc_object(t_bignum); if (old->big.big_dim > BIGNUM_REGISTER_SIZE) { /* The object already has suffered a mpz_realloc() so we can use the pointer */ @@ -115,19 +115,19 @@ big_register_normalize(cl_object x) static cl_object big_alloc(int size) { - volatile cl_object x = cl_alloc_object(t_bignum); + volatile cl_object x = ecl_alloc_object(t_bignum); if (size <= 0) ecl_internal_error("negative or zero size for bignum in big_alloc"); x->big.big_dim = size; x->big.big_size = 0; - x->big.big_limbs = (mp_limb_t *)cl_alloc_atomic_align(size * sizeof(mp_limb_t), sizeof(mp_limb_t)); + x->big.big_limbs = (mp_limb_t *)ecl_alloc_atomic_align(size * sizeof(mp_limb_t), sizeof(mp_limb_t)); return(x); } cl_object bignum1(cl_fixnum val) { - volatile cl_object z = cl_alloc_object(t_bignum); + volatile cl_object z = ecl_alloc_object(t_bignum); mpz_init_set_si(z->big.big_num, val); return(z); } @@ -147,7 +147,7 @@ bignum2(mp_limb_t hi, mp_limb_t lo) cl_object big_copy(cl_object x) { - volatile cl_object y = cl_alloc_object(t_bignum); + volatile cl_object y = ecl_alloc_object(t_bignum); mpz_init_set(y->big.big_num, x->big.big_num); return(y); } @@ -261,13 +261,13 @@ big_normalize(cl_object x) static void * mp_alloc(size_t size) { - return cl_alloc_atomic_align(size, sizeof(mp_limb_t)); + return ecl_alloc_atomic_align(size, sizeof(mp_limb_t)); } static void * mp_realloc(void *ptr, size_t osize, size_t nsize) { - void *p = cl_alloc_atomic_align(nsize, sizeof(mp_limb_t)); + void *p = ecl_alloc_atomic_align(nsize, sizeof(mp_limb_t)); memcpy(p, ptr, osize); return p; } @@ -285,7 +285,7 @@ void init_big_registers(void) { int i; for (i = 0; i < 3; i++) { - cl_env.big_register[i] = cl_alloc_object(t_bignum); + cl_env.big_register[i] = ecl_alloc_object(t_bignum); big_register_free(cl_env.big_register[i]); } } diff --git a/src/c/big_ll.d b/src/c/big_ll.d index 8927238b2..e8aeef6af 100644 --- a/src/c/big_ll.d +++ b/src/c/big_ll.d @@ -43,7 +43,7 @@ big_register_free(cl_object x) {} cl_object big_register_copy(cl_object old) { - cl_object new_big = cl_alloc_object(t_bignum); + cl_object new_big = ecl_alloc_object(t_bignum); new_big->big.big_num = old->big.big_num; return new_big; } @@ -61,7 +61,7 @@ big_register_normalize(cl_object x) static cl_object big_alloc(int size) { - volatile cl_object x = cl_alloc_object(t_bignum); + volatile cl_object x = ecl_alloc_object(t_bignum); if (size <= 0) ecl_internal_error("negative or zero size for bignum in big_alloc"); x->big.big_num = 0ll; @@ -72,7 +72,7 @@ big_alloc(int size) cl_object bignum1(cl_fixnum val) { - volatile cl_object z = cl_alloc_object(t_bignum); + volatile cl_object z = ecl_alloc_object(t_bignum); z->big.big_num = val; return(z); } @@ -90,7 +90,7 @@ bignum2(cl_fixnum hi, cl_fixnum lo) cl_object big_copy(cl_object x) { - volatile cl_object y = cl_alloc_object(t_bignum); + volatile cl_object y = ecl_alloc_object(t_bignum); y->big.big_num = x->big.big_num; return(y); } @@ -134,7 +134,7 @@ void init_big_registers(void) { int i; for (i = 0; i < 3; i++) { - cl_env.big_register[i] = cl_alloc_object(t_bignum); + cl_env.big_register[i] = ecl_alloc_object(t_bignum); cl_env.big_register[i]->big.big_num = 0ll; } } diff --git a/src/c/cfun.d b/src/c/cfun.d index 1ca06ed4f..315a911c4 100644 --- a/src/c/cfun.d +++ b/src/c/cfun.d @@ -23,7 +23,7 @@ cl_make_cfun(void *c_function, cl_object name, cl_object cblock, int narg) { cl_object cf; - cf = cl_alloc_object(t_cfunfixed); + cf = ecl_alloc_object(t_cfunfixed); cf->cfun.entry = c_function; cf->cfun.name = name; cf->cfun.block = cblock; @@ -38,7 +38,7 @@ cl_make_cfun_va(void *c_function, cl_object name, cl_object cblock) { cl_object cf; - cf = cl_alloc_object(t_cfun); + cf = ecl_alloc_object(t_cfun); cf->cfun.entry = c_function; cf->cfun.name = name; cf->cfun.block = cblock; @@ -51,7 +51,7 @@ cl_make_cclosure_va(void *c_function, cl_object env, cl_object block) { cl_object cc; - cc = cl_alloc_object(t_cclosure); + cc = ecl_alloc_object(t_cclosure); cc->cclosure.entry = c_function; cc->cclosure.env = env; cc->cclosure.block = block; diff --git a/src/c/compiler.d b/src/c/compiler.d index a5b3de01f..614067f2c 100644 --- a/src/c/compiler.d +++ b/src/c/compiler.d @@ -160,12 +160,12 @@ asm_end(cl_index beginning) { /* Save bytecodes from this session in a new vector */ code_size = current_pc() - beginning; data_size = ecl_length(ENV->constants); - bytecodes = cl_alloc_object(t_bytecodes); + bytecodes = ecl_alloc_object(t_bytecodes); bytecodes->bytecodes.name = @'si::bytecodes'; bytecodes->bytecodes.code_size = code_size; bytecodes->bytecodes.data_size = data_size; - bytecodes->bytecodes.code = cl_alloc_atomic(code_size * sizeof(cl_opcode)); - bytecodes->bytecodes.data = (cl_object*)cl_alloc(data_size * sizeof(cl_object)); + bytecodes->bytecodes.code = ecl_alloc_atomic(code_size * sizeof(cl_opcode)); + bytecodes->bytecodes.data = (cl_object*)ecl_alloc(data_size * sizeof(cl_object)); bytecodes->bytecodes.file = (file == OBJNULL)? Cnil : file; bytecodes->bytecodes.file_position = (position == OBJNULL)? Cnil : position; for (i = 0, code = (cl_opcode *)bytecodes->bytecodes.code; i < code_size; i++) { diff --git a/src/c/ffi.d b/src/c/ffi.d index 5f4443b61..246e1325b 100644 --- a/src/c/ffi.d +++ b/src/c/ffi.d @@ -61,7 +61,7 @@ static unsigned int ecl_foreign_type_size[] = { cl_object ecl_make_foreign_data(cl_object tag, cl_index size, void *data) { - cl_object output = cl_alloc_object(t_foreign); + cl_object output = ecl_alloc_object(t_foreign); output->foreign.tag = tag == Cnil ? @':void' : tag; output->foreign.size = size; output->foreign.data = (char*)data; @@ -71,10 +71,10 @@ ecl_make_foreign_data(cl_object tag, cl_index size, void *data) cl_object ecl_allocate_foreign_data(cl_object tag, cl_index size) { - cl_object output = cl_alloc_object(t_foreign); + cl_object output = ecl_alloc_object(t_foreign); output->foreign.tag = tag; output->foreign.size = size; - output->foreign.data = (char*)cl_alloc_atomic(size); + output->foreign.data = (char*)ecl_alloc_atomic(size); return output; } @@ -115,11 +115,11 @@ ecl_null_terminated_base_string(cl_object f) cl_object si_allocate_foreign_data(cl_object tag, cl_object size) { - cl_object output = cl_alloc_object(t_foreign); + cl_object output = ecl_alloc_object(t_foreign); cl_index bytes = fixnnint(size); output->foreign.tag = tag; output->foreign.size = bytes; - output->foreign.data = bytes? cl_alloc_atomic(bytes) : NULL; + output->foreign.data = bytes? ecl_alloc_atomic(bytes) : NULL; @(return output) } @@ -187,7 +187,7 @@ si_foreign_data_pointer(cl_object f, cl_object andx, cl_object asize, if (ndx >= f->foreign.size || (f->foreign.size - ndx) < size) { FEerror("Out of bounds reference into foreign data type ~A.", 1, f); } - output = cl_alloc_object(t_foreign); + output = ecl_alloc_object(t_foreign); output->foreign.tag = tag; output->foreign.size = size; output->foreign.data = f->foreign.data + ndx; diff --git a/src/c/file.d b/src/c/file.d index 6bdc6e740..085fa20dd 100644 --- a/src/c/file.d +++ b/src/c/file.d @@ -578,7 +578,7 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, } else { goto INVALID_MODE; } - x = cl_alloc_object(t_stream); + x = ecl_alloc_object(t_stream); x->stream.mode = (short)smm; x->stream.closed = 0; x->stream.file = (void*)fp; @@ -730,7 +730,7 @@ ecl_make_string_input_stream(cl_object strng, cl_index istart, cl_index iend) { cl_object strm; - strm = cl_alloc_object(t_stream); + strm = ecl_alloc_object(t_stream); strm->stream.mode = (short)smm_string_input; strm->stream.closed = 0; strm->stream.file = NULL; @@ -988,7 +988,7 @@ si_set_buffering_mode(cl_object stream, cl_object buffer_mode_symbol) if (buffer_mode != _IONBF) { char *new_buffer; cl_index buffer_size = BUFSIZ; - new_buffer = stream->stream.buffer = cl_alloc_atomic(buffer_size); + new_buffer = stream->stream.buffer = ecl_alloc_atomic(buffer_size); setvbuf(fp, new_buffer, buffer_mode, buffer_size); } } @@ -2563,7 +2563,7 @@ cl_make_synonym_stream(cl_object sym) cl_object x; sym = ecl_check_cl_type(@'make-synonym-stream',sym,t_symbol); - x = cl_alloc_object(t_stream); + x = ecl_alloc_object(t_stream); x->stream.mode = (short)smm_synonym; x->stream.closed = 0; x->stream.file = NULL; @@ -2592,7 +2592,7 @@ cl_synonym_stream_symbol(cl_object strm) not_an_output_stream(x); streams = CONS(x, streams); } - x = cl_alloc_object(t_stream); + x = ecl_alloc_object(t_stream); x->stream.mode = (short)smm_broadcast; x->stream.closed = 0; x->stream.file = NULL; @@ -2621,7 +2621,7 @@ cl_broadcast_stream_streams(cl_object strm) not_an_input_stream(x); streams = CONS(x, streams); } - x = cl_alloc_object(t_stream); + x = ecl_alloc_object(t_stream); x->stream.mode = (short)smm_concatenated; x->stream.closed = 0; x->stream.file = NULL; @@ -2647,7 +2647,7 @@ cl_make_two_way_stream(cl_object istrm, cl_object ostrm) not_an_input_stream(istrm); if (!ecl_output_stream_p(ostrm)) not_an_output_stream(ostrm); - strm = cl_alloc_object(t_stream); + strm = ecl_alloc_object(t_stream); strm->stream.mode = (short)smm_two_way; strm->stream.closed = 0; strm->stream.file = NULL; @@ -2945,7 +2945,7 @@ si_make_string_output_stream_from_string(cl_object s) if (type_of(s) != t_base_string || !s->base_string.hasfillp) FEerror("~S is not a base-string with a fill-pointer.", 1, s); - strm = cl_alloc_object(t_stream); + strm = ecl_alloc_object(t_stream); strm->stream.mode = (short)smm_string_output; strm->stream.closed = 0; strm->stream.file = NULL; @@ -3009,7 +3009,7 @@ cl_object ecl_make_stream_from_FILE(cl_object fname, void *fp, enum ecl_smmode smm) { cl_object stream; - stream = cl_alloc_object(t_stream); + stream = ecl_alloc_object(t_stream); stream->stream.mode = (short)smm; stream->stream.closed = 0; stream->stream.file = fp; @@ -3110,7 +3110,7 @@ init_file(void) cl_object null_stream; cl_object x; - null_stream = cl_alloc_object(t_stream); + null_stream = ecl_alloc_object(t_stream); null_stream->stream.mode = (short)smm_io; null_stream->stream.closed = 1; null_stream->stream.file = NULL; @@ -3124,7 +3124,7 @@ init_file(void) null_stream = cl_make_two_way_stream(null_stream, cl_make_broadcast_stream(0)); cl_core.null_stream = null_stream; - standard_input = cl_alloc_object(t_stream); + standard_input = ecl_alloc_object(t_stream); standard_input->stream.mode = (short)smm_input; standard_input->stream.closed = 0; standard_input->stream.file = stdin; @@ -3136,7 +3136,7 @@ init_file(void) standard_input->stream.byte_size = 8; standard_input->stream.signed_bytes = 0; - standard_output = cl_alloc_object(t_stream); + standard_output = ecl_alloc_object(t_stream); standard_output->stream.mode = (short)smm_output; standard_output->stream.closed = 0; standard_output->stream.file = stdout; @@ -3148,7 +3148,7 @@ init_file(void) standard_output->stream.byte_size = 8; standard_output->stream.signed_bytes = 0; - error_output = cl_alloc_object(t_stream); + error_output = ecl_alloc_object(t_stream); error_output->stream.mode = (short)smm_output; error_output->stream.closed = 0; error_output->stream.file = stderr; @@ -3165,7 +3165,7 @@ init_file(void) ECL_SET(@'*terminal-io*', standard); - x = cl_alloc_object(t_stream); + x = ecl_alloc_object(t_stream); x->stream.mode = (short)smm_synonym; x->stream.closed = 0; x->stream.file = NULL; diff --git a/src/c/gfun.d b/src/c/gfun.d index e2dd35dba..d46a69425 100644 --- a/src/c/gfun.d +++ b/src/c/gfun.d @@ -41,7 +41,7 @@ si_set_raw_funcallable(cl_object instance, cl_object function) if (Null(function)) { if (instance->instance.isgf == 2) { int length = instance->instance.length-1; - cl_object *slots = (cl_object*)cl_alloc(sizeof(cl_object)*(length)); + cl_object *slots = (cl_object*)ecl_alloc(sizeof(cl_object)*(length)); instance->instance.isgf = 2; memcpy(slots, instance->instance.slots, sizeof(cl_object)*(length)); instance->instance.slots = slots; @@ -51,7 +51,7 @@ si_set_raw_funcallable(cl_object instance, cl_object function) } else { if (instance->instance.isgf == 0) { int length = instance->instance.length+1; - cl_object *slots = (cl_object*)cl_alloc(sizeof(cl_object)*length); + cl_object *slots = (cl_object*)ecl_alloc(sizeof(cl_object)*length); memcpy(slots, instance->instance.slots, sizeof(cl_object)*(length-1)); instance->instance.slots = slots; instance->instance.length = length; diff --git a/src/c/hash.d b/src/c/hash.d index 36e1da165..5227d5db5 100644 --- a/src/c/hash.d +++ b/src/c/hash.d @@ -349,13 +349,13 @@ ecl_extend_hashtable(cl_object hashtable) } else { new_size = fix(new_size_obj); } - old = cl_alloc_object(t_hashtable); + old = ecl_alloc_object(t_hashtable); old->hash = hashtable->hash; hashtable->hash.data = NULL; /* for GC sake */ hashtable->hash.entries = 0; hashtable->hash.size = new_size; hashtable->hash.data = (struct ecl_hashtable_entry *) - cl_alloc(new_size * sizeof(struct ecl_hashtable_entry)); + ecl_alloc(new_size * sizeof(struct ecl_hashtable_entry)); for (i = 0; i < new_size; i++) { hashtable->hash.data[i].key = OBJNULL; hashtable->hash.data[i].value = OBJNULL; @@ -451,13 +451,13 @@ cl__make_hash_table(cl_object test, cl_object size, cl_object rehash_size, /* * Build actual hash. */ - h = cl_alloc_object(t_hashtable); + h = ecl_alloc_object(t_hashtable); h->hash.test = htt; h->hash.size = hsize; h->hash.entries = 0; h->hash.data = NULL; /* for GC sake */ h->hash.data = (struct ecl_hashtable_entry *) - cl_alloc(hsize * sizeof(struct ecl_hashtable_entry)); + ecl_alloc(hsize * sizeof(struct ecl_hashtable_entry)); do_clrhash(h); h->hash.rehash_size = rehash_size; diff --git a/src/c/instance.d b/src/c/instance.d index 3969903f6..fc147e4d4 100644 --- a/src/c/instance.d +++ b/src/c/instance.d @@ -20,7 +20,7 @@ cl_object ecl_allocate_instance(cl_object clas, cl_index size) { - cl_object x = cl_alloc_instance(size); + cl_object x = ecl_alloc_instance(size); cl_index i; CLASS_OF(x) = clas; for (i = 0; i < size; i++) diff --git a/src/c/interpreter.d b/src/c/interpreter.d index 4ed632ffb..7e9fdd205 100644 --- a/src/c/interpreter.d +++ b/src/c/interpreter.d @@ -35,7 +35,7 @@ cl_stack_set_size(cl_index tentative_new_size) start_critical_section(); - new_stack = (cl_object *)cl_alloc_atomic(new_size * sizeof(cl_object)); + new_stack = (cl_object *)ecl_alloc_atomic(new_size * sizeof(cl_object)); memcpy(new_stack, cl_env.stack, cl_env.stack_size * sizeof(cl_object)); #ifdef BOEHM_GBC @@ -441,7 +441,7 @@ search_global(register cl_object s) { static cl_object close_around(cl_object fun, cl_object lex) { - cl_object v = cl_alloc_object(t_bclosure); + cl_object v = ecl_alloc_object(t_bclosure); v->bclosure.code = fun; v->bclosure.lex = lex; return v; diff --git a/src/c/load.d b/src/c/load.d index 93a81adfc..874081e23 100644 --- a/src/c/load.d +++ b/src/c/load.d @@ -147,7 +147,7 @@ ecl_library_open(cl_object filename, bool force_reload) { } #endif } - block = cl_alloc_object(t_codeblock); + block = ecl_alloc_object(t_codeblock); block->cblock.self_destruct = self_destruct; block->cblock.name = filename; #ifdef HAVE_DLFCN_H diff --git a/src/c/main.d b/src/c/main.d index 4745ee691..00927701e 100644 --- a/src/c/main.d +++ b/src/c/main.d @@ -124,8 +124,8 @@ ecl_init_env(cl_env_ptr env) #if !defined(ECL_CMU_FORMAT) env->print_pretty = FALSE; - env->queue = cl_alloc_atomic(ECL_PPRINT_QUEUE_SIZE * sizeof(short)); - env->indent_stack = cl_alloc_atomic(ECL_PPRINT_INDENTATION_STACK_SIZE * sizeof(short)); + env->queue = ecl_alloc_atomic(ECL_PPRINT_QUEUE_SIZE * sizeof(short)); + env->indent_stack = ecl_alloc_atomic(ECL_PPRINT_INDENTATION_STACK_SIZE * sizeof(short)); env->fmt_aux_stream = ecl_make_string_output_stream(64); #endif #if !defined(GBC_BOEHM) @@ -140,7 +140,7 @@ ecl_init_env(cl_env_ptr env) #endif /* !GBC_BOEHM */ #ifdef ECL_DYNAMIC_FFI - env->fficall = cl_alloc(sizeof(struct ecl_fficall)); + env->fficall = ecl_alloc(sizeof(struct ecl_fficall)); ((struct ecl_fficall*)env->fficall)->registers = 0; #endif @@ -209,7 +209,7 @@ _ecl_alloc_env() if (output < 0) ecl_internal_error("Unable to allocate environment structure."); #else - output = cl_alloc(sizeof(*cl_env_p)); + output = ecl_alloc(sizeof(*cl_env_p)); #endif return output; } diff --git a/src/c/num_arith.d b/src/c/num_arith.d index 97ef7f212..58245d541 100644 --- a/src/c/num_arith.d +++ b/src/c/num_arith.d @@ -840,7 +840,7 @@ ecl_negate(cl_object x) case t_ratio: z1 = ecl_negate(x->ratio.num); - z = cl_alloc_object(t_ratio); + z = ecl_alloc_object(t_ratio); z->ratio.num = z1; z->ratio.den = x->ratio.den; return(z); @@ -850,12 +850,12 @@ ecl_negate(cl_object x) return make_shortfloat(-ecl_shortfloat(x)); #endif case t_singlefloat: - z = cl_alloc_object(t_singlefloat); + z = ecl_alloc_object(t_singlefloat); sf(z) = -sf(x); return(z); case t_doublefloat: - z = cl_alloc_object(t_doublefloat); + z = ecl_alloc_object(t_doublefloat); df(z) = -df(x); return(z); #ifdef ECL_LONG_FLOAT @@ -1253,12 +1253,12 @@ ecl_one_plus(cl_object x) return make_shortfloat(1.0 + ecl_short_float(x)); #endif case t_singlefloat: - z = cl_alloc_object(t_singlefloat); + z = ecl_alloc_object(t_singlefloat); sf(z) = sf(x) + 1.0; return(z); case t_doublefloat: - z = cl_alloc_object(t_doublefloat); + z = ecl_alloc_object(t_doublefloat); df(z) = df(x) + 1.0; return(z); @@ -1310,12 +1310,12 @@ ecl_one_minus(cl_object x) #endif case t_singlefloat: - z = cl_alloc_object(t_singlefloat); + z = ecl_alloc_object(t_singlefloat); sf(z) = sf(x) - 1.0; return(z); case t_doublefloat: - z = cl_alloc_object(t_doublefloat); + z = ecl_alloc_object(t_doublefloat); df(z) = df(x) - 1.0; return(z); diff --git a/src/c/num_log.d b/src/c/num_log.d index c9881b7dc..0dd611d81 100644 --- a/src/c/num_log.d +++ b/src/c/num_log.d @@ -848,7 +848,7 @@ si_bit_array_op(cl_object o, cl_object x, cl_object y, cl_object r) } L2: if (Null(r)) { - r = cl_alloc_object(t_array); + r = ecl_alloc_object(t_array); r->array.self.t = NULL; r->array.displaced = Cnil; r->array.rank = x->array.rank; diff --git a/src/c/num_rand.d b/src/c/num_rand.d index 31aa4372a..596d440a0 100644 --- a/src/c/num_rand.d +++ b/src/c/num_rand.d @@ -171,7 +171,7 @@ rando(cl_object x, cl_object rs) cl_object ecl_make_random_state(cl_object rs) { - cl_object z = cl_alloc_object(t_random); + cl_object z = ecl_alloc_object(t_random); if (rs == Ct) { z->random.value = init_random_state(); } else { diff --git a/src/c/number.d b/src/c/number.d index 134cc735c..1447f1bb6 100644 --- a/src/c/number.d +++ b/src/c/number.d @@ -87,7 +87,7 @@ cl_object ecl_make_integer(cl_fixnum l) { if (l > MOST_POSITIVE_FIXNUM || l < MOST_NEGATIVE_FIXNUM) { - cl_object z = cl_alloc_object(t_bignum); + cl_object z = ecl_alloc_object(t_bignum); #ifdef WITH_GMP mpz_init_set_si(z->big.big_num, l); #else /* WITH_GMP */ @@ -102,7 +102,7 @@ cl_object ecl_make_unsigned_integer(cl_index l) { if (l > MOST_POSITIVE_FIXNUM) { - cl_object z = cl_alloc_object(t_bignum); + cl_object z = ecl_alloc_object(t_bignum); #ifdef WITH_GMP mpz_init_set_ui(z->big.big_num, l); #else /* WITH_GMP */ @@ -134,7 +134,7 @@ ecl_make_ratio(cl_object num, cl_object den) return num; if (den == MAKE_FIXNUM(-1)) return ecl_negate(num); - r = cl_alloc_object(t_ratio); + r = ecl_alloc_object(t_ratio); r->ratio.num = num; r->ratio.den = den; return(r); @@ -158,7 +158,7 @@ ecl_make_singlefloat(float f) if (!isfinite(f)) { cl_error(1, @'floating-point-overflow'); } - x = cl_alloc_object(t_singlefloat); + x = ecl_alloc_object(t_singlefloat); sf(x) = f; return(x); } @@ -181,7 +181,7 @@ ecl_make_doublefloat(double f) if (!isfinite(f)) { cl_error(1, @'floating-point-overflow'); } - x = cl_alloc_object(t_doublefloat); + x = ecl_alloc_object(t_doublefloat); df(x) = f; return(x); } @@ -205,7 +205,7 @@ make_longfloat(long double f) if (!isfinite(f)) { cl_error(1, @'floating-point-overflow'); } - x = cl_alloc_object(t_longfloat); + x = ecl_alloc_object(t_longfloat); x->longfloat.value = f; return x; } @@ -337,7 +337,7 @@ ecl_make_complex(cl_object r, cl_object i) goto AGAIN; } - c = cl_alloc_object(t_complex); + c = ecl_alloc_object(t_complex); c->complex.real = r; c->complex.imag = i; return(c); @@ -589,12 +589,12 @@ init_number(void) ECL_SET(@'LEAST-NEGATIVE-LONG-FLOAT', num); ECL_SET(@'LEAST-NEGATIVE-NORMALIZED-LONG-FLOAT', num); - cl_core.singlefloat_zero = cl_alloc_object(t_singlefloat); + cl_core.singlefloat_zero = ecl_alloc_object(t_singlefloat); sf(cl_core.singlefloat_zero) = (float)0; - cl_core.doublefloat_zero = cl_alloc_object(t_doublefloat); + cl_core.doublefloat_zero = ecl_alloc_object(t_doublefloat); df(cl_core.doublefloat_zero) = (double)0; #ifdef ECL_LONG_FLOAT - cl_core.longfloat_zero = cl_alloc_object(t_longfloat); + cl_core.longfloat_zero = ecl_alloc_object(t_longfloat); cl_core.longfloat_zero->longfloat.value = (long double)0; #endif cl_core.plus_half = ecl_make_ratio(MAKE_FIXNUM(1), MAKE_FIXNUM(2)); diff --git a/src/c/package.d b/src/c/package.d index 368dd18a9..e14b10ab9 100644 --- a/src/c/package.d +++ b/src/c/package.d @@ -111,7 +111,7 @@ make_package_hashtable() cl_object h; cl_index hsize = 128; - h = cl_alloc_object(t_hashtable); + h = ecl_alloc_object(t_hashtable); h->hash.lockable = 0; h->hash.test = htt_pack; h->hash.size = hsize; @@ -120,7 +120,7 @@ make_package_hashtable() h->hash.factor = 0.7; h->hash.entries = 0; h->hash.data = NULL; /* for GC sake */ - h->hash.data = (struct ecl_hashtable_entry *)cl_alloc(hsize * sizeof(struct ecl_hashtable_entry)); + h->hash.data = (struct ecl_hashtable_entry *)ecl_alloc(hsize * sizeof(struct ecl_hashtable_entry)); return cl_clrhash(h); } @@ -169,7 +169,7 @@ ecl_make_package(cl_object name, cl_object nicknames, cl_object use_list) other, 1, name); return other; } - x = cl_alloc_object(t_package); + x = ecl_alloc_object(t_package); x->pack.internal = make_package_hashtable(); x->pack.external = make_package_hashtable(); #ifdef ECL_THREADS diff --git a/src/c/pathname.d b/src/c/pathname.d index 4e7b446c2..7edb0ed2a 100644 --- a/src/c/pathname.d +++ b/src/c/pathname.d @@ -122,7 +122,7 @@ ecl_make_pathname(cl_object host, cl_object device, cl_object directory, { cl_object x, p, component; - p = cl_alloc_object(t_pathname); + p = ecl_alloc_object(t_pathname); if (ecl_stringp(host)) p->pathname.logical = ecl_logical_hostname_p(host); else if (host == Cnil) @@ -1535,7 +1535,7 @@ copy_list_wildcards(cl_object *wilds, cl_object to) if (source->pathname.logical != from->pathname.logical) goto error; - out = cl_alloc_object(t_pathname); + out = ecl_alloc_object(t_pathname); out->pathname.logical = to->pathname.logical; /* Match host names */ diff --git a/src/c/read.d b/src/c/read.d index f813c166a..9d657ccee 100644 --- a/src/c/read.d +++ b/src/c/read.d @@ -445,7 +445,7 @@ ecl_parse_number(cl_object str, cl_index start, cl_index end, * 'e' or 'E' as exponent markers and we have to make a copy * of the number with this exponent marker. */ cl_index length = end - start; - char *buffer = (char*)cl_alloc_atomic(length+1); + char *buffer = (char*)ecl_alloc_atomic(length+1); char *parse_end; char exp_marker; cl_object output; @@ -750,7 +750,7 @@ sharp_C_reader(cl_object in, cl_object c, cl_object d) if ((CONSP(real) || CONSP(imag)) && !Null(SYM_VAL(@'si::*sharp-eq-context*'))) { - x = cl_alloc_object(t_complex); + x = ecl_alloc_object(t_complex); x->complex.real = real; x->complex.imag = imag; } else { @@ -824,7 +824,7 @@ sharp_Y_reader(cl_object in, cl_object c, cl_object d) FEreader_error("Reader macro #Y should be followed by a list", in, 0); - rv = cl_alloc_object(t_bytecodes); + rv = ecl_alloc_object(t_bytecodes); rv->bytecodes.name = CAR(x); x = CDR(x); lex = CAR(x); x = CDR(x); @@ -832,18 +832,18 @@ sharp_Y_reader(cl_object in, cl_object c, cl_object d) rv->bytecodes.definition = CAR(x); x = CDR(x); rv->bytecodes.code_size = fixint(cl_list_length(CAR(x))); - rv->bytecodes.code = cl_alloc_atomic(rv->bytecodes.code_size * sizeof(uint16_t)); + rv->bytecodes.code = ecl_alloc_atomic(rv->bytecodes.code_size * sizeof(uint16_t)); for ( i=0, nth=CAR(x) ; !ecl_endp(nth) ; i++, nth=CDR(nth) ) ((cl_opcode*)(rv->bytecodes.code))[i] = fixint(CAR(nth)); x = CDR(x); rv->bytecodes.data_size = fixint(cl_list_length(CAR(x))); - rv->bytecodes.data = cl_alloc(rv->bytecodes.data_size * sizeof(cl_object)); + rv->bytecodes.data = ecl_alloc(rv->bytecodes.data_size * sizeof(cl_object)); for ( i=0, nth=CAR(x) ; !ecl_endp(nth) ; i++, nth=CDR(nth) ) ((cl_object*)(rv->bytecodes.data))[i] = CAR(nth); if (lex != Cnil) { - cl_object x = cl_alloc_object(t_bclosure); + cl_object x = ecl_alloc_object(t_bclosure); x->bclosure.code = rv; x->bclosure.lex = lex; rv = x; @@ -1294,7 +1294,7 @@ sharp_dollar_reader(cl_object in, cl_object c, cl_object d) if (d != Cnil && !read_suppress) extra_argument('$', in, d); c = ecl_read_object(in); - rs = cl_alloc_object(t_random); + rs = ecl_alloc_object(t_random); rs->random.value = c; @(return rs) } @@ -1313,10 +1313,10 @@ ecl_copy_readtable(cl_object from, cl_object to) /* Copy also the case for reading */ if (Null(to)) { - to = cl_alloc_object(t_readtable); + to = ecl_alloc_object(t_readtable); to->readtable.table = NULL; /* Saving for GC. */ - to->readtable.table = (struct ecl_readtable_entry *)cl_alloc_align(total_bytes, entry_bytes); + to->readtable.table = (struct ecl_readtable_entry *)ecl_alloc_align(total_bytes, entry_bytes); /* for (i = 0; i < RTABSIZE; i++) rtab[i] = from->readtable.table[i]; @@ -1330,7 +1330,7 @@ ecl_copy_readtable(cl_object from, cl_object to) for (i = 0; i < RTABSIZE; i++) { if (from->readtable.table[i].dispatch_table != NULL) { rtab[i].dispatch_table - = (cl_object *)cl_alloc_align(RTABSIZE * sizeof(cl_object), sizeof(cl_object)); + = (cl_object *)ecl_alloc_align(RTABSIZE * sizeof(cl_object), sizeof(cl_object)); memcpy(rtab[i].dispatch_table, from->readtable.table[i].dispatch_table, RTABSIZE * sizeof(cl_object *)); /* @@ -1826,7 +1826,7 @@ ecl_invalid_character_p(int c) torte->macro = fromrte->macro; if ((torte->dispatch_table = fromrte->dispatch_table) != NULL) { size_t rtab_size = RTABSIZE * sizeof(cl_object); - torte->dispatch_table = (cl_object *)cl_alloc(rtab_size); + torte->dispatch_table = (cl_object *)ecl_alloc(rtab_size); memcpy(torte->dispatch_table, fromrte->dispatch_table, rtab_size); } @(return Ct) @@ -1875,7 +1875,7 @@ ecl_invalid_character_p(int c) entry->syntax_type = cat_non_terminating; else entry->syntax_type = cat_terminating; - table = (cl_object *)cl_alloc(RTABSIZE * sizeof(cl_object)); + table = (cl_object *)ecl_alloc(RTABSIZE * sizeof(cl_object)); entry->dispatch_table = table; for (i = 0; i < RTABSIZE; i++) table[i] = cl_core.default_dispatch_macro; @@ -1962,11 +1962,11 @@ init_read(void) cl_object *dtab; int i; - cl_core.standard_readtable = cl_alloc_object(t_readtable); + cl_core.standard_readtable = ecl_alloc_object(t_readtable); cl_core.standard_readtable->readtable.read_case = ecl_case_upcase; cl_core.standard_readtable->readtable.table = rtab - = (struct ecl_readtable_entry *)cl_alloc(RTABSIZE * sizeof(struct ecl_readtable_entry)); + = (struct ecl_readtable_entry *)ecl_alloc(RTABSIZE * sizeof(struct ecl_readtable_entry)); for (i = 0; i < RTABSIZE; i++) { rtab[i].syntax_type = cat_constituent; rtab[i].macro = OBJNULL; @@ -2006,7 +2006,7 @@ init_read(void) rtab['#'].dispatch_table = dtab - = (cl_object *)cl_alloc(RTABSIZE * sizeof(cl_object)); + = (cl_object *)ecl_alloc(RTABSIZE * sizeof(cl_object)); for (i = 0; i < RTABSIZE; i++) dtab[i] = cl_core.default_dispatch_macro; dtab['C'] = dtab['c'] = make_cf3(sharp_C_reader); @@ -2077,7 +2077,7 @@ read_VV(cl_object block, void (*entry_point)(cl_object)) cl_object *VV, *VVtemp = 0; if (block == NULL) { - block = cl_alloc_object(t_codeblock); + block = ecl_alloc_object(t_codeblock); si_set_finalizer(block, Ct); } block->cblock.entry = entry_point; @@ -2096,7 +2096,7 @@ read_VV(cl_object block, void (*entry_point)(cl_object)) temp_len = block->cblock.temp_data_size; len = perm_len + temp_len; #ifdef ECL_DYNAMIC_VV - VV = block->cblock.data = perm_len? (cl_object *)cl_alloc(perm_len * sizeof(cl_object)) : NULL; + VV = block->cblock.data = perm_len? (cl_object *)ecl_alloc(perm_len * sizeof(cl_object)) : NULL; #else VV = block->cblock.data; #endif @@ -2104,7 +2104,7 @@ read_VV(cl_object block, void (*entry_point)(cl_object)) if ((len == 0) || (block->cblock.data_text == 0)) goto NO_DATA_LABEL; - VVtemp = block->cblock.temp_data = temp_len? (cl_object *)cl_alloc(temp_len * sizeof(cl_object)) : NULL; + VVtemp = block->cblock.temp_data = temp_len? (cl_object *)ecl_alloc(temp_len * sizeof(cl_object)) : NULL; memset(VVtemp, 0, temp_len * sizeof(*VVtemp)); /* Read all data for the library */ diff --git a/src/c/sequence.d b/src/c/sequence.d index b8cbff6a1..ac543832b 100644 --- a/src/c/sequence.d +++ b/src/c/sequence.d @@ -35,7 +35,7 @@ ecl_alloc_simple_vector(cl_index l, cl_elttype aet) return cl_alloc_simple_extended_string(l); #endif case aet_bit: - x = cl_alloc_object(t_bitvector); + x = ecl_alloc_object(t_bitvector); x->vector.hasfillp = FALSE; x->vector.adjustable = FALSE; x->vector.displaced = Cnil; @@ -44,7 +44,7 @@ ecl_alloc_simple_vector(cl_index l, cl_elttype aet) x->vector.self.bit = NULL; break; default: - x = cl_alloc_object(t_vector); + x = ecl_alloc_object(t_vector); x->vector.hasfillp = FALSE; x->vector.adjustable = FALSE; x->vector.displaced = Cnil; diff --git a/src/c/stacks.d b/src/c/stacks.d index d17900d38..30f562bd7 100644 --- a/src/c/stacks.d +++ b/src/c/stacks.d @@ -178,7 +178,7 @@ bds_set_size(cl_index size) } else { cl_index margin = ecl_get_option(ECL_OPT_BIND_STACK_SAFETY_AREA); bds_ptr org; - org = cl_alloc_atomic(size * sizeof(*org)); + org = ecl_alloc_atomic(size * sizeof(*org)); memcpy(org, cl_env.bds_org, (limit + 1) * sizeof(*org)); cl_env.bds_top = org + limit; cl_env.bds_org = org; @@ -347,7 +347,7 @@ frs_set_size(cl_index size) cl_index margin = ecl_get_option(ECL_OPT_FRAME_STACK_SAFETY_AREA); ecl_frame_ptr org; size += 2*margin; - org = cl_alloc_atomic(size * sizeof(*org)); + org = ecl_alloc_atomic(size * sizeof(*org)); memcpy(org, cl_env.frs_org, (limit + 1) * sizeof(*org)); cl_env.frs_top = org + limit; cl_env.frs_org = org; @@ -489,14 +489,14 @@ init_stacks(struct cl_env_struct *env, int *new_cs_org) margin = ecl_get_option(ECL_OPT_FRAME_STACK_SAFETY_AREA); size = ecl_get_option(ECL_OPT_FRAME_STACK_SIZE) + 2 * margin; env->frs_size = size; - env->frs_org = (ecl_frame_ptr)cl_alloc_atomic(size * sizeof(*env->frs_org)); + env->frs_org = (ecl_frame_ptr)ecl_alloc_atomic(size * sizeof(*env->frs_org)); env->frs_top = env->frs_org-1; env->frs_limit = &env->frs_org[size - 2*margin]; margin = ecl_get_option(ECL_OPT_BIND_STACK_SAFETY_AREA); size = ecl_get_option(ECL_OPT_BIND_STACK_SIZE) + 2 * margin; env->bds_size = size; - env->bds_org = (bds_ptr)cl_alloc_atomic(size * sizeof(*env->bds_org)); + env->bds_org = (bds_ptr)ecl_alloc_atomic(size * sizeof(*env->bds_org)); env->bds_top = env->bds_org-1; env->bds_limit = &env->bds_org[size - 2*margin]; @@ -535,7 +535,7 @@ init_stacks(struct cl_env_struct *env, int *new_cs_org) (sizeof(cl_object)*4); } env->altstack_size = size; - env->altstack = cl_alloc_atomic(size); + env->altstack = ecl_alloc_atomic(size); memset(&new_stack, 0, sizeof(new_stack)); new_stack.ss_size = env->altstack_size; new_stack.ss_sp = env->altstack; @@ -544,6 +544,6 @@ init_stacks(struct cl_env_struct *env, int *new_cs_org) } #endif #ifdef SA_SIGINFO - env->interrupt_info = cl_alloc_atomic(sizeof(siginfo_t)); + env->interrupt_info = ecl_alloc_atomic(sizeof(siginfo_t)); #endif } diff --git a/src/c/string.d b/src/c/string.d index c50284dbb..76a4b2907 100644 --- a/src/c/string.d +++ b/src/c/string.d @@ -80,12 +80,12 @@ cl_alloc_simple_base_string(cl_index length) { cl_object x; - x = cl_alloc_object(t_base_string); + x = ecl_alloc_object(t_base_string); x->base_string.hasfillp = FALSE; x->base_string.adjustable = FALSE; x->base_string.displaced = Cnil; x->base_string.dim = (x->base_string.fillp = length); - x->base_string.self = (char *)cl_alloc_atomic(length+1); + x->base_string.self = (char *)ecl_alloc_atomic(length+1); x->base_string.self[length] = x->base_string.self[0] = 0; return(x); } @@ -97,12 +97,12 @@ cl_alloc_simple_extended_string(cl_index length) cl_object x; /* should this call si_make_vector? */ - x = cl_alloc_object(t_string); + x = ecl_alloc_object(t_string); x->string.hasfillp = FALSE; x->string.adjustable = FALSE; x->string.displaced = Cnil; x->string.dim = x->string.fillp = length; - x->string.self = (cl_object *)cl_alloc_align(sizeof (cl_object)*length, sizeof (cl_object)); + x->string.self = (cl_object *)ecl_alloc_align(sizeof (cl_object)*length, sizeof (cl_object)); return(x); } #endif @@ -131,7 +131,7 @@ make_simple_base_string(char *s) cl_object x; cl_index l = strlen(s); - x = cl_alloc_object(t_base_string); + x = ecl_alloc_object(t_base_string); x->base_string.hasfillp = FALSE; x->base_string.adjustable = FALSE; x->base_string.displaced = Cnil; diff --git a/src/c/structure.d b/src/c/structure.d index 1ac555cf9..5fd9fcefc 100644 --- a/src/c/structure.d +++ b/src/c/structure.d @@ -66,11 +66,11 @@ si_structure_subtype_p(cl_object x, cl_object y) cl_object x; int i; @ - x = cl_alloc_object(T_STRUCTURE); + x = ecl_alloc_object(T_STRUCTURE); STYPE(x) = type; SLOTS(x) = NULL; /* for GC sake */ SLENGTH(x) = --narg; - SLOTS(x) = (cl_object *)cl_alloc_align(sizeof(cl_object)*narg, sizeof(cl_object)); + SLOTS(x) = (cl_object *)ecl_alloc_align(sizeof(cl_object)*narg, sizeof(cl_object)); if (narg >= ECL_SLOTS_LIMIT) FEerror("Limit on structure size exceeded: ~S slots requested.", 1, MAKE_FIXNUM(narg)); @@ -90,12 +90,12 @@ ecl_copy_structure(cl_object x) if (!si_structurep(x)) FEwrong_type_argument(@'structure', x); - y = cl_alloc_object(T_STRUCTURE); + y = ecl_alloc_object(T_STRUCTURE); STYPE(y) = STYPE(x); SLENGTH(y) = j = SLENGTH(x); size = sizeof(cl_object)*j; SLOTS(y) = NULL; /* for GC sake */ - SLOTS(y) = (cl_object *)cl_alloc_align(size, sizeof(cl_object)); + SLOTS(y) = (cl_object *)ecl_alloc_align(size, sizeof(cl_object)); memcpy(SLOTS(y), SLOTS(x), size); @(return y) } diff --git a/src/c/symbol.d b/src/c/symbol.d index 874e9303b..943b3394a 100644 --- a/src/c/symbol.d +++ b/src/c/symbol.d @@ -116,7 +116,7 @@ cl_make_symbol(cl_object str) str = ecl_type_error(@'make-symbol',"name",str,@'string'); goto AGAIN; } - x = cl_alloc_object(t_symbol); + x = ecl_alloc_object(t_symbol); x->symbol.name = str; x->symbol.dynamic = 0; ECL_SET(x,OBJNULL); diff --git a/src/c/threads.d b/src/c/threads.d index 70f9f4f76..142f31a92 100644 --- a/src/c/threads.d +++ b/src/c/threads.d @@ -123,7 +123,7 @@ thread_entry_point(cl_object process) static cl_object alloc_process(cl_object name) { - cl_object process = cl_alloc_object(t_process); + cl_object process = ecl_alloc_object(t_process); process->process.active = 0; process->process.name = name; process->process.function = Cnil; @@ -311,7 +311,7 @@ mp_process_run_function(cl_narg narg, cl_object name, cl_object function, ...) cl_object output; @ pthread_mutexattr_init(&attr); - output = cl_alloc_object(t_lock); + output = ecl_alloc_object(t_lock); output->lock.name = name; output->lock.holder = Cnil; output->lock.counter = 0; @@ -405,7 +405,7 @@ mp_make_condition_variable(void) cl_object output; pthread_condattr_init(&attr); - output = cl_alloc_object(t_condition_variable); + output = ecl_alloc_object(t_condition_variable); pthread_cond_init(&output->condition_variable.cv, &attr); pthread_condattr_destroy(&attr); si_set_finalizer(output, Ct); @@ -500,7 +500,7 @@ init_threads(cl_env_ptr env) pthread_mutex_init(&cl_core.global_lock, &attr); pthread_mutexattr_destroy(&attr); - process = cl_alloc_object(t_process); + process = ecl_alloc_object(t_process); process->process.active = 1; process->process.name = @'si::top-level'; process->process.function = Cnil; diff --git a/src/c/threads_win32.d b/src/c/threads_win32.d index db99e264d..77337ce55 100644 --- a/src/c/threads_win32.d +++ b/src/c/threads_win32.d @@ -120,13 +120,13 @@ thread_entry_point(cl_object process) static cl_object alloc_process(cl_object name) { - cl_object process = cl_alloc_object(t_process); + cl_object process = ecl_alloc_object(t_process); process->process.active = 0; process->process.name = name; process->process.function = Cnil; process->process.args = Cnil; process->process.interrupt = Cnil; - process->process.env = cl_alloc(sizeof(*process->process.env)); + process->process.env = ecl_alloc(sizeof(*process->process.env)); process->process.env->own_process = process; return process; } @@ -321,7 +321,7 @@ mp_process_run_function(cl_narg narg, cl_object name, cl_object function, ...) @(defun mp::make-lock (&key name ((:recursive recursive) Ct)) cl_object output; @ - output = cl_alloc_object(t_lock); + output = ecl_alloc_object(t_lock); output->lock.name = name; output->lock.mutex = CreateMutex(NULL, FALSE, NULL); output->lock.holder = Cnil; @@ -466,13 +466,13 @@ init_threads() cl_core.processes = OBJNULL; cl_core.global_lock = CreateMutex(NULL, FALSE, NULL); - process = cl_alloc_object(t_process); + process = ecl_alloc_object(t_process); process->process.active = 1; process->process.name = @'si::top-level'; process->process.function = Cnil; process->process.args = Cnil; process->process.thread = GetCurrentThread(); - process->process.env = env = (struct cl_env_struct*)cl_alloc(sizeof(*env)); + process->process.env = env = (struct cl_env_struct*)ecl_alloc(sizeof(*env)); #ifdef WITH___THREAD cl_env_p = env diff --git a/src/c/unixfsys.d b/src/c/unixfsys.d index 89c0e7d0f..a1d6efd33 100644 --- a/src/c/unixfsys.d +++ b/src/c/unixfsys.d @@ -262,7 +262,7 @@ ERROR: FElibc_error("Can't change the current directory to ~S", void * ecl_backup_fopen(const char *filename, const char *option) { - char *backupfilename = cl_alloc(strlen(filename) + 5); + char *backupfilename = ecl_alloc(strlen(filename) + 5); if (backupfilename == NULL) { FElibc_error("Cannot allocate memory for backup filename", 0); } diff --git a/src/h/external.h b/src/h/external.h index c20ccfef7..eb2210943 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -11,7 +11,7 @@ extern "C" { typedef struct cl_env_struct { /* Flag for disabling interrupts while we call C library functions. */ - int disable_interrupts; + volatile int disable_interrupts; /* The four stacks in ECL. */ @@ -203,19 +203,19 @@ extern ECL_API struct cl_core_struct cl_core; /* alloc.c / alloc_2.c */ -extern ECL_API cl_object cl_alloc_object(cl_type t); -extern ECL_API cl_object cl_alloc_instance(cl_index slots); +extern ECL_API cl_object ecl_alloc_object(cl_type t); +extern ECL_API cl_object ecl_alloc_instance(cl_index slots); extern ECL_API cl_object ecl_cons(cl_object a, cl_object d); extern ECL_API cl_object ecl_list1(cl_object a); #ifdef GBC_BOEHM extern ECL_API cl_object si_gc(cl_object area); extern ECL_API cl_object si_gc_dump(void); extern ECL_API cl_object si_gc_stats(cl_object enable); -#define cl_alloc GC_malloc_ignore_off_page -#define cl_alloc_atomic GC_malloc_atomic_ignore_off_page -#define cl_alloc_align(s,d) GC_malloc_ignore_off_page(s) -#define cl_alloc_atomic_align(s,d) GC_malloc_atomic_ignore_off_page(s) -#define cl_dealloc(p) GC_free(p) +extern ECL_API void *ecl_alloc(cl_index n); +extern ECL_API void *ecl_alloc_atomic(cl_index n); +extern ECL_API void ecl_dealloc(void *); +#define ecl_alloc_align(s,d) ecl_alloc(s) +#define ecl_alloc_atomic_align(s,d) ecl_alloc_atomic(s) #define ecl_register_static_root(x) ecl_register_root(x) #else extern ECL_API cl_object si_allocate _ARGS((cl_narg narg, cl_object type, cl_object qty, ...)); @@ -228,13 +228,13 @@ extern ECL_API cl_object si_allocate_contiguous_pages _ARGS((cl_narg narg, cl_ob extern ECL_API cl_object si_get_hole_size _ARGS((cl_narg narg)); extern ECL_API cl_object si_set_hole_size _ARGS((cl_narg narg, cl_object size)); extern ECL_API cl_object si_ignore_maximum_pages _ARGS((cl_narg narg, ...)); -extern ECL_API void *cl_alloc(cl_index n); -extern ECL_API void *cl_alloc_align(cl_index size, cl_index align); +extern ECL_API void *ecl_alloc(cl_index n); +extern ECL_API void *ecl_alloc_align(cl_index size, cl_index align); extern ECL_API void *ecl_alloc_uncollectable(size_t size); extern ECL_API void ecl_free_uncollectable(void *); -extern ECL_API void cl_dealloc(void *p); -#define cl_alloc_atomic(x) cl_alloc(x) -#define cl_alloc_atomic_align(x,s) cl_alloc_align(x,s) +extern ECL_API void ecl_dealloc(void *p); +#define ecl_alloc_atomic(x) ecl_alloc(x) +#define ecl_alloc_atomic_align(x,s) ecl_alloc_align(x,s) #define ecl_register_static_root(x) ecl_register_root(x); #endif /* GBC_BOEHM */ @@ -1807,6 +1807,19 @@ extern ECL_API cl_object clos_install_method _ARGS((cl_narg narg, cl_object V1, /* standard.lsp */ extern ECL_API cl_object clos_standard_instance_set _ARGS((cl_narg narg, cl_object V1, cl_object V2, cl_object V3, ...)); #endif + +/* + * Deprecated names + */ +#if 0 +#define cl_alloc_instance ecl_alloc_instance +#define cl_alloc_object ecl_alloc_object +#define cl_alloc ecl_alloc +#define cl_alloc_atomic ecl_alloc_atomic +#define cl_alloc_align ecl_alloc_align +#define cl_alloc_atomic_align ecl_alloc_atomic_align +#endif + #endif #ifdef __cplusplus From 8bf59c96ad679fa4c0715afdd5d354372c2c12ea Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Fri, 10 Oct 2008 22:56:15 +0200 Subject: [PATCH 06/60] When resizing the stack, enclose the update in an interrupts-free region --- src/c/interpreter.d | 18 +++++++----------- src/c/stacks.d | 20 ++++++++++++++++---- 2 files changed, 23 insertions(+), 15 deletions(-) diff --git a/src/c/interpreter.d b/src/c/interpreter.d index 7e9fdd205..bcf5668ad 100644 --- a/src/c/interpreter.d +++ b/src/c/interpreter.d @@ -26,35 +26,31 @@ void cl_stack_set_size(cl_index tentative_new_size) { cl_index top = cl_env.stack_top - cl_env.stack; - cl_object *new_stack; + cl_object *new_stack, *old_stack; cl_index safety_area = ecl_get_option(ECL_OPT_LISP_STACK_SAFETY_AREA); cl_index new_size = tentative_new_size + 2*safety_area; if (top > new_size) FEerror("Internal error: cannot shrink stack that much.",0); - start_critical_section(); - + old_stack = cl_env.stack; new_stack = (cl_object *)ecl_alloc_atomic(new_size * sizeof(cl_object)); - memcpy(new_stack, cl_env.stack, cl_env.stack_size * sizeof(cl_object)); -#ifdef BOEHM_GBC - GC_free(cl_env.stack); -#else - cl_dealloc(cl_env.stack); -#endif + ecl_disable_interrupts(); + memcpy(new_stack, old_stack, cl_env.stack_size * sizeof(cl_object)); cl_env.stack_size = new_size; cl_env.stack = new_stack; cl_env.stack_top = cl_env.stack + top; cl_env.stack_limit = cl_env.stack + (new_size - 2*safety_area); + ecl_enable_interrupts(); + + cl_dealloc(old_stack); /* A stack always has at least one element. This is assumed by cl__va_start * and friends, which take a sp=0 to have no arguments. */ if (top == 0) cl_stack_push(MAKE_FIXNUM(0)); - - end_critical_section(); } static void diff --git a/src/c/stacks.d b/src/c/stacks.d index 30f562bd7..33aecabde 100644 --- a/src/c/stacks.d +++ b/src/c/stacks.d @@ -171,7 +171,8 @@ bds_unwind_n(int n) static void bds_set_size(cl_index size) { - cl_index limit = (cl_env.bds_top - cl_env.bds_org); + bds_ptr old_org = cl_env.bds_org; + cl_index limit = cl_env.bds_top - old_org; if (size <= limit) { FEerror("Cannot shrink the binding stack below ~D.", 1, ecl_make_unsigned_integer(limit)); @@ -179,11 +180,16 @@ bds_set_size(cl_index size) cl_index margin = ecl_get_option(ECL_OPT_BIND_STACK_SAFETY_AREA); bds_ptr org; org = ecl_alloc_atomic(size * sizeof(*org)); - memcpy(org, cl_env.bds_org, (limit + 1) * sizeof(*org)); + + ecl_disable_interrupts(); + memcpy(org, old_org, (limit + 1) * sizeof(*org)); cl_env.bds_top = org + limit; cl_env.bds_org = org; cl_env.bds_limit = org + (size - 2*margin); cl_env.bds_size = size; + ecl_enable_interrupts(); + + cl_dealloc(old_org); } } @@ -339,7 +345,8 @@ new_frame_id(void) static void frs_set_size(cl_index size) { - cl_index limit = (cl_env.frs_top - cl_env.frs_org); + ecl_frame_ptr old_org = cl_env.frs_top; + cl_index limit = cl_env.frs_top - old_org; if (size <= limit) { FEerror("Cannot shrink frame stack below ~D.", 1, ecl_make_unsigned_integer(limit)); @@ -348,11 +355,16 @@ frs_set_size(cl_index size) ecl_frame_ptr org; size += 2*margin; org = ecl_alloc_atomic(size * sizeof(*org)); - memcpy(org, cl_env.frs_org, (limit + 1) * sizeof(*org)); + + ecl_disable_interrupts(); + memcpy(org, old_org, (limit + 1) * sizeof(*org)); cl_env.frs_top = org + limit; cl_env.frs_org = org; cl_env.frs_limit = org + (size - 2*margin); cl_env.frs_size = size; + ecl_enable_interrupts(); + + cl_dealloc(old_org); } } From 6bd1b30f5e0cc533579daa80960b3431fabab422 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Fri, 10 Oct 2008 23:25:20 +0200 Subject: [PATCH 07/60] start/end_critical_section does not make sense any more --- src/c/alloc.d | 18 +++++++++--------- src/c/array.d | 2 -- src/c/format.d | 8 ++++---- src/c/gbc.d | 10 ++++------ src/c/tcp.d | 25 ++++++++----------------- src/h/ecl.h | 5 ----- 6 files changed, 25 insertions(+), 43 deletions(-) diff --git a/src/c/alloc.d b/src/c/alloc.d index 03c7b775b..430718fbc 100644 --- a/src/c/alloc.d +++ b/src/c/alloc.d @@ -242,7 +242,7 @@ ecl_alloc_object(cl_type t) default:; } - start_critical_section(); + ecl_disable_interrupts(); tm = tm_of(t); ONCE_MORE: obj = tm->tm_free; @@ -435,7 +435,7 @@ ONCE_MORE: printf("\ttype = %d\n", t); ecl_internal_error("alloc botch."); } - end_critical_section(); + ecl_enable_interrupts(); return(obj); CALL_GC: ecl_gc(tm->tm_type); @@ -469,7 +469,7 @@ ecl_cons(cl_object a, cl_object d) register cl_ptr p; struct typemanager *tm=(&tm_table[(int)t_cons]); - start_critical_section(); + ecl_disable_interrupts(); ONCE_MORE: obj = tm->tm_free; @@ -494,7 +494,7 @@ ONCE_MORE: obj->cons.car = a; obj->cons.cdr = d; - end_critical_section(); + ecl_enable_interrupts(); return(obj); CALL_GC: @@ -542,7 +542,7 @@ ecl_alloc(cl_index n) g = FALSE; n = round_up(n); - start_critical_section(); + ecl_disable_interrupts(); ONCE_MORE: /* Use extra indirection so that cb_pointer can be updated */ for (cbpp = &cb_pointer; (*cbpp) != NULL; cbpp = &(*cbpp)->cb_link) @@ -553,7 +553,7 @@ ONCE_MORE: --ncb; cl_dealloc(p+n, i); - end_critical_section(); + ecl_enable_interrupts(); return(p); } m = round_to_page(n); @@ -587,7 +587,7 @@ Use ALLOCATE-CONTIGUOUS-PAGES to expand the space.", ncbpage += m; cl_dealloc(p+n, LISP_PAGESIZE*m - n); - end_critical_section(); + ecl_enable_interrupts(); return memset(p, 0, n); } @@ -623,13 +623,13 @@ void * ecl_alloc_align(cl_index size, cl_index align) { void *output; - start_critical_section(); + ecl_disable_interrupts(); align--; if (align) output = (void*)(((cl_index)ecl_alloc(size + align) + align - 1) & ~align); else output = ecl_alloc(size); - end_critical_section(); + ecl_enable_interrupts(); return output; } diff --git a/src/c/array.d b/src/c/array.d index c722e288d..b7b3f21e0 100644 --- a/src/c/array.d +++ b/src/c/array.d @@ -419,7 +419,6 @@ ecl_array_allocself(cl_object x) cl_index i, d; d = x->array.dim; - start_critical_section(); /* avoid losing elts */ switch (ecl_array_elttype(x)) { /* assign self field only after it has been filled, for GC sake */ case aet_object: { @@ -508,7 +507,6 @@ ecl_array_allocself(cl_object x) break; } } - end_critical_section(); } cl_elttype diff --git a/src/c/format.d b/src/c/format.d index bc2b36cf0..4a8b619fe 100644 --- a/src/c/format.d +++ b/src/c/format.d @@ -104,14 +104,14 @@ get_aux_stream(void) { cl_object stream; - start_critical_section(); - if (cl_env.fmt_aux_stream == Cnil) + ecl_disable_interrupts(); + if (cl_env.fmt_aux_stream == Cnil) { stream = ecl_make_string_output_stream(64); - else { + } else { stream = cl_env.fmt_aux_stream; cl_env.fmt_aux_stream = Cnil; } - end_critical_section(); + ecl_enable_interrupts(); return stream; } diff --git a/src/c/gbc.d b/src/c/gbc.d index 43ab7a65e..608ec60bb 100644 --- a/src/c/gbc.d +++ b/src/c/gbc.d @@ -775,8 +775,8 @@ ecl_gc(cl_type t) #error "We need to stop all other threads" #endif /* THREADS */ - interrupts = ecl_interrupt_enable; - ecl_interrupt_enable = 0; + interrupts = cl_env.disable_interrupts; + cl_env.disable_interrupts = 1; collect_blocks = t > t_end; if (collect_blocks) @@ -863,7 +863,7 @@ ecl_gc(cl_type t) fflush(stdout); } - ecl_interrupt_enable = interrupts; + cl_env.disable_interrupts = interrupts; if (GC_exit_hook != NULL) (*GC_exit_hook)(); @@ -884,9 +884,7 @@ ecl_gc(cl_type t) fflush(stdout); } - if (cl_env.interrupt_pending) si_check_pending_interrupts(); - - end_critical_section(); + if (cl_env.interrupt_pending) ecl_check_pending_interrupts(); } /* diff --git a/src/c/tcp.d b/src/c/tcp.d index 5fd61a41c..b64bc3f86 100644 --- a/src/c/tcp.d +++ b/src/c/tcp.d @@ -123,6 +123,7 @@ int connect_to_server(char *host, int port) if ((fd = socket((int) addr->sa_family, SOCK_STREAM, 0)) < 0) return(0); /* errno set by system call. */ + ecl_disable_interrupts(); #ifdef TCP_NODELAY /* make sure to turn off TCP coalescence */ #if defined(_MSC_VER) || defined(mingw32) @@ -135,20 +136,15 @@ int connect_to_server(char *host, int port) } #endif #endif - start_critical_section(); if (connect(fd, addr, addrlen) == -1) { #if defined(_MSC_VER) || defined(mingw32) closesocket(fd); #else (void) close (fd); #endif - end_critical_section(); - return(0); /* errno set by system call. */ + fd = 0; } - /* - * Return the id if the connection succeeded. - */ - end_critical_section(); + ecl_enable_interrupts(); return(fd); } @@ -279,9 +275,9 @@ si_open_client_stream(cl_object host, cl_object port) if (host->base_string.fillp > BUFSIZ - 1) FEerror("~S is a too long file name.", 1, host); - start_critical_section(); + ecl_disable_interrupts(); fd = connect_to_server(host->base_string.self, fix(port)); - end_critical_section(); + ecl_enable_interrupts(); if (fd == 0) @(return Cnil) @@ -302,17 +298,12 @@ si_open_server_stream(cl_object port) cl_index p; cl_object output; - start_critical_section(); p = ecl_fixnum_in_range(@'si::open-client-stream',"port",port,0,65535); + ecl_disable_interrupts(); fd = create_server_port(p); - end_critical_section(); + ecl_enable_interrupts(); - if (fd == 0) - output = Cnil; - else { - output = ecl_make_stream_from_fd(Cnil, fd, smm_io); - } - @(return output) + @(return ((fd == 0)? Cnil : ecl_make_stream_from_fd(Cnil, fd, smm_io))) } /************************************************************ diff --git a/src/h/ecl.h b/src/h/ecl.h index 15544f65c..e79219d72 100644 --- a/src/h/ecl.h +++ b/src/h/ecl.h @@ -67,11 +67,6 @@ typedef unsigned short uint16_t; # define CreateThread GC_CreateThread # endif # endif -# define start_critical_section() -# define end_critical_section() -#else -# define start_critical_section() -# define end_critical_section() #endif #include From e578cc9aa823e11cd30dac3d238c3c3f49eeb464 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sat, 11 Oct 2008 00:11:14 +0200 Subject: [PATCH 08/60] DEFENTRY can now wrap forms in no interrupt blocks --- src/lsp/ffi.lsp | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/src/lsp/ffi.lsp b/src/lsp/ffi.lsp index 50239cb4a..70e280d57 100644 --- a/src/lsp/ffi.lsp +++ b/src/lsp/ffi.lsp @@ -733,7 +733,7 @@ defined Lisp function and VALUE-TYPE is its the return type." (c-inline ,args ,arg-types ,result-type ,C-expr :one-liner t)))) -(defmacro defentry (name arg-types c-name) +(defmacro defentry (name arg-types c-name &key no-interrupts) "Syntax: (defentry symbol ({arg-type}*) (value-type function-name)) The compiler defines a Lisp function named by SYMBOL whose body consists of a @@ -746,9 +746,15 @@ CHAR, CHAR*, FLOAT, DOUBLE are allowed for these types." (if (consp c-name) (setf output-type (first c-name) c-name (second c-name))) - (setf c-name (string c-name)) - `(defun ,name ,args - (c-inline ,args ,arg-types ,output-type - ,(produce-function-call c-name (length arg-types)) - :one-liner t)))) + (let* ((call (produce-function-call (string c-name) (length arg-types))) + (full-text (if no-interrupts + (concatenate 'string + "ecl_disable_interrupts();@(return)=" + call + ";ecl_enable_interrupts();") + call))) + `(defun ,name ,args + (c-inline ,args ,arg-types ,output-type + ,full-text + :one-liner ,(not no-interrupts)))))) From 8a3350f1807afdcd0c699668e0a141ec8e119135 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sat, 11 Oct 2008 00:28:17 +0200 Subject: [PATCH 09/60] Protect the socket library with no-interrupt blocks --- contrib/sockets/sockets.lisp | 153 +++++++++++++++++++++++++++-------- 1 file changed, 120 insertions(+), 33 deletions(-) diff --git a/contrib/sockets/sockets.lisp b/contrib/sockets/sockets.lisp index 44846cae4..19469aa23 100644 --- a/contrib/sockets/sockets.lisp +++ b/contrib/sockets/sockets.lisp @@ -86,10 +86,14 @@ " { WSADATA wsadata; + cl_object output; + ecl_disable_interrupts(); if (WSAStartup(MAKEWORD(2,2), &wsadata) == NO_ERROR) - @(return) = Ct; + output = Ct; else - @(return) = Cnil; + output = Cnil; + ecl_enable_interrupts(); + @(return output) }") (setf +wsock-initialized+ t) (error "Unable to initialize Windows Socket library")))) @@ -121,10 +125,10 @@ ;; Foreign functions -(defentry ff-socket (:int :int :int) (:int "socket")) -(defentry ff-listen (:int :int) (:int "listen")) -(defentry ff-close (:int) (:int "close")) -#+:wsock (defentry ff-closesocket (:int) (:int "closesocket")) +(defentry ff-socket (:int :int :int) (:int "socket") :no-interrupts t) +(defentry ff-listen (:int :int) (:int "listen") :no-interrupts t) +(defentry ff-close (:int) (:int "close") :no-interrupts t) +#+:wsock (defentry ff-closesocket (:int) (:int "closesocket") :no-interrupts t) ;;; This courtesy of Pierre Mai in comp.lang.lisp 08 Jan 1999 00:51:44 +0100 ;;; Message-ID: <87lnjebq0f.fsf@orion.dent.isdn.cs.tu-berlin.de> @@ -236,7 +240,9 @@ weird stuff - see gethostbyname(3) for grisly details." vector[1] = fixint(ecl_aref(#0,1)); vector[2] = fixint(ecl_aref(#0,2)); vector[3] = fixint(ecl_aref(#0,3)); + ecl_disable_interrupts(); hostent = gethostbyaddr(vector,4,AF_INET); + ecl_enable_interrupts(); if (hostent != NULL) { char **aliases; @@ -479,9 +485,12 @@ safe_buffer_pointer(cl_object x, cl_index size) ( #4 ? MSG_PEEK : 0 ) | ( #5 ? MSG_WAITALL : 0 ); cl_type type = type_of(#1); + ssize_t len; - ssize_t len = recvfrom(#0, safe_buffer_pointer(#1, #2), - #2, flags, NULL,NULL); + ecl_disable_interrupts(); + len = recvfrom(#0, safe_buffer_pointer(#1, #2), + #2, flags, NULL,NULL); + ecl_enable_interrupts(); if (len >= 0) { if (type == t_vector) { #1->vector.fillp = len; } else if (type == t_base_string) { #1->base_string.fillp = len; } @@ -568,9 +577,12 @@ static void fill_inet_sockaddr(struct sockaddr_in *sockaddr, int port, " { struct sockaddr_in sockaddr; - + int output; + ecl_disable_interrupts(); fill_inet_sockaddr(&sockaddr, #0, #1, #2, #3, #4); - @(return) = bind(#5,(struct sockaddr*)&sockaddr, sizeof(struct sockaddr_in)); + output = bind(#5,(struct sockaddr*)&sockaddr, sizeof(struct sockaddr_in)); + ecl_enable_interrupts(); + @(return) = output; }" :side-effects t)) (socket-error "bind")))) @@ -582,7 +594,11 @@ static void fill_inet_sockaddr(struct sockaddr_in *sockaddr, int port, "{ struct sockaddr_in sockaddr; socklen_t addr_len = (socklen_t)sizeof(struct sockaddr_in); - int new_fd = accept(#0, (struct sockaddr*)&sockaddr, &addr_len); + int new_fd; + + ecl_disable_interrupts(); + new_fd = accept(#0, (struct sockaddr*)&sockaddr, &addr_len); + ecl_enable_interrupts(); @(return 0) = new_fd; @(return 1) = Cnil; @@ -621,9 +637,14 @@ static void fill_inet_sockaddr(struct sockaddr_in *sockaddr, int port, " { struct sockaddr_in sockaddr; + int output; + ecl_disable_interrupts(); fill_inet_sockaddr(&sockaddr, #0, #1, #2, #3, #4); - @(return) = connect(#5,(struct sockaddr*)&sockaddr, sizeof(struct sockaddr_in)); + output = connect(#5,(struct sockaddr*)&sockaddr, sizeof(struct sockaddr_in)); + ecl_enable_interrupts(); + + @(return) = output; }")) (socket-error "connect")))) @@ -634,7 +655,11 @@ static void fill_inet_sockaddr(struct sockaddr_in *sockaddr, int port, "@01;{ struct sockaddr_in name; socklen_t len = sizeof(struct sockaddr_in); - int ret = getpeername(#0,(struct sockaddr*)&name,&len); + int ret; + + ecl_disable_interrupts(); + ret = getpeername(#0,(struct sockaddr*)&name,&len); + ecl_enable_interrupts(); if (ret == 0) { uint32_t ip = ntohl(name.sin_addr.s_addr); @@ -661,7 +686,11 @@ static void fill_inet_sockaddr(struct sockaddr_in *sockaddr, int port, "@01;{ struct sockaddr_in name; socklen_t len = sizeof(struct sockaddr_in); - int ret = getsockname(#0,(struct sockaddr*)&name,&len); + int ret; + + ecl_disable_interrupts(); + ret = getsockname(#0,(struct sockaddr*)&name,&len); + ecl_enable_interrupts(); if (ret == 0) { uint32_t ip = ntohl(name.sin_addr.s_addr); @@ -721,11 +750,12 @@ static void fill_inet_sockaddr(struct sockaddr_in *sockaddr, int port, struct sockaddr_in sockaddr; ssize_t len; + ecl_disable_interrupts(); fill_inet_sockaddr(&sockaddr, #3, #4, #5, #6, #7); - len = sendto(#0, safe_buffer_pointer(#1,#2), #2, flags,(struct sockaddr*)&sockaddr, sizeof(struct sockaddr_in)); + ecl_enable_interrupts(); @(return) = len; } " @@ -744,8 +774,10 @@ static void fill_inet_sockaddr(struct sockaddr_in *sockaddr, int port, ( #7 ? MSG_NOSIGNAL : 0 ) | ( #8 ? MSG_CONFIRM : 0 ); cl_type type = type_of(#1); - - ssize_t len = send(#0, safe_buffer_pointer(#1,#2), #2, flags); + ssize_t len; + ecl_disable_interrupts(); + len = send(#0, safe_buffer_pointer(#1,#2), #2, flags); + ecl_enable_interrupts(); @(return) = len; } " @@ -779,7 +811,7 @@ also known as unix-domain sockets.")) { struct sockaddr_un sockaddr; size_t size; - + int output; #ifdef BSD sockaddr.sun_len = sizeof(struct sockaddr_un); #endif @@ -787,7 +819,11 @@ also known as unix-domain sockets.")) strncpy(sockaddr.sun_path,#1,sizeof(sockaddr.sun_path)); sockaddr.sun_path[sizeof(sockaddr.sun_path)-1] = '\0'; - @(return) = bind(#0,(struct sockaddr*)&sockaddr, sizeof(struct sockaddr_un)); + ecl_disable_interrupts(); + output = bind(#0,(struct sockaddr*)&sockaddr, sizeof(struct sockaddr_un)); + ecl_enable_interrupts(); + + @(return) = output; }")) (socket-error "bind")))) @@ -797,7 +833,10 @@ also known as unix-domain sockets.")) "{ struct sockaddr_un sockaddr; socklen_t addr_len = (socklen_t)sizeof(struct sockaddr_un); - int new_fd = accept(#0, (struct sockaddr *)&sockaddr, &addr_len); + int new_fd; + ecl_disable_interrupts(); + new_fd = accept(#0, (struct sockaddr *)&sockaddr, &addr_len); + ecl_enable_interrupts(); @(return 0) = new_fd; @(return 1) = (new_fd == -1) ? Cnil : make_base_string_copy(sockaddr.sun_path); }") @@ -822,7 +861,7 @@ also known as unix-domain sockets.")) " { struct sockaddr_un sockaddr; - + int output; #ifdef BSD sockaddr.sun_len = sizeof(struct sockaddr_un); #endif @@ -830,7 +869,11 @@ also known as unix-domain sockets.")) strncpy(sockaddr.sun_path,#2,sizeof(sockaddr.sun_path)); sockaddr.sun_path[sizeof(sockaddr.sun_path)-1] = '\0'; - @(return) = connect(#0,(struct sockaddr*)&sockaddr, sizeof(struct sockaddr_un)); + ecl_disable_interrupts(); + output = connect(#0,(struct sockaddr*)&sockaddr, sizeof(struct sockaddr_un)); + ecl_enable_interrupts(); + + @(return) = output; }")) (socket-error "connect")))) @@ -841,7 +884,11 @@ also known as unix-domain sockets.")) { struct sockaddr_un name; socklen_t len = sizeof(struct sockaddr_un); - int ret = getpeername(#0,(struct sockaddr*)&name,&len); + int ret; + + ecl_disable_interrupts(); + ret = getpeername(#0,(struct sockaddr*)&name,&len); + ecl_enable_interrupts(); if (ret == 0) { @(return) = make_base_string_copy(name.sun_path); @@ -952,7 +999,9 @@ also known as unix-domain sockets.")) (hnd (c-inline (pipe-name) (:cstring) :int " { - HANDLE hnd = CreateNamedPipe( + HANDLE hnd; + ecl_disable_interrupts(); + hnd = CreateNamedPipe( #0, PIPE_ACCESS_DUPLEX, PIPE_TYPE_BYTE | PIPE_READMODE_BYTE | PIPE_WAIT, @@ -961,6 +1010,7 @@ also known as unix-domain sockets.")) 4096, NMPWAIT_USE_DEFAULT_WAIT, NULL); + ecl_enable_interrupts(); if (hnd == INVALID_HANDLE_VALUE) @(return) = -1; else @@ -977,10 +1027,12 @@ also known as unix-domain sockets.")) " { HANDLE hnd = _get_osfhandle(#0), dupHnd; + ecl_disable_interrupts(); if (ConnectNamedPipe(hnd, NULL) != 0 || GetLastError() == ERROR_PIPE_CONNECTED) { @(return) = #0; } else @(return) = -1; + ecl_enable_interrupts(); }" :one-liner nil))) (cond @@ -1006,7 +1058,9 @@ also known as unix-domain sockets.")) (c-inline (pipe-name) (:cstring) :int " { - HANDLE hnd = CreateFile( + HANDLE hnd; + ecl_disable_interrupts(); + hnd = CreateFile( #0, GENERIC_READ | GENERIC_WRITE, 0, @@ -1018,6 +1072,7 @@ also known as unix-domain sockets.")) @(return) = -1; else @(return) = _open_osfhandle(hnd, O_RDWR); + ecl_enable_interrupts(); }"))) (socket-error "connect") (setf (slot-value socket 'pipe-name) pipe-name)))) @@ -1032,7 +1087,9 @@ also known as unix-domain sockets.")) " { DWORD mode = PIPE_READMODE_BYTE | (#1 == Ct ? PIPE_NOWAIT : PIPE_WAIT); + ecl_disable_interrupts(); @(return) = SetNamedPipeHandleState(_get_osfhandle(#0), &mode, NULL, NULL); + ecl_enable_interrupts(); }" :one-liner nil)) (socket-error "SetNamedPipeHandleState") @@ -1044,12 +1101,14 @@ also known as unix-domain sockets.")) " { DWORD flags; + ecl_disable_interrupts(); if (!GetNamedPipeInfo(_get_osfhandle(#0), &flags, NULL, NULL, NULL)) @(return) = Cnil; if (flags == PIPE_CLIENT_END || DisconnectNamedPipe(_get_osfhandle(#0))) @(return) = Ct; else @(return) = Cnil; + ecl_enable_interrupts(); }" :one-liner nil) (socket-error "DisconnectNamedPipe")) @@ -1078,7 +1137,9 @@ also known as unix-domain sockets.")) " { int blocking_flag = (#1 ? 1 : 0); + ecl_disable_interrupts(); @(return) = ioctlsocket(#0, FIONBIO, (u_long*)&blocking_flag); + ecl_enable_interrupts(); }" #-:wsock " @@ -1086,7 +1147,9 @@ also known as unix-domain sockets.")) int oldflags = fcntl(#0,F_GETFL,NULL); int newflags = (oldflags & ~O_NONBLOCK) | (#1 ? O_NONBLOCK : 0); + ecl_disable_interrupts(); @(return) = fcntl(#0,F_SETFL,newflags); + ecl_enable_interrupts(); }")) (socket-error #-:wsock "fcntl" #+:wsock "ioctlsocket") #-:wsock non-blocking-p @@ -1164,6 +1227,7 @@ also known as unix-domain sockets.")) (c-inline (num) (:int) t "{char *lpMsgBuf; cl_object msg; + ecl_disable_interrupts(); FormatMessage( FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM, NULL, @@ -1174,6 +1238,7 @@ also known as unix-domain sockets.")) NULL); msg = make_base_string_copy(lpMsgBuf); LocalFree(lpMsgBuf); + ecl_enable_interrupts(); @(return) = msg;}" :one-liner nil)) @@ -1324,9 +1389,12 @@ GET-NAME-SERVICE-ERRNO") (defun get-sockopt-int (fd const) (let ((ret (c-inline (fd const) (:int :int) t "{ - int sockopt; + int sockopt, ret; socklen_t socklen = sizeof(int); - int ret = getsockopt(#0,SOL_SOCKET,#1,&sockopt,&socklen); + + ecl_disable_interrupts(); + ret = getsockopt(#0,SOL_SOCKET,#1,&sockopt,&socklen); + ecl_enable_interrupts(); @(return) = (ret == 0) ? ecl_make_integer(sockopt) : Cnil; }"))) @@ -1338,9 +1406,12 @@ GET-NAME-SERVICE-ERRNO") (defun get-sockopt-bool (fd const) (let ((ret (c-inline (fd const) (:int :int) t "{ - int sockopt; + int sockopt, ret; socklen_t socklen = sizeof(int); - int ret = getsockopt(#0,SOL_SOCKET,#1,&sockopt,&socklen); + + ecl_disable_interrupts(); + ret = getsockopt(#0,SOL_SOCKET,#1,&sockopt,&socklen); + ecl_enable_interrupts(); @(return) = (ret == 0) ? Ct : Cnil; }"))) @@ -1358,7 +1429,11 @@ GET-NAME-SERVICE-ERRNO") "{ struct timeval tv; socklen_t socklen = sizeof(struct timeval); - int ret = getsockopt(#0,SOL_SOCKET,#1,&tv,&socklen); + int ret; + + ecl_disable_interrupts(); + ret = getsockopt(#0,SOL_SOCKET,#1,&tv,&socklen); + ecl_enable_interrupts(); @(return) = (ret == 0) ? ecl_make_doublefloat((double)tv.tv_sec + ((double)tv.tv_usec) / 1000000.0) : Cnil; @@ -1371,7 +1446,12 @@ GET-NAME-SERVICE-ERRNO") (let ((ret (c-inline (fd const value) (:int :int :int) t "{ int sockopt = #2; - int ret = setsockopt(#0,SOL_SOCKET,#1,&sockopt,sizeof(int)); + int ret; + + ecl_disable_interrupts(); + ret = setsockopt(#0,SOL_SOCKET,#1,&sockopt,sizeof(int)); + ecl_enable_interrupts(); + @(return) = (ret == 0) ? Ct : Cnil; }"))) (if ret @@ -1382,7 +1462,12 @@ GET-NAME-SERVICE-ERRNO") (let ((ret (c-inline (fd const value) (:int :int :object) t "{ int sockopt = (#2 == Cnil) ? 0 : 1; - int ret = setsockopt(#0,SOL_SOCKET,#1,&sockopt,sizeof(int)); + int ret; + + ecl_disable_interrupts(); + ret = setsockopt(#0,SOL_SOCKET,#1,&sockopt,sizeof(int)); + ecl_enable_interrupts(); + @(return) = (ret == 0) ? Ct : Cnil; }"))) (if ret @@ -1397,10 +1482,12 @@ GET-NAME-SERVICE-ERRNO") double tmp = #2; int ret; + ecl_disable_interrupts(); tv.tv_sec = (int)tmp; tv.tv_usec = (int)((tmp-trunc(tmp))*1000000.0); - ret = setsockopt(#0,SOL_SOCKET,#1,&tv,sizeof(struct timeval)); + ecl_enable_interrupts(); + @(return) = (ret == 0) ? Ct : Cnil; }"))) (if ret From cbe49afc5b98c12540ab50dc9d28cef3e95e384d Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sat, 11 Oct 2008 11:38:15 +0200 Subject: [PATCH 10/60] Unify the sources for windows and posix threads --- msvc/c/Makefile | 2 +- src/c/alloc_2.d | 15 +- src/c/big.d | 10 +- src/c/main.d | 9 +- src/c/number.d | 2 +- src/c/symbols_list.h | 1 - src/c/symbols_list2.h | 1 - src/c/threads.d | 198 +++++++++++++++-- src/c/threads_win32.d | 488 ------------------------------------------ src/c/unixfsys.d | 343 ++++++++++++++++------------- src/h/external.h | 1 - src/h/internal.h | 4 +- 12 files changed, 387 insertions(+), 687 deletions(-) delete mode 100644 src/c/threads_win32.d diff --git a/msvc/c/Makefile b/msvc/c/Makefile index f4dd95b07..b4acf7c68 100644 --- a/msvc/c/Makefile +++ b/msvc/c/Makefile @@ -5,7 +5,7 @@ top_srcdir = ..\..\src srcdir = ..\..\src\c !if "$(ECL_THREADS)" != "" -THREADS_OBJ= threads_win32.obj +THREADS_OBJ= threads.obj THREADS_FLAGS= -DECL_THREADS !else THREADS_OBJ= diff --git a/src/c/alloc_2.d b/src/c/alloc_2.d index eaf941641..dcddb5b45 100644 --- a/src/c/alloc_2.d +++ b/src/c/alloc_2.d @@ -522,26 +522,15 @@ ecl_mark_env(struct cl_env_struct *env) GC_set_mark_bit((void *)env->bds_org); } #endif -#if 0 - GC_push_all(&(env->lex_env), &(env->lex_env)+1); - GC_push_all(&(env->string_pool), &(env->print_base)); -#if !defined(ECL_CMU_FORMAT) - GC_push_all(&(env->queue), &(env->qh)); -#endif - GC_push_all(env->big_register, env->big_register + 3); - if (env->nvalues) - GC_push_all(env->values, env->values + env->nvalues + 1); -#else /*memset(env->values[env->nvalues], 0, (64-env->nvalues)*sizeof(cl_object));*/ -#ifdef ECL_THREADS +#if defined(ECL_THREADS) && !defined(ECL_USE_MPROTECT) /* When using threads, "env" is a pointer to memory allocated by ECL. */ GC_push_conditional((void *)env, (void *)(env + 1), 1); GC_set_mark_bit((void *)env); #else - /* When not using threads, "env" is a statically allocated structure. */ + /* When not using threads, "env" is mmaped or statically allocated. */ GC_push_all((void *)env, (void *)(env + 1)); #endif -#endif } static void diff --git a/src/c/big.d b/src/c/big.d index ab2d4116a..31457d0f4 100644 --- a/src/c/big.d +++ b/src/c/big.d @@ -281,18 +281,18 @@ mp_free(void *ptr, size_t size) cl_dealloc(x); } -void init_big_registers(void) +void init_big_registers(cl_env_ptr env) { int i; for (i = 0; i < 3; i++) { - cl_env.big_register[i] = ecl_alloc_object(t_bignum); - big_register_free(cl_env.big_register[i]); + env->big_register[i] = ecl_alloc_object(t_bignum); + big_register_free(env->big_register[i]); } } void -init_big(void) +init_big(cl_env_ptr env) { - init_big_registers(); + init_big_registers(env); mp_set_memory_functions(mp_alloc, mp_realloc, mp_free); } diff --git a/src/c/main.d b/src/c/main.d index 00927701e..ec56b1e21 100644 --- a/src/c/main.d +++ b/src/c/main.d @@ -204,13 +204,14 @@ _ecl_alloc_env() { cl_env_ptr output; #if defined(ECL_USE_MPROTECT) - output = mmap(0, sizeof(*cl_env_p), PROT_READ | PROT_WRITE, + output = mmap(0, sizeof(*output), PROT_READ | PROT_WRITE, MAP_ANON | MAP_PRIVATE, 0, 0); if (output < 0) ecl_internal_error("Unable to allocate environment structure."); #else - output = ecl_alloc(sizeof(*cl_env_p)); + output = ecl_alloc(sizeof(*output)); #endif + output->disable_interrupts = 1; return output; } @@ -273,10 +274,6 @@ cl_boot(int argc, char **argv) init_threads(cl_env_p); #endif -#if !defined(MSDOS) && !defined(cygwin) - ecl_self = ecl_expand_pathname(ecl_self); -#endif - /* * 1) Initialize symbols and packages */ diff --git a/src/c/number.d b/src/c/number.d index 1447f1bb6..4458900a9 100644 --- a/src/c/number.d +++ b/src/c/number.d @@ -612,7 +612,7 @@ init_number(void) ECL_SET(@'pi', ecl_make_doublefloat((double)ECL_PI_D)); #endif - init_big(); + init_big(&cl_env); ECL_SET(@'*random-state*', ecl_make_random_state(Ct)); } diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index 1bf8cbc6c..b139d9442 100644 --- a/src/c/symbols_list.h +++ b/src/c/symbols_list.h @@ -1489,7 +1489,6 @@ cl_symbols[] = { {MP_ "+LOAD-COMPILE-LOCK+", MP_CONSTANT, NULL, -1, OBJNULL}, {MP_ "WITH-LOCK", MP_CONSTANT, NULL, -1, OBJNULL}, {MP_ "WITHOUT-INTERRUPTS", MP_CONSTANT, NULL, -1, OBJNULL}, -{MP_ "CHECK-PENDING-INTERRUPTS", SI_ORDINARY, si_check_pending_interrupts, 0, OBJNULL}, #endif {SYS_ "WHILE", SI_ORDINARY, NULL, -1, OBJNULL}, diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h index 4b684e396..adf2dad68 100644 --- a/src/c/symbols_list2.h +++ b/src/c/symbols_list2.h @@ -1489,7 +1489,6 @@ cl_symbols[] = { {MP_ "+LOAD-COMPILE-LOCK+",NULL}, {MP_ "WITH-LOCK",NULL}, {MP_ "WITHOUT-INTERRUPTS",NULL}, -{MP_ "CHECK-PENDING-INTERRUPTS","si_check_pending_interrupts"}, #endif {SYS_ "WHILE",NULL}, diff --git a/src/c/threads.d b/src/c/threads.d index 142f31a92..55fde20f0 100644 --- a/src/c/threads.d +++ b/src/c/threads.d @@ -31,11 +31,29 @@ # include #endif +#if defined(_MSVC) || defined(mingw32) +#define ECL_WINDOWS_THREADS +/* + * We have to put this explicit definition here because Boehm GC + * is designed to produce a DLL and we rather want a static + * reference + */ +#include +#include +extern HANDLE WINAPI GC_CreateThread( + LPSECURITY_ATTRIBUTES lpThreadAttributes, + DWORD dwStackSize, LPTHREAD_START_ROUTINE lpStartAddress, + LPVOID lpParameter, DWORD dwCreationFlags, LPDWORD lpThreadId ); +#ifndef WITH___THREAD +DWORD cl_env_key; +#endif +static DWORD main_thread; +#else #ifndef WITH___THREAD static pthread_key_t cl_env_key; #endif - static pthread_t main_thread; +#endif extern void ecl_init_env(struct cl_env_struct *env); @@ -43,11 +61,15 @@ extern void ecl_init_env(struct cl_env_struct *env); struct cl_env_struct * ecl_process_env(void) { +#ifdef ECL_WINDOWS_THREADS + return TlsGetValue(cl_env_key); +#else struct cl_env_struct *rv = pthread_getspecific(cl_env_key); if (rv) return rv; FElibc_error("pthread_getspecific() failed.", 0); return NULL; +#endif } #endif @@ -90,16 +112,22 @@ thread_cleanup(void *env) static void * thread_entry_point(cl_object process) { + cl_env_ptr env = process->process.env; + /* 1) Setup the environment for the execution of the thread */ - pthread_cleanup_push(thread_cleanup, (void *)process->process.env); + pthread_cleanup_push(thread_cleanup, (void *)env); + ecl_init_env(env); + init_big_registers(env); #ifdef WITH___THREAD - cl_env_p = process->process.env; + cl_env_p = env; #else - if (pthread_setspecific(cl_env_key, process->process.env)) +# ifdef ECL_WINDOWS_THREADS + TlsSetValue(cl_env_key, env); +# else + if (pthread_setspecific(cl_env_key, env)) FElibc_error("pthread_setcspecific() failed.", 0); +# endif #endif - ecl_init_env(process->process.env); - init_big_registers(); /* 2) Execute the code. The CATCH_ALL point is the destination * provides us with an elegant way to exit the thread: we just @@ -116,8 +144,13 @@ thread_entry_point(cl_object process) /* 3) If everything went right, we should be exiting the thread * through this point. thread_cleanup is automatically invoked. */ +#ifdef ECL_WINDOWS_THREADS + thread_cleanup(env); + return 1; +#else pthread_cleanup_pop(1); return NULL; +#endif } static cl_object @@ -155,15 +188,21 @@ void ecl_import_current_thread(cl_object name, cl_object bindings) { cl_object process = alloc_process(name); -#ifdef WITH___THREAD - cl_env_p = process->process.env; -#else - if (pthread_setspecific(cl_env_key, process->process.env)) - FElibc_error("pthread_setcspecific() failed.", 0); -#endif + cl_env_ptr env = process->process.env; initialize_process_bindings(process, bindings); - ecl_init_env(&cl_env); - init_big_registers(); + ecl_init_env(env); + init_big_registers(env); + ecl_enable_interrupts_env(env); +#ifdef WITH___THREAD + cl_env_p = env; +#else +# ifdef ECL_WINDOWS_THREADS + TlsSetValue(cl_env_key, env); +# else + if (pthread_setspecific(cl_env_key, env)) + FElibc_error("pthread_setcspecific() failed.", 0); +# endif +#endif } void @@ -198,17 +237,34 @@ mp_interrupt_process(cl_object process, cl_object function) { if (mp_process_active_p(process) == Cnil) FEerror("Cannot interrupt the inactive process ~A", 1, process); +#ifdef ECL_WINDOWS_THREADS + { + CONTEXT context; + HANDLE thread = process->process.thread; + if (SuspendThread(thread) == (DWORD)-1) + FEwin32_error("Cannot suspend process ~A", 1, process); + context.ContextFlags = CONTEXT_CONTROL | CONTEXT_INTEGER; + if (!GetThreadContext(thread, &context)) + FEwin32_error("Cannot get context for process ~A", 1, process); + context.Eip = process_interrupt_handler; + if (!SetThreadContext(thread, &context)) + FEwin32_error("Cannot set context for process ~A", 1, process); + process->process.interrupt = function; + if (ResumeThread(thread) == (DWORD)-1) + FEwin32_error("Cannot resume process ~A", 1, process); + } +#else process->process.interrupt = function; if ( pthread_kill(process->process.thread, SIGUSR1) ) FElibc_error("pthread_kill() failed.", 0); +#endif @(return Ct) } cl_object mp_process_kill(cl_object process) { - mp_interrupt_process(process, @'mp::exit-process'); - @(return Ct) + return mp_interrupt_process(process, @'mp::exit-process'); } cl_object @@ -217,7 +273,11 @@ mp_process_yield(void) #ifdef HAVE_SCHED_YIELD sched_yield(); #else +# if defined(_MSVC) || defined(mingw32) + Sleep(0); +# else sleep(0); /* Use sleep(0) to yield to a >= priority thread */ +# endif #endif @(return) } @@ -225,6 +285,25 @@ mp_process_yield(void) cl_object mp_process_enable(cl_object process) { + cl_object output; +#ifdef ECL_WINDOWS_THREADS + HANDLE code; + DWORD threadId; + + if (mp_process_active_p(process) != Cnil) + FEerror("Cannot enable the running process ~A.", 1, process); + THREAD_OP_LOCK(); + code = (HANDLE)CreateThread(NULL, 0, thread_entry_point, process, 0, &threadId); + if (code) { + /* If everything went ok, add the thread to the list. */ + cl_core.processes = CONS(process, cl_core.processes); + output = process; + } else { + output = Cnil; + } + process->process.thread = code; + THREAD_OP_UNLOCK(); +#else pthread_t *posix_thread; int code; @@ -232,18 +311,27 @@ mp_process_enable(cl_object process) FEerror("Cannot enable the running process ~A.", 1, process); THREAD_OP_LOCK(); code = pthread_create(&process->process.thread, NULL, thread_entry_point, process); - if (!code) { + if (code) { + output = Cnil; + } else { /* If everything went ok, add the thread to the list. */ cl_core.processes = CONS(process, cl_core.processes); + output = process; } /* FIXME: how to do FElibc_error() without leaving a lock? */ THREAD_OP_UNLOCK(); - @(return (code? Cnil : process)) +#endif + @(return output) } cl_object mp_exit_process(void) { - if (pthread_equal(pthread_self(), main_thread)) { +#ifdef ECL_WINDOWS_THREADS + int same = GetCurrentThreadId() == main_thread; +#else + int same = pthread_equal(pthread_self(), main_thread); +#endif + if (same) { /* This is the main thread. Quitting it means exiting the program. */ si_quit(0); @@ -259,7 +347,7 @@ mp_exit_process(void) cl_object mp_all_processes(void) { - /* Isn't it a race condition? */ + /* Isn't it a race condition? */ @(return cl_copy_list(cl_core.processes)) } @@ -310,8 +398,15 @@ mp_process_run_function(cl_narg narg, cl_object name, cl_object function, ...) pthread_mutexattr_t attr; cl_object output; @ - pthread_mutexattr_init(&attr); output = ecl_alloc_object(t_lock); +#ifdef ECL_WINDOWS_THREADS + output->lock.name = name; + output->lock.mutex = CreateMutex(NULL, FALSE, NULL); + output->lock.holder = Cnil; + output->lock.counter = 0; + output->lock.recursive = (recursive != Cnil); +#else + pthread_mutexattr_init(&attr); output->lock.name = name; output->lock.holder = Cnil; output->lock.counter = 0; @@ -324,6 +419,7 @@ mp_process_run_function(cl_narg narg, cl_object name, cl_object function, ...) } pthread_mutex_init(&output->lock.mutex, &attr); pthread_mutexattr_destroy(&attr); +#endif si_set_finalizer(output, Ct); @(return output) @) @@ -365,7 +461,12 @@ mp_giveup_lock(cl_object lock) if (--lock->lock.counter == 0) { lock->lock.holder = Cnil; } +#ifdef ECL_WINDOWS_THREADS + if (ReleaseMutex(lock->lock.mutex) == 0) + FEwin32_error("Unable to release Win32 Mutex", 0); +#else pthread_mutex_unlock(&lock->lock.mutex); +#endif @(return Ct) } @@ -375,10 +476,29 @@ mp_giveup_lock(cl_object lock) @ if (type_of(lock) != t_lock) FEwrong_type_argument(@'mp::lock', lock); + /* In Windows, all locks are recursive. We simulate the other case. */ /* We will complain always if recursive=0 and try to lock recursively. */ if (!lock->lock.recursive && (lock->lock.holder == cl_env.own_process)) { FEerror("A recursive attempt was made to hold lock ~S", 1, lock); } +#ifdef ECL_WINDOWS_THREADS + switch (WaitForSingleObject(lock->lock.mutex, (wait==Ct?INFINITE:0))) { + case WAIT_OBJECT_0: + lock->lock.holder = cl_env.own_process; + lock->lock.counter++; + output = Ct; + break; + case WAIT_TIMEOUT: + output = Cnil; + break; + case WAIT_ABANDONED: + ecl_internal_error(""); + break; + case WAIT_FAILED: + FEwin32_error("Unable to lock Win32 Mutex", 0); + break; + } +#else if (wait == Ct) { rc = pthread_mutex_lock(&lock->lock.mutex); } else { @@ -391,6 +511,7 @@ mp_giveup_lock(cl_object lock) } else { output = Cnil; } +#endif @(return output) @) @@ -401,6 +522,10 @@ mp_giveup_lock(cl_object lock) cl_object mp_make_condition_variable(void) { +#ifdef ECL_WINDOWS_THREADS + FEerror("Condition variables are not supported under Windows.", 0); + @(return Cnil) +#else pthread_condattr_t attr; cl_object output; @@ -410,11 +535,15 @@ mp_make_condition_variable(void) pthread_condattr_destroy(&attr); si_set_finalizer(output, Ct); @(return output) +#endif } cl_object mp_condition_variable_wait(cl_object cv, cl_object lock) { +#ifdef ECL_WINDOWS_THREADS + FEerror("Condition variables are not supported under Windows.", 0); +#else if (type_of(cv) != t_condition_variable) FEwrong_type_argument(@'mp::condition-variable', cv); if (type_of(lock) != t_lock) @@ -422,12 +551,16 @@ mp_condition_variable_wait(cl_object cv, cl_object lock) if (pthread_cond_wait(&cv->condition_variable.cv, &lock->lock.mutex) == 0) lock->lock.holder = cl_env.own_process; +#endif @(return Ct) } cl_object mp_condition_variable_timedwait(cl_object cv, cl_object lock, cl_object seconds) { +#ifdef ECL_WINDOWS_THREADS + FEerror("Condition variables are not supported under Windows.", 0); +#else int rc; double r; struct timespec ts; @@ -443,7 +576,6 @@ mp_condition_variable_timedwait(cl_object cv, cl_object lock, cl_object seconds) make_constant_base_string("Not a non-negative number ~S"), @':format-arguments', cl_list(1, seconds), @':expected-type', @'real', @':datum', seconds); - gettimeofday(&tp, NULL); /* Convert from timeval to timespec */ ts.tv_sec = tp.tv_sec; @@ -464,23 +596,32 @@ mp_condition_variable_timedwait(cl_object cv, cl_object lock, cl_object seconds) } else { @(return Cnil) } +#endif } cl_object mp_condition_variable_signal(cl_object cv) { +#ifdef ECL_WINDOWS_THREADS + FEerror("Condition variables are not supported under Windows.", 0); +#else if (type_of(cv) != t_condition_variable) FEwrong_type_argument(@'mp::condition-variable', cv); pthread_cond_signal(&cv->condition_variable.cv); +#endif @(return Ct) } cl_object mp_condition_variable_broadcast(cl_object cv) { +#ifdef ECL_WINDOWS_THREADS + FEerror("Condition variables are not supported under Windows.", 0); +#else if (type_of(cv) != t_condition_variable) FEwrong_type_argument(@'mp::condition-variable', cv); pthread_cond_broadcast(&cv->condition_variable.cv); +#endif @(return Ct) } @@ -495,10 +636,14 @@ init_threads(cl_env_ptr env) pthread_mutexattr_t attr; cl_core.processes = OBJNULL; +#ifdef ECL_WINDOWS_THREADS + cl_core.global_lock = CreateMutex(NULL, FALSE, NULL); +#else pthread_mutexattr_init(&attr); pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_ERRORCHECK_NP); pthread_mutex_init(&cl_core.global_lock, &attr); pthread_mutexattr_destroy(&attr); +#endif process = ecl_alloc_object(t_process); process->process.active = 1; @@ -511,12 +656,21 @@ init_threads(cl_env_ptr env) #ifdef WITH___THREAD cl_env_p = env; #else +# ifdef ECL_WINDOWS_THREADS + cl_env_key = TlsAlloc(); + TlsSetValue(cl_env_key, env); +# else pthread_key_create(&cl_env_key, NULL); pthread_setspecific(cl_env_key, env); +# endif #endif env->own_process = process; cl_core.processes = ecl_list1(process); +#ifdef ECL_WINDOWS_THREADS + main_thread = GetCurrentThreadId(); +#else main_thread = pthread_self(); +#endif } diff --git a/src/c/threads_win32.d b/src/c/threads_win32.d deleted file mode 100644 index 77337ce55..000000000 --- a/src/c/threads_win32.d +++ /dev/null @@ -1,488 +0,0 @@ -/* -*- mode: c; c-basic-offset: 8 -*- */ -/* - threads.d -- Posix threads with support from GCC. -*/ -/* - Copyright (c) 2003, Juan Jose Garcia Ripoll. - - ECL is free software; you can redistribute it and/or - modify it under the terms of the GNU Library General Public - License as published by the Free Software Foundation; either - version 2 of the License, or (at your option) any later version. - - See file '../Copyright' for full details. -*/ -/* - * IMPORTANT!!!! IF YOU EDIT THIS FILE, CHANGE ALSO threads.d - */ - -#include -#include -#include -#ifdef HAVE_SCHED_YIELD -# include -#endif - -/* - * We have to put this explicit definition here because Boehm GC - * is designed to produce a DLL and we rather want a static - * reference - */ -#include -#include -extern HANDLE WINAPI GC_CreateThread( - LPSECURITY_ATTRIBUTES lpThreadAttributes, - DWORD dwStackSize, LPTHREAD_START_ROUTINE lpStartAddress, - LPVOID lpParameter, DWORD dwCreationFlags, LPDWORD lpThreadId ); -#ifndef WITH___THREAD -DWORD cl_env_key; -#endif - -static DWORD main_thread; - -extern void ecl_init_env(struct cl_env_struct *env); - -#ifndef WITH___THREAD -struct cl_env_struct * -ecl_process_env(void) -{ - return TlsGetValue(cl_env_key); -} -#endif - -cl_object -mp_current_process(void) -{ - return cl_env.own_process; -} - -/*---------------------------------------------------------------------- - * THREAD OBJECT - */ - -static void -assert_type_process(cl_object o) -{ - if (type_of(o) != t_process) - FEwrong_type_argument(@'mp::process', o); -} - -static void -thread_cleanup(void *env) -{ - /* This routine performs some cleanup before a thread is completely - * killed. For instance, it has to remove the associated process - * object from the list, an it has to dealloc some memory. - * - * NOTE: thread_cleanup() does not provide enough "protection". In - * order to ensure that all UNWIND-PROTECT forms are properly - * executed, never use pthread_cancel() to kill a process, but - * rather use the lisp functions mp_interrupt_process() and - * mp_process_kill(). - */ - THREAD_OP_LOCK(); - cl_core.processes = ecl_remove_eq(cl_env.own_process, - cl_core.processes); - THREAD_OP_UNLOCK(); -} - -static DWORD WINAPI -thread_entry_point(cl_object process) -{ - /* 1) Setup the environment for the execution of the thread */ -#ifdef WITH___THREAD - cl_env_p = process->process.env -#else - TlsSetValue(cl_env_key, (void *)process->process.env); -#endif - ecl_init_env(process->process.env); - init_big_registers(); - - /* 2) Execute the code. The CATCH_ALL point is the destination - * provides us with an elegant way to exit the thread: we just - * do an unwind up to frs_top. - */ - process->process.active = 1; - CL_CATCH_ALL_BEGIN { - bds_bind(@'mp::*current-process*', process); - cl_apply(2, process->process.function, process->process.args); - bds_unwind1(); - } CL_CATCH_ALL_END; - process->process.active = 0; - - /* 3) If everything went right, we should be exiting the thread - * through this point. - */ - thread_cleanup(&cl_env); - return 1; -} - -static cl_object -alloc_process(cl_object name) -{ - cl_object process = ecl_alloc_object(t_process); - process->process.active = 0; - process->process.name = name; - process->process.function = Cnil; - process->process.args = Cnil; - process->process.interrupt = Cnil; - process->process.env = ecl_alloc(sizeof(*process->process.env)); - process->process.env->own_process = process; - return process; -} - -static void -initialize_process_bindings(cl_object process, cl_object initial_bindings) -{ - cl_object hash; - /* FIXME! Here we should either use INITIAL-BINDINGS or copy lexical - * bindings */ - if (initial_bindings != OBJNULL) { - hash = cl__make_hash_table(@'eq', MAKE_FIXNUM(1024), - ecl_make_singlefloat(1.5), - ecl_make_singlefloat(0.7), - Cnil); /* no need for locking */ - } else { - hash = si_copy_hash_table(cl_env.bindings_hash); - } - process->process.env->bindings_hash = hash; -} - -void -ecl_import_current_thread(cl_object name, cl_object bindings) -{ - cl_object process = alloc_process(name); -#ifdef WITH___THREAD - cl_env_p = process->process.env; -#else - TlsSetValue(cl_env_key, (void *)process->process.env); -#endif - initialize_process_bindings(process, bindings); - ecl_init_env(&cl_env); - init_big_registers(); -} - -void -ecl_release_current_thread(void) -{ - thread_cleanup(&cl_env); -} - -@(defun mp::make-process (&key name ((:initial-bindings initial_bindings) Ct)) - cl_object process; -@ - process = alloc_process(name); - initialize_process_bindings(process, initial_bindings); - @(return process) -@) - -cl_object -mp_process_preset(cl_narg narg, cl_object process, cl_object function, ...) -{ - cl_va_list args; - cl_va_start(args, function, narg, 2); - if (narg < 2) - FEwrong_num_arguments(@'mp::process-preset'); - assert_type_process(process); - process->process.function = function; - process->process.args = cl_grab_rest_args(args); - @(return process) -} - -static void -process_interrupt_handler(void) -{ - funcall(1, ecl_process_env()->own_process->process.interrupt); -} - -cl_object -mp_interrupt_process(cl_object process, cl_object function) -{ - CONTEXT context; - HANDLE thread = process->process.thread; - - if (mp_process_active_p(process) == Cnil) - FEerror("Cannot interrupt the inactive process ~A", 1, process); - if (SuspendThread(thread) == (DWORD)-1) - FEwin32_error("Cannot suspend process ~A", 1, process); - context.ContextFlags = CONTEXT_CONTROL | CONTEXT_INTEGER; - if (!GetThreadContext(thread, &context)) - FEwin32_error("Cannot get context for process ~A", 1, process); - context.Eip = process_interrupt_handler; - if (!SetThreadContext(thread, &context)) - FEwin32_error("Cannot set context for process ~A", 1, process); - process->process.interrupt = function; - if (ResumeThread(thread) == (DWORD)-1) - FEwin32_error("Cannot resume process ~A", 1, process); - @(return Ct) -} - -cl_object -mp_process_kill(cl_object process) -{ - return mp_interrupt_process(process, @'mp::exit-process'); -} - -cl_object -mp_process_yield(void) -{ -#ifdef HAVE_SCHED_YIELD - sched_yield(); -#else - Sleep(0); /* Use sleep(0) to yield to a >= priority thread */ -#endif - @(return) -} - -cl_object -mp_process_enable(cl_object process) -{ - HANDLE code; - DWORD threadId; - - if (mp_process_active_p(process) != Cnil) - FEerror("Cannot enable the running process ~A.", 1, process); - THREAD_OP_LOCK(); - code = (HANDLE)CreateThread(NULL, 0, thread_entry_point, process, 0, &threadId); - if (code) { - /* If everything went ok, add the thread to the list. */ - cl_core.processes = CONS(process, cl_core.processes); - } - process->process.thread = code; - THREAD_OP_UNLOCK(); - @(return (code==NULL ? Cnil : process)) -} - -cl_object -mp_exit_process(void) -{ - if (GetCurrentThreadId() == main_thread) { - /* This is the main thread. Quitting it means exiting the - program. */ - si_quit(0); - } else { - /* We simply undo the whole of the frame stack. This brings up - back to the thread entry point, going through all possible - UNWIND-PROTECT. - */ - ecl_unwind(cl_env.frs_org); - } -} - -cl_object -mp_all_processes(void) -{ - @(return cl_copy_list(cl_core.processes)) -} - -cl_object -mp_process_name(cl_object process) -{ - assert_type_process(process); - @(return process->process.name) -} - -cl_object -mp_process_active_p(cl_object process) -{ - assert_type_process(process); - @(return (process->process.active? Ct : Cnil)) -} - -cl_object -mp_process_whostate(cl_object process) -{ - assert_type_process(process); - @(return (cl_core.null_string)) -} - -cl_object -mp_process_run_function(cl_narg narg, cl_object name, cl_object function, ...) -{ - cl_object process; - cl_va_list args; - cl_va_start(args, function, narg, 2); - if (narg < 2) - FEwrong_num_arguments(@'mp::process-run-function'); - if (CONSP(name)) { - process = cl_apply(2, @'mp::make-process', name); - } else { - process = mp_make_process(2, @':name', name); - } - cl_apply(4, @'mp::process-preset', process, function, - cl_grab_rest_args(args)); - return mp_process_enable(process); -} - -/*---------------------------------------------------------------------- - * LOCKS or MUTEX - */ - -@(defun mp::make-lock (&key name ((:recursive recursive) Ct)) - cl_object output; -@ - output = ecl_alloc_object(t_lock); - output->lock.name = name; - output->lock.mutex = CreateMutex(NULL, FALSE, NULL); - output->lock.holder = Cnil; - output->lock.counter = 0; - output->lock.recursive = (recursive != Cnil); - si_set_finalizer(output, Ct); - @(return output) -@) - -cl_object -mp_recursive_lock_p(cl_object lock) -{ - if (type_of(lock) != t_lock) - FEwrong_type_argument(@'mp::lock', lock); - @(return (lock->lock.recursive? Ct : Cnil)) -} - -cl_object -mp_lock_name(cl_object lock) -{ - if (type_of(lock) != t_lock) - FEwrong_type_argument(@'mp::lock', lock); - @(return lock->lock.name) -} - -cl_object -mp_lock_holder(cl_object lock) -{ - if (type_of(lock) != t_lock) - FEwrong_type_argument(@'mp::lock', lock); - @(return lock->lock.holder) -} - -cl_object -mp_giveup_lock(cl_object lock) -{ - if (type_of(lock) != t_lock) - FEwrong_type_argument(@'mp::lock', lock); - if (lock->lock.holder != cl_env.own_process) { - FEerror("Attempt to give up a lock ~S that is not owned by ~S.", 2, - lock, cl_env.own_process); - } - if (--lock->lock.counter == 0) { - lock->lock.holder = Cnil; - } - if (ReleaseMutex(lock->lock.mutex) == 0) - FEwin32_error("Unable to release Win32 Mutex", 0); - @(return Ct) -} - -@(defun mp::get-lock (lock &optional (wait Ct)) - cl_object output; -@ - if (type_of(lock) != t_lock) - FEwrong_type_argument(@'mp::lock', lock); - /* In Windows, all locks are recursive. We simulate the other case. */ - if (!lock->lock.recursive && (lock->lock.holder == cl_env.own_process)) { - FEerror("A recursive attempt was made to hold lock ~S", 1, lock); - } - switch (WaitForSingleObject(lock->lock.mutex, (wait==Ct?INFINITE:0))) { - case WAIT_OBJECT_0: - lock->lock.holder = cl_env.own_process; - lock->lock.counter++; - output = Ct; - break; - case WAIT_TIMEOUT: - output = Cnil; - break; - case WAIT_ABANDONED: - ecl_internal_error(""); - break; - case WAIT_FAILED: - FEwin32_error("Unable to lock Win32 Mutex", 0); - break; - } - @(return output) -@) - -/*---------------------------------------------------------------------- - * CONDITION VARIABLES - */ - -cl_object -mp_make_condition_variable(void) -{ - FEerror("Condition variables are not supported under Windows.", 0); - @(return Cnil) -} - -cl_object -mp_condition_variable_wait(cl_object cv, cl_object lock) -{ - if (type_of(cv) != t_condition_variable) - FEwrong_type_argument(@'mp::condition-variable', cv); - if (type_of(lock) != t_lock) - FEwrong_type_argument(@'mp::lock', lock); - FEerror("Condition variables are not supported under Windows.", 0); - @(return Ct) -} - -cl_object -mp_condition_variable_timedwait(cl_object cv, cl_object lock, cl_object seconds) -{ - if (type_of(cv) != t_condition_variable) - FEwrong_type_argument(@'mp::condition-variable', cv); - if (type_of(lock) != t_lock) - FEwrong_type_argument(@'mp::lock', lock); - FEerror("Condition variables are not supported under Windows.", 0); - @(return Cnil) -} - -cl_object -mp_condition_variable_signal(cl_object cv) -{ - if (type_of(cv) != t_condition_variable) - FEwrong_type_argument(@'mp::condition-variable', cv); - FEerror("Condition variables are not supported under Windows.", 0); - @(return Ct) -} - -cl_object -mp_condition_variable_broadcast(cl_object cv) -{ - if (type_of(cv) != t_condition_variable) - FEwrong_type_argument(@'mp::condition-variable', cv); - FEerror("Condition variables are not supported under Windows.", 0); - @(return Ct) -} - -/*---------------------------------------------------------------------- - * INITIALIZATION - */ - -void -init_threads() -{ - cl_object process; - struct cl_env_struct *env; - - GC_INIT(); - - cl_core.processes = OBJNULL; - cl_core.global_lock = CreateMutex(NULL, FALSE, NULL); - - process = ecl_alloc_object(t_process); - process->process.active = 1; - process->process.name = @'si::top-level'; - process->process.function = Cnil; - process->process.args = Cnil; - process->process.thread = GetCurrentThread(); - process->process.env = env = (struct cl_env_struct*)ecl_alloc(sizeof(*env)); - -#ifdef WITH___THREAD - cl_env_p = env -#else - cl_env_key = TlsAlloc(); - TlsSetValue(cl_env_key, env); -#endif - env->own_process = process; - - cl_core.processes = CONS(process, Cnil); - - main_thread = GetCurrentThreadId(); -} diff --git a/src/c/unixfsys.d b/src/c/unixfsys.d index a1d6efd33..c03d772a1 100644 --- a/src/c/unixfsys.d +++ b/src/c/unixfsys.d @@ -50,6 +50,38 @@ #endif #include +static int +safe_chdir(const char *path) +{ + int output; + ecl_disable_interrupts(); + output = chdir(path); + ecl_enable_interrupts(); + return output; +} + +static int +safe_stat(const char *path, struct stat *sb) +{ + int output; + ecl_disable_interrupts(); + output = stat(path, sb); + ecl_enable_interrupts(); + return output; +} + +#ifdef HAVE_LSTAT +static int +safe_lstat(const char *path, struct stat *sb) +{ + int output; + ecl_disable_interrupts(); + output = lstat(path, sb); + ecl_enable_interrupts(); + return output; +} +#endif + #if defined(_MSC_VER) || defined(mingw32) static void change_drive(cl_object pathname) @@ -57,7 +89,7 @@ change_drive(cl_object pathname) if (pathname->pathname.device != Cnil) { char device[3] = {'\0', ':', '\0'}; device[0] = pathname->pathname.device->base_string.self[0]; - if (chdir(device) < 0) { + if (safe_chdir(device) < 0) { FElibc_error("Can't change the current drive to ~S", 1, pathname->pathname.device); } @@ -91,16 +123,18 @@ current_dir(void) { cl_index size = 128; do { - output = cl_alloc_adjustable_base_string(size); - ok = getcwd(output->base_string.self, size); - size += 256; + output = cl_alloc_adjustable_base_string(size); + ecl_disable_interrupts(); + ok = getcwd(output->base_string.self, size); + ecl_enable_interrupts(); + size += 256; } while(ok == NULL); size = strlen(output->base_string.self); if ((size + 1 /* / */ + 1 /* 0 */) >= output->base_string.dim) { - /* Too large to host the trailing '/' */ - cl_object other = cl_alloc_adjustable_base_string(size+2); - strcpy(other->base_string.self, output->base_string.self); - output = other; + /* Too large to host the trailing '/' */ + cl_object other = cl_alloc_adjustable_base_string(size+2); + strcpy(other->base_string.self, output->base_string.self); + output = other; } #ifdef _MSC_VER for (c=output->base_string.self; *c; c++) @@ -121,32 +155,38 @@ current_dir(void) { static cl_object file_kind(char *filename, bool follow_links) { + cl_object output; #if defined(_MSC_VER) || defined(mingw32) - DWORD dw = GetFileAttributes( filename ); + DWORD dw; + ecl_disable_interrupts(); + dw = GetFileAttributes( filename ); if (dw == -1) - return Cnil; + output = Cnil; else if ( dw & FILE_ATTRIBUTE_DIRECTORY ) - return @':directory'; + output = @':directory'; else - return @':file'; + output = @':file'; + ecl_enable_interrupts(); #else struct stat buf; -#ifdef HAVE_LSTAT - if ((follow_links? stat : lstat)(filename, &buf) < 0) -#else - if (stat(filename, &buf) < 0) -#endif - return Cnil; -#ifdef HAVE_LSTAT - if (S_ISLNK(buf.st_mode)) - return @':link'; -#endif - if (S_ISDIR(buf.st_mode)) - return @':directory'; - if (S_ISREG(buf.st_mode)) - return @':file'; - return @':special'; +# ifdef HAVE_LSTAT + if ((follow_links? safe_stat : safe_lstat)(filename, &buf) < 0) +# else + if (safe_stat(filename, &buf) < 0) +# endif + output = Cnil; +# ifdef HAVE_LSTAT + else if (S_ISLNK(buf.st_mode)) + output = @':link'; +# endif + else if (S_ISDIR(buf.st_mode)) + output = @':directory'; + else if (S_ISREG(buf.st_mode)) + output = @':file'; + else + output = @':special'; #endif + return output; } cl_object @@ -164,7 +204,10 @@ si_readlink(cl_object filename) { cl_object output, kind; do { output = cl_alloc_adjustable_base_string(size); - written = readlink(filename->base_string.self, output->base_string.self, size); + ecl_disable_interrupts(); + written = readlink(filename->base_string.self, + output->base_string.self, size); + ecl_enable_interrupts(); size += 256; } while(written == size); output->base_string.self[written] = '\0'; @@ -227,17 +270,17 @@ cl_truename(cl_object orig_pathname) { cl_object part = CAR(dir); if (type_of(part) == t_base_string) { - if (chdir(part->base_string.self) < 0) { + if (safe_chdir(part->base_string.self) < 0) { ERROR: FElibc_error("Can't change the current directory to ~S", 1, pathname); } } else if (part == @':absolute') { - if (chdir("/") < 0) + if (safe_chdir("/") < 0) goto ERROR; } else if (part == @':relative') { /* Nothing to do */ } else if (part == @':up') { - if (chdir("..") < 0) + if (safe_chdir("..") < 0) goto ERROR; } else { FEerror("~S is not allowed in TRUENAME", 1, part); @@ -253,7 +296,7 @@ ERROR: FElibc_error("Can't change the current directory to ~S", #endif pathname = ecl_merge_pathnames(si_getcwd(0), pathname, @':newest'); } CL_UNWIND_PROTECT_EXIT { - chdir(previous->base_string.self); + safe_chdir(previous->base_string.self); } CL_UNWIND_PROTECT_END; @(return pathname) @@ -268,14 +311,20 @@ ecl_backup_fopen(const char *filename, const char *option) } strcat(strcpy(backupfilename, filename), ".BAK"); + ecl_disable_interrupts(); #ifdef _MSC_VER /* MSVC rename doesn't remove an existing file */ - if (access(backupfilename, F_OK) == 0 && unlink(backupfilename)) + if (access(backupfilename, F_OK) == 0 && unlink(backupfilename)) { + ecl_enable_interrupts(); FElibc_error("Cannot remove the file ~S", 1, make_simple_base_string(backupfilename)); + } #endif - if (rename(filename, backupfilename)) + if (rename(filename, backupfilename)) { + ecl_enable_interrupts(); FElibc_error("Cannot rename the file ~S to ~S.", 2, make_constant_base_string(filename), make_simple_base_string(backupfilename)); + } + ecl_enable_interrupts(); cl_dealloc(backupfilename); return fopen(filename, option); } @@ -284,8 +333,9 @@ cl_object ecl_file_len(void *fp) { struct stat filestatus; - + ecl_disable_interrupts(); fstat(fileno((FILE*)fp), &filestatus); + ecl_enable_interrupts(); return ecl_make_integer(filestatus.st_size); } @@ -305,6 +355,7 @@ ecl_file_len(void *fp) newn = ecl_merge_pathnames(newn, oldn, @':newest'); new_filename = si_coerce_to_filename(newn); + ecl_disable_interrupts(); while (if_exists == @':error' || if_exists == Cnil) { #if defined(_MSC_VER) || defined(mingw32) error = SetErrorMode(0); @@ -331,14 +382,17 @@ ecl_file_len(void *fp) #endif /* if the file already exists */ if (if_exists != Cnil) { + ecl_enable_interrupts(); if_exists = CEerror(@':supersede', "When trying to rename ~S, ~S already exists", 2, oldn, new_filename); + ecl_disable_interrupts(); if (if_exists == Ct) if_exists= @':error'; } if (if_exists == Cnil) { - @(return Cnil) + ecl_enable_interrupts(); + @(return Cnil Cnil Cnil) } } @@ -384,22 +438,30 @@ ecl_file_len(void *fp) #endif } else { /* invalid key */ + ecl_enable_interrupts(); FEerror("~S is an illegal IF-EXISTS option for RENAME-FILE.", 1, if_exists); } FAILURE_CLOBBER: + ecl_enable_interrupts(); FElibc_error("Cannot rename the file ~S to ~S.", 2, oldn, newn); -SUCCESS:new_truename = cl_truename(newn); +SUCCESS: + ecl_enable_interrupts(); + new_truename = cl_truename(newn); @(return newn old_truename new_truename) @) cl_object cl_delete_file(cl_object file) { - cl_object filename; + cl_object filename = si_coerce_to_filename(file); + int ok; - filename = si_coerce_to_filename(file); - if (unlink(filename->base_string.self) < 0) + ecl_disable_interrupts(); + ok = unlink(filename->base_string.self); + ecl_enable_interrupts(); + + if (ok < 0) FElibc_error("Cannot delete the file ~S.", 1, file); @(return Ct) } @@ -414,11 +476,9 @@ cl_probe_file(cl_object file) cl_object cl_file_write_date(cl_object file) { - cl_object filename, time; + cl_object time, filename = si_coerce_to_filename(file); struct stat filestatus; - - filename = si_coerce_to_filename(file); - if (stat(filename->base_string.self, &filestatus) < 0) + if (safe_stat(filename->base_string.self, &filestatus) < 0) time = Cnil; else time = UTC_time_to_universal_time(filestatus.st_mtime); @@ -428,54 +488,22 @@ cl_file_write_date(cl_object file) cl_object cl_file_author(cl_object file) { - cl_object filename = si_coerce_to_filename(file); + cl_object output, filename = si_coerce_to_filename(file); + struct stat filestatus; + if (safe_stat(filename->base_string.self, &filestatus) < 0) + FElibc_error("Cannot get the file status of ~S.", 1, file); #ifdef HAVE_PWD_H - struct stat filestatus; - struct passwd *pwent; - - if (stat(filename->base_string.self, &filestatus) < 0) - FElibc_error("Cannot get the file status of ~S.", 1, file); - pwent = getpwuid(filestatus.st_uid); - @(return make_base_string_copy(pwent->pw_name)) + { + struct passwd *pwent; + ecl_disable_interrupts(); + pwent = getpwuid(filestatus.st_uid); + ecl_enable_interrupts(); + output = make_base_string_copy(pwent->pw_name); + } #else - struct stat filestatus; - if (stat(filename->base_string.self, &filestatus) < 0) - FElibc_error("Cannot get the file status of ~S.", 1, file); - @(return make_constant_base_string("UNKNOWN")) + output = make_constant_base_string("UNKNOWN"); #endif -} - -const char * -ecl_expand_pathname(const char *name) -{ - const char *path, *p; - static char pathname[255], *pn; - - if (IS_DIR_SEPARATOR(name[0])) return(name); - if ((path = getenv("PATH")) == NULL) ecl_internal_error("No PATH in environment"); - p = path; - pn = pathname; - do { - if ((*p == '\0') || (*p == PATH_SEPARATOR)) { - if (pn != pathname) *pn++ = DIR_SEPARATOR; /* on SYSV . is empty */ -LAST: strcpy(pn, name); -#ifdef _MSC_VER - if (GetFileAttributes(pathname) & FILE_ATTRIBUTE_DIRECTORY) - return ( pathname ); -#else - if (access(pathname, X_OK) == 0) - return (pathname); -#endif - pn = pathname; - if (p[0] == PATH_SEPARATOR && p[1] == '\0') { /* last entry is empty */ - p++; - goto LAST; - } - } - else - *pn++ = *p; - } while (*p++ != '\0'); - return(name); /* should never occur */ + @(return output) } cl_object @@ -596,14 +624,16 @@ list_current_directory(const char *mask, bool only_dir) { cl_object out = Cnil; char *text; - #if defined(HAVE_DIRENT_H) DIR *dir; struct dirent *entry; + ecl_disable_interrupts(); dir = opendir("./"); - if (dir == NULL) - return Cnil; + if (dir == NULL) { + out = Cnil; + goto OUTPUT; + } while ((entry = readdir(dir))) { text = entry->d_name; @@ -613,30 +643,32 @@ list_current_directory(const char *mask, bool only_dir) HANDLE hFind = NULL; BOOL found = FALSE; + ecl_disable_interrupts(); for (;;) { - if (hFind == NULL) - { + if (hFind == NULL) { hFind = FindFirstFile(".\\*", &fd); - if (hFind == INVALID_HANDLE_VALUE) - return Cnil; + if (hFind == INVALID_HANDLE_VALUE) { + out = Cnil; + goto OUTPUT; + } found = TRUE; - } - else + } else { found = FindNextFile(hFind, &fd); - + } if (!found) break; text = fd.cFileName; - # else /* sys/dir.h as in SYSV */ FILE *fp; char iobuffer[BUFSIZ]; DIRECTORY dir; + ecl_disable_interrupts(); fp = fopen("./", OPEN_R); - if (fp == NULL) - return Cnil; - + if (fp == NULL) { + out = Cnil; + goto OUTPUT; + } setbuf(fp, iobuffer); for (;;) { if (fread(&dir, sizeof(DIRECTORY), 1, fp) <= 0) @@ -665,6 +697,8 @@ list_current_directory(const char *mask, bool only_dir) fclose(fp); # endif /* !_MSC_VER */ #endif /* !HAVE_DIRENT_H */ + ecl_enable_interrupts(); +OUTPUT: return cl_nreverse(out); } @@ -757,21 +791,21 @@ dir_recursive(cl_object pathname, cl_object directory) loop_for_in(next_dir) { char *text = CAR(next_dir)->base_string.self; /* We are unable to move into this directory! */ - if (chdir(text) < 0) + if (safe_chdir(text) < 0) continue; item = dir_recursive(pathname, CDR(directory)); output = ecl_nconc(item, output); - chdir(prev_dir->base_string.self); + safe_chdir(prev_dir->base_string.self); } end_loop_for_in; } else if (item == @':absolute') { /* * 2.2) If CAR(DIRECTORY) is :ABSOLUTE, we have to scan the * root directory. */ - if (chdir("/") < 0) + if (safe_chdir("/") < 0) return Cnil; output = dir_recursive(pathname, CDR(directory)); - chdir(prev_dir->base_string.self); + safe_chdir(prev_dir->base_string.self); } else if (item == @':relative') { /* * 2.3) If CAR(DIRECTORY) is :RELATIVE, we have to scan the @@ -783,10 +817,10 @@ dir_recursive(cl_object pathname, cl_object directory) * 2.4) If CAR(DIRECTORY) is :UP, we have to scan the directory * which contains this one. */ - if (chdir("..") < 0) + if (safe_chdir("..") < 0) return Cnil; output = dir_recursive(pathname, CDR(directory)); - chdir(prev_dir->base_string.self); + safe_chdir(prev_dir->base_string.self); } else if (item == @':wild-inferiors') { /* * 2.5) If CAR(DIRECTORY) is :WILD-INFERIORS, we have to do @@ -796,11 +830,11 @@ dir_recursive(cl_object pathname, cl_object directory) next_dir = list_current_directory("*", TRUE); loop_for_in(next_dir) { char *text = CAR(next_dir)->base_string.self; - if (chdir(text) < 0) + if (safe_chdir(text) < 0) continue; item = dir_recursive(pathname, directory); output = ecl_nconc(item, output); - chdir(prev_dir->base_string.self); + safe_chdir(prev_dir->base_string.self); } end_loop_for_in; output = ecl_nconc(output, dir_recursive(pathname, CDR(directory))); } @@ -818,7 +852,7 @@ dir_recursive(cl_object pathname, cl_object directory) output = dir_recursive(mask, mask->pathname.directory); } CL_UNWIND_PROTECT_EXIT { if (prev_dir != Cnil) - chdir(prev_dir->base_string.self); + safe_chdir(prev_dir->base_string.self); } CL_UNWIND_PROTECT_END; @(return output) @) @@ -838,10 +872,16 @@ si_get_library_pathname(void) { cl_object s = cl_alloc_adjustable_base_string(cl_core.path_max); char *buffer = (char*)s->base_string.self; - HMODULE hnd = GetModuleHandle( "ecl.dll" ); + HMODULE hnd; cl_index len, ep; - if ((len = GetModuleFileName(hnd, buffer, cl_core.path_max-1)) == 0) - FEerror("GetModuleFileName failed (last error = ~S)", 1, MAKE_FIXNUM(GetLastError())); + ecl_disable_interrupts(); + hnd = GetModuleHandle("ecl.dll"); + len = GetModuleFileName(hnd, buffer, cl_core.path_max-1); + ecl_enable_interrupts(); + if (len == 0) { + FEerror("GetModuleFileName failed (last error = ~S)", + 1, MAKE_FIXNUM(GetLastError())); + } s->base_string.fillp = len; return ecl_parse_namestring(s, 0, len, &ep, Cnil); } @@ -857,7 +897,7 @@ si_get_library_pathname(void) directory->pathname.type != Cnil) FEerror("~A is not a directory pathname.", 1, directory); namestring = cl_namestring(directory); - if (chdir(namestring->base_string.self) <0) + if (safe_chdir(namestring->base_string.self) <0) FElibc_error("Can't change the current directory to ~A", 1, namestring); if (change_d_p_d != Cnil) @@ -868,18 +908,22 @@ si_get_library_pathname(void) cl_object si_mkdir(cl_object directory, cl_object mode) { - cl_object filename; - cl_index modeint; + cl_object filename = si_coerce_to_filename(directory); + cl_index modeint = ecl_fixnum_in_range(@'si::mkdir',"mode",mode,0,0777); + int ok; - filename = si_coerce_to_filename(directory); - modeint = ecl_fixnum_in_range(@'si::mkdir',"mode",mode,0,0777); if (filename->base_string.fillp) filename->base_string.self[--filename->base_string.fillp] = 0; + + ecl_disable_interrupts(); #ifdef mingw32 - if (mkdir(filename->base_string.self) < 0) + ok = mkdir(filename->base_string.self); #else - if (mkdir(filename->base_string.self, modeint) < 0) + ok = mkdir(filename->base_string.self, modeint); #endif + ecl_enable_interrupts(); + + if (ok < 0) FElibc_error("Could not create directory ~S", 1, filename); @(return filename) } @@ -892,67 +936,74 @@ si_mkstemp(cl_object template) int fd; #if defined(mingw32) || defined(_MSC_VER) - cl_object phys, dir, file; char strTempDir[MAX_PATH]; char strTempFileName[MAX_PATH]; - char * s; - + char *s; + int ok; + phys = cl_translate_logical_pathname(1, template); - dir = cl_make_pathname(8, @':type', Cnil, @':name', Cnil, @':version', Cnil, @':defaults', phys); - dir = cl_namestring(dir); file = cl_file_namestring(phys); l = dir->base_string.fillp; - memcpy(strTempDir, dir->base_string.self, l); strTempDir[l] = 0; for (s = strTempDir; *s; s++) if (*s == '/') *s = '\\'; - if (!GetTempFileName(strTempDir, file->base_string.self, 0, strTempFileName)) - { - @(return Cnil) + ecl_disable_interrupts(); + ok = GetTempFileName(strTempDir, file->base_string.self, 0, strTempFileName); + ecl_enable_interrupts(); + if (!ok) { + output = Cnil; + } else { + l = strlen(strTempFileName); + output = cl_alloc_simple_base_string(l); + memcpy(output->base_string.self, strTempFileName, l); } - - l = strlen(strTempFileName); - output = cl_alloc_simple_base_string(l); - memcpy(output->base_string.self, strTempFileName, l); - #else - template = si_coerce_to_filename(template); l = template->base_string.fillp; output = cl_alloc_simple_base_string(l + 6); memcpy(output->base_string.self, template->base_string.self, l); memcpy(output->base_string.self + l, "XXXXXX", 6); -#ifdef HAVE_MKSTEMP + + ecl_disable_interrupts(); +# ifdef HAVE_MKSTEMP fd = mkstemp(output->base_string.self); -#else +# else fd = mktemp(output->base_string.self); fd = open(fd, O_CREAT|O_TRUNC, 0666); -#endif - if (fd < 0) - @(return Cnil) - close(fd); +# endif + ecl_enable_interrupts(); + if (fd < 0) { + output = Cnil; + } else { + close(fd); + } #endif - - @(return cl_truename(output)) + @(return (Null(output)? output : cl_truename(output))) } cl_object si_rmdir(cl_object directory) { + int code; directory = si_coerce_to_filename(directory); - if ( rmdir(directory->base_string.self) != 0 ) + + ecl_disable_interrupts(); + code = rmdir(directory->base_string.self); + ecl_enable_interrupts(); + + if (code != 0) FElibc_error("Can't remove directory ~A.", 1, directory); @(return Cnil) } diff --git a/src/h/external.h b/src/h/external.h index eb2210943..8a5781e2f 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -1541,7 +1541,6 @@ extern ECL_API cl_object cl_user_homedir_pathname _ARGS((cl_narg narg, ...)); extern ECL_API cl_object si_mkstemp(cl_object templ); extern ECL_API cl_object si_rmdir(cl_object directory); -extern ECL_API const char *ecl_expand_pathname(const char *name); extern ECL_API cl_object ecl_cstring_to_pathname(char *s); extern ECL_API void *ecl_backup_fopen(const char *filename, const char *option); extern ECL_API cl_object ecl_file_len(void *fp); diff --git a/src/h/internal.h b/src/h/internal.h index 588b16553..b30af2c82 100644 --- a/src/h/internal.h +++ b/src/h/internal.h @@ -25,8 +25,8 @@ extern "C" { extern void init_all_symbols(void); extern void init_alloc(void); extern void init_backq(void); -extern void init_big(void); -extern void init_big_registers(void); +extern void init_big(cl_env_ptr); +extern void init_big_registers(cl_env_ptr); #ifdef CLOS extern void init_clos(void); #endif From 55cea1530c3c41d2ae425d8503e6a3a2e6b54bbe Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sat, 11 Oct 2008 19:18:29 +0200 Subject: [PATCH 11/60] If signals arrive before we have created an environment, we abort. --- src/c/main.d | 20 ++++++++++---------- src/c/unixint.d | 14 ++++++++++++-- 2 files changed, 22 insertions(+), 12 deletions(-) diff --git a/src/c/main.d b/src/c/main.d index ec56b1e21..5e0a42f9e 100644 --- a/src/c/main.d +++ b/src/c/main.d @@ -43,9 +43,9 @@ extern int GC_dont_gc; /******************************* EXPORTS ******************************/ #if !defined(ECL_THREADS) -cl_env_ptr cl_env_p; +cl_env_ptr cl_env_p = NULL; #elif defined(WITH___THREAD) -__thread cl_env_ptr cl_env_p; +__thread cl_env_ptr cl_env_p = NULL; #endif struct cl_core_struct cl_core; const char *ecl_self; @@ -244,9 +244,7 @@ cl_boot(int argc, char **argv) cl_object aux; cl_object features; int i; -#if defined(ECL_THREADS) && !defined(WITH__THREAD) - static cl_env_ptr cl_env_p; -#endif + cl_env_ptr env; i = ecl_get_option(ECL_OPT_BOOTED); if (i) { @@ -269,9 +267,11 @@ cl_boot(int argc, char **argv) init_unixint(0); init_alloc(); GC_disable(); + pause(); +#if !defined(ECL_THREADS) || defined(WITH__THREAD) cl_env_p = _ecl_alloc_env(); -#ifdef ECL_THREADS - init_threads(cl_env_p); +#else + init_threads(env); #endif /* @@ -426,7 +426,7 @@ cl_boot(int argc, char **argv) * This cannot come later, because some routines need the * frame stack immediately (for instance SI:PATHNAME-TRANSLATIONS). */ - ecl_init_env(&cl_env); + ecl_init_env(env); #if !defined(GBC_BOEHM) /* We need this because a lot of stuff is to be created */ init_GC(); @@ -434,11 +434,11 @@ cl_boot(int argc, char **argv) GC_enable(); #ifdef ECL_THREADS - cl_env.bindings_hash = cl__make_hash_table(@'eq', MAKE_FIXNUM(1024), + env->bindings_hash = cl__make_hash_table(@'eq', MAKE_FIXNUM(1024), ecl_make_singlefloat(1.5f), ecl_make_singlefloat(0.75f), Cnil); /* no locking */ - ECL_SET(@'mp::*current-process*', cl_env.own_process); + ECL_SET(@'mp::*current-process*', env->own_process); #endif /* diff --git a/src/c/unixint.d b/src/c/unixint.d index 98faed9d4..d53d8f815 100644 --- a/src/c/unixint.d +++ b/src/c/unixint.d @@ -313,7 +313,12 @@ static void define_handler(non_evil_signal_handler, int sig, siginfo_t *siginfo, void *data) { int old_errno = errno; - cl_env_ptr the_env = &cl_env; + cl_env_ptr the_env; + if (!ecl_get_option(ECL_OPT_BOOTED)) { + ecl_internal_error("Got signal before environment was installed" + " on our thread."); + } + the_env = ecl_process_env(); reinstall_signal(sig, non_evil_signal_handler); printf("Non evil handler\n"); /* @@ -370,7 +375,12 @@ define_handler(non_evil_signal_handler, int sig, siginfo_t *siginfo, void *data) static void define_handler(sigsegv_handler, int sig, siginfo_t *info, void *aux) { - cl_env_ptr the_env = &cl_env; + cl_env_ptr the_env = ecl_process_env(); + if (!ecl_get_option(ECL_OPT_BOOTED)) { + ecl_internal_error("Got signal before environment was installed" + " on our thread."); + } + the_env = ecl_process_env(); #ifdef HAVE_SIGPROCMASK # ifdef ECL_DOWN_STACK if ((cl_fixnum*)info->si_addr > the_env->cs_barrier && From 18f24ea0714a913d422e28e4fb9a787a045005c0 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sat, 11 Oct 2008 19:38:04 +0200 Subject: [PATCH 12/60] Fixed typo and removed debug statement. --- src/c/main.d | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/c/main.d b/src/c/main.d index 5e0a42f9e..b91f3ef6b 100644 --- a/src/c/main.d +++ b/src/c/main.d @@ -267,9 +267,9 @@ cl_boot(int argc, char **argv) init_unixint(0); init_alloc(); GC_disable(); - pause(); + env = _ecl_alloc_env(); #if !defined(ECL_THREADS) || defined(WITH__THREAD) - cl_env_p = _ecl_alloc_env(); + cl_env_p = env; #else init_threads(env); #endif From d74230e75856c83490cc652108209339fa77f049 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sat, 11 Oct 2008 19:38:23 +0200 Subject: [PATCH 13/60] Replaced multiple references to cl_env by a single call to ecl_process_env --- src/c/stacks.d | 216 ++++++++++++++++++++++++++----------------------- 1 file changed, 115 insertions(+), 101 deletions(-) diff --git a/src/c/stacks.d b/src/c/stacks.d index 33aecabde..302256634 100644 --- a/src/c/stacks.d +++ b/src/c/stacks.d @@ -26,40 +26,41 @@ /************************ C STACK ***************************/ static void -cs_set_size(cl_index new_size) +cs_set_size(cl_env_ptr env, cl_index new_size) { volatile int foo = 0; cl_index safety_area = ecl_get_option(ECL_OPT_C_STACK_SAFETY_AREA); new_size += 2*safety_area; #ifdef ECL_DOWN_STACK - if (&foo > cl_env.cs_org - new_size + 16) { - cl_env.cs_limit = cl_env.cs_org - new_size + 2*safety_area; - if (cl_env.cs_limit < cl_env.cs_barrier) - cl_env.cs_barrier = cl_env.cs_limit; + if (&foo > env->cs_org - new_size + 16) { + env->cs_limit = env->cs_org - new_size + 2*safety_area; + if (env->cs_limit < env->cs_barrier) + env->cs_barrier = env->cs_limit; } #else - if (&foo < cl_env.cs_org + new_size - 16) { - cl_env.cs_limit = cl_env.cs_org + new_size - 2*safety_area; - if (cl_env.cs_limit > cl_env.cs_barrier) - cl_env.cs_barrier = cl_env.cs_limit; + if (&foo < env->cs_org + new_size - 16) { + env->cs_limit = env->cs_org + new_size - 2*safety_area; + if (env->cs_limit > env->cs_barrier) + env->cs_barrier = env->cs_limit; } #endif else - ecl_internal_error("can't reset cl_env.cs_limit."); - cl_env.cs_size = new_size; + ecl_internal_error("can't reset env->cs_limit."); + env->cs_size = new_size; } void ecl_cs_overflow(void) { + cl_env_ptr env = ecl_process_env(); cl_index safety_area = ecl_get_option(ECL_OPT_C_STACK_SAFETY_AREA); - cl_index size = cl_env.cs_size; + cl_index size = env->cs_size; #ifdef ECL_DOWN_STACK - if (cl_env.cs_limit > cl_env.cs_org - size) - cl_env.cs_limit -= safety_area; + if (env->cs_limit > env->cs_org - size) + env->cs_limit -= safety_area; #else - if (cl_env.cs_limit < cl_env.cs_org + size) - cl_env.cs_limit += safety_area; + if (env->cs_limit < env->cs_org + size) + env->cs_limit += safety_area; #endif else ecl_internal_error("Cannot grow stack size."); @@ -67,7 +68,7 @@ ecl_cs_overflow(void) @'ext::stack-overflow', @':size', MAKE_FIXNUM(size), @':type', @'ext::c-stack'); size += size / 2; - cs_set_size(size); + cs_set_size(env, size); } @@ -77,17 +78,18 @@ ecl_cs_overflow(void) void bds_bind(cl_object s, cl_object value) { + cl_env_ptr env = ecl_process_env(); struct ecl_hashtable_entry *h = ecl_search_hash(s, cl_env.bindings_hash); - struct bds_bd *slot = ++cl_env.bds_top; - if (slot >= cl_env.bds_limit) { + struct bds_bd *slot = ++env->bds_top; + if (slot >= env->bds_limit) { bds_overflow(); - slot = cl_env.bds_top; + slot = env->bds_top; } if (h->key == OBJNULL) { /* The previous binding was at most global */ slot->symbol = s; slot->value = OBJNULL; - ecl_sethash(s, cl_env.bindings_hash, value); + ecl_sethash(s, env->bindings_hash, value); } else { /* We have to save a dynamic binding */ slot->symbol = h->key; @@ -100,17 +102,18 @@ bds_bind(cl_object s, cl_object value) void bds_push(cl_object s) { - struct ecl_hashtable_entry *h = ecl_search_hash(s, cl_env.bindings_hash); - struct bds_bd *slot = ++cl_env.bds_top; - if (slot >= cl_env.bds_limit) { + cl_env_ptr env = ecl_process_env(); + struct ecl_hashtable_entry *h = ecl_search_hash(s, env->bindings_hash); + struct bds_bd *slot = ++env->bds_top; + if (slot >= env->bds_limit) { bds_overflow(); - slot = cl_env.bds_top; + slot = env->bds_top; } if (h->key == OBJNULL) { /* The previous binding was at most global */ slot->symbol = s; slot->value = OBJNULL; - ecl_sethash(s, cl_env.bindings_hash, s->symbol.value); + ecl_sethash(s, env->bindings_hash, s->symbol.value); } else { /* We have to save a dynamic binding */ slot->symbol = h->key; @@ -122,14 +125,15 @@ bds_push(cl_object s) void bds_unwind1(void) { - struct bds_bd *slot = cl_env.bds_top--; + cl_env_ptr env = ecl_process_env(); + struct bds_bd *slot = env->bds_top--; cl_object s = slot->symbol; - struct ecl_hashtable_entry *h = ecl_search_hash(s, cl_env.bindings_hash); + struct ecl_hashtable_entry *h = ecl_search_hash(s, env->bindings_hash); if (slot->value == OBJNULL) { /* We have deleted all dynamic bindings */ h->key = OBJNULL; h->value = OBJNULL; - cl_env.bindings_hash->hash.entries--; + env->bindings_hash->hash.entries--; } else { /* We restore the previous dynamic binding */ h->value = slot->value; @@ -142,7 +146,8 @@ ecl_symbol_slot(cl_object s) if (Null(s)) s = Cnil_symbol; if (s->symbol.dynamic) { - struct ecl_hashtable_entry *h = ecl_search_hash(s, cl_env.bindings_hash); + cl_env_ptr env = ecl_process_env(); + struct ecl_hashtable_entry *h = ecl_search_hash(s, env->bindings_hash); if (h->key != OBJNULL) return &h->value; } @@ -153,7 +158,8 @@ cl_object ecl_set_symbol(cl_object s, cl_object value) { if (s->symbol.dynamic) { - struct ecl_hashtable_entry *h = ecl_search_hash(s, cl_env.bindings_hash); + cl_env_ptr env = ecl_process_env(); + struct ecl_hashtable_entry *h = ecl_search_hash(s, env->bindings_hash); if (h->key != OBJNULL) { return (h->value = value); } @@ -169,10 +175,10 @@ bds_unwind_n(int n) } static void -bds_set_size(cl_index size) +bds_set_size(cl_env_ptr env, cl_index size) { - bds_ptr old_org = cl_env.bds_org; - cl_index limit = cl_env.bds_top - old_org; + bds_ptr old_org = env->bds_org; + cl_index limit = env->bds_top - old_org; if (size <= limit) { FEerror("Cannot shrink the binding stack below ~D.", 1, ecl_make_unsigned_integer(limit)); @@ -181,13 +187,13 @@ bds_set_size(cl_index size) bds_ptr org; org = ecl_alloc_atomic(size * sizeof(*org)); - ecl_disable_interrupts(); + ecl_disable_interrupts_env(env); memcpy(org, old_org, (limit + 1) * sizeof(*org)); - cl_env.bds_top = org + limit; - cl_env.bds_org = org; - cl_env.bds_limit = org + (size - 2*margin); - cl_env.bds_size = size; - ecl_enable_interrupts(); + env->bds_top = org + limit; + env->bds_org = org; + env->bds_limit = org + (size - 2*margin); + env->bds_size = size; + ecl_enable_interrupts_env(env); cl_dealloc(old_org); } @@ -196,42 +202,43 @@ bds_set_size(cl_index size) void bds_overflow(void) { + cl_env_ptr env = ecl_process_env(); cl_index margin = ecl_get_option(ECL_OPT_BIND_STACK_SAFETY_AREA); - cl_index size = cl_env.bds_size; - bds_ptr org = cl_env.bds_org; + cl_index size = env->bds_size; + bds_ptr org = env->bds_org; bds_ptr last = org + size; - if (cl_env.bds_limit >= last) { + if (env->bds_limit >= last) { ecl_internal_error("Bind stack overflow, cannot grow larger."); } - cl_env.bds_limit += margin; + env->bds_limit += margin; cl_cerror(6, make_constant_base_string("Extend stack size"), @'ext::stack-overflow', @':size', MAKE_FIXNUM(size), @':type', @'ext::binding-stack'); - bds_set_size(size + (size / 2)); + bds_set_size(env, size + (size / 2)); } void bds_unwind(cl_index new_bds_top_index) { - bds_ptr new_bds_top = new_bds_top_index + cl_env.bds_org; - bds_ptr bds = cl_env.bds_top; + cl_env_ptr env = ecl_process_env(); + bds_ptr new_bds_top = new_bds_top_index + env->bds_org; + bds_ptr bds = env->bds_top; for (; bds > new_bds_top; bds--) #ifdef ECL_THREADS bds_unwind1(); #else bds->symbol->symbol.value = bds->value; #endif - cl_env.bds_top = new_bds_top; + env->bds_top = new_bds_top; } static bds_ptr get_bds_ptr(cl_object x) { - bds_ptr p; - if (FIXNUMP(x)) { - p = cl_env.bds_org + fix(x); - if (cl_env.bds_org <= p && p <= cl_env.bds_top) + cl_env_ptr env = ecl_process_env(); + bds_ptr p = env->bds_org + fix(x); + if (env->bds_org <= p && p <= env->bds_top) return(p); } FEerror("~S is an illegal bds index.", 1, x); @@ -240,7 +247,8 @@ get_bds_ptr(cl_object x) cl_object si_bds_top() { - @(return MAKE_FIXNUM(cl_env.bds_top - cl_env.bds_org)) + cl_env_ptr env = ecl_process_env(); + @(return MAKE_FIXNUM(env->bds_top - env->bds_org)) } cl_object @@ -288,7 +296,8 @@ ihs_function_name(cl_object x) static ihs_ptr get_ihs_ptr(cl_index n) { - ihs_ptr p = cl_env.ihs_top; + cl_env_ptr env = ecl_process_env(); + ihs_ptr p = env->ihs_top; if (n > p->index) FEerror("~D is an illegal IHS index.", 1, MAKE_FIXNUM(n)); while (n < p->index) @@ -299,13 +308,15 @@ get_ihs_ptr(cl_index n) cl_object ihs_top_function_name(void) { - return ihs_function_name(cl_env.ihs_top->function); + cl_env_ptr env = ecl_process_env(); + return ihs_function_name(env->ihs_top->function); } cl_object si_ihs_top(cl_object name) { - @(return MAKE_FIXNUM(cl_env.ihs_top->index)) + cl_env_ptr env = ecl_process_env(); + @(return MAKE_FIXNUM(env->ihs_top->index)) } cl_object @@ -339,14 +350,14 @@ static int frame_id = 0; cl_object new_frame_id(void) { - return(MAKE_FIXNUM(frame_id++)); + return MAKE_FIXNUM(frame_id++); } static void -frs_set_size(cl_index size) +frs_set_size(cl_env_ptr env, cl_index size) { - ecl_frame_ptr old_org = cl_env.frs_top; - cl_index limit = cl_env.frs_top - old_org; + ecl_frame_ptr old_org = env->frs_top; + cl_index limit = env->frs_top - old_org; if (size <= limit) { FEerror("Cannot shrink frame stack below ~D.", 1, ecl_make_unsigned_integer(limit)); @@ -356,13 +367,13 @@ frs_set_size(cl_index size) size += 2*margin; org = ecl_alloc_atomic(size * sizeof(*org)); - ecl_disable_interrupts(); + ecl_disable_interrupts_env(env); memcpy(org, old_org, (limit + 1) * sizeof(*org)); - cl_env.frs_top = org + limit; - cl_env.frs_org = org; - cl_env.frs_limit = org + (size - 2*margin); - cl_env.frs_size = size; - ecl_enable_interrupts(); + env->frs_top = org + limit; + env->frs_org = org; + env->frs_limit = org + (size - 2*margin); + env->frs_size = size; + ecl_enable_interrupts_env(env); cl_dealloc(old_org); } @@ -371,31 +382,33 @@ frs_set_size(cl_index size) static void frs_overflow(void) /* used as condition in list.d */ { + cl_env_ptr env = ecl_process_env(); cl_index margin = ecl_get_option(ECL_OPT_FRAME_STACK_SAFETY_AREA); - cl_index size = cl_env.frs_size; - ecl_frame_ptr org = cl_env.frs_org; + cl_index size = env->frs_size; + ecl_frame_ptr org = env->frs_org; ecl_frame_ptr last = org + size; - if (cl_env.frs_limit >= last) { + if (env->frs_limit >= last) { ecl_internal_error("Frame stack overflow, cannot grow larger."); } - cl_env.frs_limit += margin; + env->frs_limit += margin; cl_cerror(6, make_constant_base_string("Extend stack size"), @'ext::stack-overflow', @':size', MAKE_FIXNUM(size), @':type', @'ext::frame-stack'); - frs_set_size(size + size / 2); + frs_set_size(env, size + size / 2); } ecl_frame_ptr _frs_push(register cl_object val) { - ecl_frame_ptr output = ++cl_env.frs_top; - if (output >= cl_env.frs_limit) { + cl_env_ptr env = ecl_process_env(); + ecl_frame_ptr output = ++env->frs_top; + if (output >= env->frs_limit) { frs_overflow(); - output = cl_env.frs_top; + output = env->frs_top; } - output->frs_bds_top_index = cl_env.bds_top - cl_env.bds_org; + output->frs_bds_top_index = env->bds_top - env->bds_org; output->frs_val = val; - output->frs_ihs = cl_env.ihs_top; + output->frs_ihs = env->ihs_top; output->frs_sp = cl_stack_index(); return output; } @@ -403,22 +416,23 @@ _frs_push(register cl_object val) void ecl_unwind(ecl_frame_ptr fr) { - cl_env.nlj_fr = fr; - while (cl_env.frs_top != fr && cl_env.frs_top->frs_val != ECL_PROTECT_TAG) - --cl_env.frs_top; - cl_env.ihs_top = cl_env.frs_top->frs_ihs; - bds_unwind(cl_env.frs_top->frs_bds_top_index); - cl_stack_set_index(cl_env.frs_top->frs_sp); - ecl_longjmp(cl_env.frs_top->frs_jmpbuf, 1); + cl_env_ptr env = ecl_process_env(); + env->nlj_fr = fr; + while (env->frs_top != fr && env->frs_top->frs_val != ECL_PROTECT_TAG) + --env->frs_top; + env->ihs_top = env->frs_top->frs_ihs; + bds_unwind(env->frs_top->frs_bds_top_index); + cl_stack_set_index(env->frs_top->frs_sp); + ecl_longjmp(env->frs_top->frs_jmpbuf, 1); /* never reached */ } ecl_frame_ptr frs_sch (cl_object frame_id) { + cl_env_ptr env = ecl_process_env(); ecl_frame_ptr top; - - for (top = cl_env.frs_top; top >= cl_env.frs_org; top--) + for (top = env->frs_top; top >= env->frs_org; top--) if (top->frs_val == frame_id) return(top); return(NULL); @@ -427,12 +441,11 @@ frs_sch (cl_object frame_id) static ecl_frame_ptr get_frame_ptr(cl_object x) { - ecl_frame_ptr p; - if (FIXNUMP(x)) { - p = cl_env.frs_org + fix(x); - if (cl_env.frs_org <= p && p <= cl_env.frs_top) - return(p); + cl_env_ptr env = ecl_process_env(); + ecl_frame_ptr p = env->frs_org + fix(x); + if (env->frs_org <= p && p <= env->frs_top) + return p; } FEerror("~S is an illegal frs index.", 1, x); } @@ -440,7 +453,8 @@ get_frame_ptr(cl_object x) cl_object si_frs_top() { - @(return MAKE_FIXNUM(cl_env.frs_top - cl_env.frs_org)) + cl_env_ptr env = ecl_process_env(); + @(return MAKE_FIXNUM(env->frs_top - env->frs_org)) } cl_object @@ -464,14 +478,13 @@ si_frs_ihs(cl_object arg) cl_object si_sch_frs_base(cl_object fr, cl_object ihs) { + cl_env_ptr env = ecl_process_env(); ecl_frame_ptr x; - cl_index y; - - y = fixnnint(ihs); + cl_index y = fixnnint(ihs); for (x = get_frame_ptr(fr); - x <= cl_env.frs_top && x->frs_ihs->index < y; + x <= env->frs_top && x->frs_ihs->index < y; x++); - @(return ((x > cl_env.frs_top) ? Cnil : MAKE_FIXNUM(x - cl_env.frs_org))) + @(return ((x > env->frs_top) ? Cnil : MAKE_FIXNUM(x - env->frs_org))) } /********************* INITIALIZATION ***********************/ @@ -479,13 +492,14 @@ si_sch_frs_base(cl_object fr, cl_object ihs) cl_object si_set_stack_size(cl_object type, cl_object size) { + cl_env_ptr env = ecl_process_env(); cl_index the_size = fixnnint(size); if (type == @'ext::frame-stack') { - frs_set_size(the_size); + frs_set_size(env, the_size); } else if (type == @'ext::binding-stack') { - bds_set_size(the_size); + bds_set_size(env, the_size); } else if (type == @'ext::c-stack') { - cs_set_size(the_size); + cs_set_size(env, the_size); } else { cl_stack_set_size(the_size); } @@ -493,7 +507,7 @@ si_set_stack_size(cl_object type, cl_object size) } void -init_stacks(struct cl_env_struct *env, int *new_cs_org) +init_stacks(cl_env_ptr env, int *new_cs_org) { static struct ihs_frame ihs_org = { NULL, NULL, NULL, 0}; cl_index size, margin; @@ -536,7 +550,7 @@ init_stacks(struct cl_env_struct *env, int *new_cs_org) } } #endif - cs_set_size(ecl_get_option(ECL_OPT_C_STACK_SIZE)); + cs_set_size(env, ecl_get_option(ECL_OPT_C_STACK_SIZE)); #if defined(HAVE_SIGPROCMASK) && defined(SA_SIGINFO) if (ecl_get_option(ECL_OPT_SIGALTSTACK_SIZE)) { From 774c4dd185f12f461f1141656b8b4748ffde4666 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sat, 11 Oct 2008 19:49:56 +0200 Subject: [PATCH 14/60] Factor the code for setting the thread environment. --- src/c/threads.d | 52 ++++++++++++++++++++++--------------------------- 1 file changed, 23 insertions(+), 29 deletions(-) diff --git a/src/c/threads.d b/src/c/threads.d index 55fde20f0..5da7f6477 100644 --- a/src/c/threads.d +++ b/src/c/threads.d @@ -57,8 +57,8 @@ static pthread_t main_thread; extern void ecl_init_env(struct cl_env_struct *env); -#ifndef WITH___THREAD -struct cl_env_struct * +#if !defined(WITH___THREAD) +cl_env_ptr ecl_process_env(void) { #ifdef ECL_WINDOWS_THREADS @@ -73,6 +73,21 @@ ecl_process_env(void) } #endif +static void +ecl_set_process_env(cl_env_ptr env) +{ +#ifdef WITH__THREAD + cl_env_p = env; +#else +# ifdef ECL_WINDOWS_THREADS + TlsSetValue(cl_env_key, env); +# else + if (pthread_setspecific(cl_env_key, env)) + FElibc_error("pthread_setcspecific() failed.", 0); +# endif +#endif +} + cl_object mp_current_process(void) { @@ -118,16 +133,7 @@ thread_entry_point(cl_object process) pthread_cleanup_push(thread_cleanup, (void *)env); ecl_init_env(env); init_big_registers(env); -#ifdef WITH___THREAD - cl_env_p = env; -#else -# ifdef ECL_WINDOWS_THREADS - TlsSetValue(cl_env_key, env); -# else - if (pthread_setspecific(cl_env_key, env)) - FElibc_error("pthread_setcspecific() failed.", 0); -# endif -#endif + ecl_set_process_env(env); /* 2) Execute the code. The CATCH_ALL point is the destination * provides us with an elegant way to exit the thread: we just @@ -192,17 +198,8 @@ ecl_import_current_thread(cl_object name, cl_object bindings) initialize_process_bindings(process, bindings); ecl_init_env(env); init_big_registers(env); + ecl_set_process_env(env); ecl_enable_interrupts_env(env); -#ifdef WITH___THREAD - cl_env_p = env; -#else -# ifdef ECL_WINDOWS_THREADS - TlsSetValue(cl_env_key, env); -# else - if (pthread_setspecific(cl_env_key, env)) - FElibc_error("pthread_setcspecific() failed.", 0); -# endif -#endif } void @@ -653,18 +650,15 @@ init_threads(cl_env_ptr env) process->process.thread = pthread_self(); process->process.env = env; -#ifdef WITH___THREAD - cl_env_p = env; -#else -# ifdef ECL_WINDOWS_THREADS + env->own_process = process; +#if !defined(WITH__THREADS) +# if defined(ECL_WINDOWS_THREADS) cl_env_key = TlsAlloc(); - TlsSetValue(cl_env_key, env); # else pthread_key_create(&cl_env_key, NULL); - pthread_setspecific(cl_env_key, env); # endif #endif - env->own_process = process; + ecl_set_process_env(env); cl_core.processes = ecl_list1(process); From 162b934fc464705ec8d69e32d7c57c38c6dce9fc Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sat, 11 Oct 2008 20:16:08 +0200 Subject: [PATCH 15/60] Reactivate use of thread local storage via __thread flag. --- src/CHANGELOG | 3 +++ src/aclocal.m4 | 1 - src/c/threads.d | 4 ++-- src/configure | 1 - 4 files changed, 5 insertions(+), 4 deletions(-) diff --git a/src/CHANGELOG b/src/CHANGELOG index ed438ba7c..45a16548d 100644 --- a/src/CHANGELOG +++ b/src/CHANGELOG @@ -74,6 +74,9 @@ ECL 8.9.0: names while keeping the old definitions as macros. Look at external.h for the list of already deprecated names. + - ECL builds using thread local storage when configured with --with-__thread and + the feature works on that platform. + * Embedding: - ECL now implements a more transparent interface for setting and querying diff --git a/src/aclocal.m4 b/src/aclocal.m4 index 9b117e5db..d7c9f1373 100644 --- a/src/aclocal.m4 +++ b/src/aclocal.m4 @@ -600,7 +600,6 @@ AC_TRY_COMPILE(,[static __thread void *data;], ac_cv_ecl___thread=yes, ac_cv_ecl___thread=no)) dnl We deactivate this test because it seems to slow down ECL A LOT!!! -ac_cv_ecl___thread=no ]) dnl ---------------------------------------------------------------------- diff --git a/src/c/threads.d b/src/c/threads.d index 5da7f6477..aa9f6149a 100644 --- a/src/c/threads.d +++ b/src/c/threads.d @@ -76,7 +76,7 @@ ecl_process_env(void) static void ecl_set_process_env(cl_env_ptr env) { -#ifdef WITH__THREAD +#ifdef WITH___THREAD cl_env_p = env; #else # ifdef ECL_WINDOWS_THREADS @@ -651,7 +651,7 @@ init_threads(cl_env_ptr env) process->process.env = env; env->own_process = process; -#if !defined(WITH__THREADS) +#if !defined(WITH___THREAD) # if defined(ECL_WINDOWS_THREADS) cl_env_key = TlsAlloc(); # else diff --git a/src/configure b/src/configure index 57ff33c2f..1a15e8990 100755 --- a/src/configure +++ b/src/configure @@ -4545,7 +4545,6 @@ rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { $as_echo "$as_me:$LINENO: result: $ac_cv_ecl___thread" >&5 $as_echo "$ac_cv_ecl___thread" >&6; } -ac_cv_ecl___thread=no From e0100efe51654dc8fc95ea769140591a8f230b79 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sat, 11 Oct 2008 20:19:51 +0200 Subject: [PATCH 16/60] Interrupts have to be explicitely activated at the thread entry point. --- src/c/main.d | 9 +++++++++ src/c/threads.d | 1 + 2 files changed, 10 insertions(+) diff --git a/src/c/main.d b/src/c/main.d index b91f3ef6b..ca1ba5bd6 100644 --- a/src/c/main.d +++ b/src/c/main.d @@ -202,6 +202,11 @@ static const struct { cl_env_ptr _ecl_alloc_env() { + /* + * Allocates the lisp environment for a thread. Depending on which + * mechanism we use for detecting delayed signals, we may allocate + * the environment using mmap or the garbage collector. + */ cl_env_ptr output; #if defined(ECL_USE_MPROTECT) output = mmap(0, sizeof(*output), PROT_READ | PROT_WRITE, @@ -211,6 +216,10 @@ _ecl_alloc_env() #else output = ecl_alloc(sizeof(*output)); #endif + /* + * An uninitialized environment _always_ disables interrupts. They + * are activated later on by the thread entry point or init_unixint(). + */ output->disable_interrupts = 1; return output; } diff --git a/src/c/threads.d b/src/c/threads.d index aa9f6149a..dbcab8d7d 100644 --- a/src/c/threads.d +++ b/src/c/threads.d @@ -134,6 +134,7 @@ thread_entry_point(cl_object process) ecl_init_env(env); init_big_registers(env); ecl_set_process_env(env); + ecl_enable_interrupts(env); /* 2) Execute the code. The CATCH_ALL point is the destination * provides us with an elegant way to exit the thread: we just From 7c5ab4f1fbbdc021bd9a7b6a9ff8cde901c73267 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sat, 11 Oct 2008 22:32:54 +0200 Subject: [PATCH 17/60] Some functions now take a cl_env_ptr argument, becoming better isolated. --- src/c/arch/ffi_x86.d | 3 +- src/c/arch/ffi_x86_64.d | 3 +- src/c/compiler.d | 12 +-- src/c/dpp.c | 2 + src/c/eval.d | 5 +- src/c/interpreter.d | 170 ++++++++++++++++++++-------------------- src/c/main.d | 2 +- src/c/mapfun.d | 3 +- src/c/read.d | 11 +-- src/c/stacks.d | 6 +- src/c/string.d | 4 +- src/c/threads.d | 2 +- src/cmp/cmpcall.lsp | 2 +- src/cmp/cmpcatch.lsp | 8 +- src/cmp/cmpcbk.lsp | 2 +- src/cmp/cmpexit.lsp | 4 +- src/cmp/cmpffi.lsp | 2 +- src/cmp/cmploc.lsp | 14 ++-- src/cmp/cmpmulti.lsp | 10 +-- src/cmp/cmpstack.lsp | 6 +- src/cmp/cmptag.lsp | 2 +- src/cmp/cmptop.lsp | 4 +- src/cmp/cmpvar.lsp | 2 +- src/h/external.h | 22 +++--- src/h/internal.h | 8 +- src/h/object.h | 1 + src/h/stacks.h | 10 ++- 27 files changed, 170 insertions(+), 150 deletions(-) diff --git a/src/c/arch/ffi_x86.d b/src/c/arch/ffi_x86.d index cc8131a3e..a4fe8eb6e 100644 --- a/src/c/arch/ffi_x86.d +++ b/src/c/arch/ffi_x86.d @@ -116,8 +116,9 @@ ecl_dynamic_callback_execute(cl_object cbk_info, char *arg_buffer) cl_index i, size; union ecl_ffi_values output; enum ecl_ffi_tag tag; + cl_env_ptr env = ecl_process_env(); - ECL_BUILD_STACK_FRAME(frame, aux); + ECL_BUILD_STACK_FRAME(env, frame, aux); fun = CAR(cbk_info); rtype = CADR(cbk_info); diff --git a/src/c/arch/ffi_x86_64.d b/src/c/arch/ffi_x86_64.d index 75c679866..b8667e0fe 100644 --- a/src/c/arch/ffi_x86_64.d +++ b/src/c/arch/ffi_x86_64.d @@ -165,8 +165,9 @@ ecl_dynamic_callback_execute(long i1, long i2, long i3, long i4, long i5, long i enum ecl_ffi_tag tag; long i_reg[MAX_INT_REGISTERS]; double f_reg[MAX_FP_REGISTERS]; + cl_env_ptr env = ecl_process_env(); - ECL_BUILD_STACK_FRAME(frame, aux); + ECL_BUILD_STACK_FRAME(env, frame, aux); fun = CAR(cbk_info); rtype = CADR(cbk_info); diff --git a/src/c/compiler.d b/src/c/compiler.d index 614067f2c..7c2a74acd 100644 --- a/src/c/compiler.d +++ b/src/c/compiler.d @@ -59,12 +59,12 @@ /********************* PRIVATE ********************/ -#define asm_begin() cl_stack_index() -#define asm_clear(h) cl_stack_set_index(h) -#define current_pc() cl_stack_index() -#define set_pc(n) cl_stack_set_index(n) -#define asm_op(o) cl_stack_push((cl_object)((cl_fixnum)(o))) -#define asm_ref(n) (cl_fixnum)(cl_env.stack[n]) +#define asm_begin() ecl_stack_index(ecl_process_env()) +#define asm_clear(h) ecl_stack_set_index(ecl_process_env(), h) +#define current_pc() ecl_stack_index(ecl_process_env()) +#define set_pc(n) ecl_stack_set_index(ecl_process_env(), n) +#define asm_op(o) ecl_stack_push(ecl_process_env(), (cl_object)((cl_fixnum)(o))) +#define asm_ref(n) (cl_fixnum)(ecl_process_env()->stack[n]) static void asm_op2(int op, int arg); static cl_object asm_end(cl_index handle); static cl_index asm_jmp(register int op); diff --git a/src/c/dpp.c b/src/c/dpp.c index a7f2731d2..56948c9bb 100644 --- a/src/c/dpp.c +++ b/src/c/dpp.c @@ -636,6 +636,8 @@ put_declaration(void) int i; int simple_varargs; + put_lineno(); + fprintf(out, "\tconst cl_env_ptr the_env = ecl_process_env();\n"); for (i = 0; i < nopt; i++) { put_lineno(); fprintf(out, "\tcl_object %s;\n", optional[i].o_var); diff --git a/src/c/eval.d b/src/c/eval.d index 1b56a084c..ee26020fa 100644 --- a/src/c/eval.d +++ b/src/c/eval.d @@ -28,6 +28,7 @@ _ecl_va_sp(cl_narg narg) static cl_object build_funcall_frame(cl_object f, cl_va_list args) { + cl_env_ptr env = ecl_process_env(); cl_index n = args[0].narg; cl_object *p = args[0].sp; f->frame.stack = 0; @@ -46,6 +47,7 @@ build_funcall_frame(cl_object f, cl_va_list args) f->frame.bottom = p; f->frame.top = p + n; f->frame.t = t_frame; + f->frame.env = env; return f; } @@ -210,7 +212,8 @@ si_unlink_symbol(cl_object s) cl_object out; cl_index i; struct ecl_stack_frame frame_aux; - const cl_object frame = ecl_stack_frame_open((cl_object)&frame_aux, + const cl_object frame = ecl_stack_frame_open(ecl_process_env(), + (cl_object)&frame_aux, narg -= 2); for (i = 0; i < narg; i++) { ecl_stack_frame_elt_set(frame, i, lastarg); diff --git a/src/c/interpreter.d b/src/c/interpreter.d index bcf5668ad..0ec20bd58 100644 --- a/src/c/interpreter.d +++ b/src/c/interpreter.d @@ -23,9 +23,9 @@ /* -------------------- INTERPRETER STACK -------------------- */ void -cl_stack_set_size(cl_index tentative_new_size) +ecl_stack_set_size(cl_env_ptr env, cl_index tentative_new_size) { - cl_index top = cl_env.stack_top - cl_env.stack; + cl_index top = env->stack_top - env->stack; cl_object *new_stack, *old_stack; cl_index safety_area = ecl_get_option(ECL_OPT_LISP_STACK_SAFETY_AREA); cl_index new_size = tentative_new_size + 2*safety_area; @@ -33,16 +33,16 @@ cl_stack_set_size(cl_index tentative_new_size) if (top > new_size) FEerror("Internal error: cannot shrink stack that much.",0); - old_stack = cl_env.stack; + old_stack = env->stack; new_stack = (cl_object *)ecl_alloc_atomic(new_size * sizeof(cl_object)); - ecl_disable_interrupts(); - memcpy(new_stack, old_stack, cl_env.stack_size * sizeof(cl_object)); - cl_env.stack_size = new_size; - cl_env.stack = new_stack; - cl_env.stack_top = cl_env.stack + top; - cl_env.stack_limit = cl_env.stack + (new_size - 2*safety_area); - ecl_enable_interrupts(); + ecl_disable_interrupts_env(env); + memcpy(new_stack, old_stack, env->stack_size * sizeof(cl_object)); + env->stack_size = new_size; + env->stack = new_stack; + env->stack_top = env->stack + top; + env->stack_limit = env->stack + (new_size - 2*safety_area); + ecl_enable_interrupts_env(env); cl_dealloc(old_stack); @@ -50,67 +50,67 @@ cl_stack_set_size(cl_index tentative_new_size) * and friends, which take a sp=0 to have no arguments. */ if (top == 0) - cl_stack_push(MAKE_FIXNUM(0)); + ecl_stack_push(env, MAKE_FIXNUM(0)); } static void -cl_stack_grow(void) +ecl_stack_grow(cl_env_ptr env) { - cl_stack_set_size(cl_env.stack_size + LISP_PAGESIZE); + ecl_stack_set_size(env, env->stack_size + env->stack_size / 2); } void -cl_stack_push(cl_object x) { - if (cl_env.stack_top >= cl_env.stack_limit) - cl_stack_grow(); - *(cl_env.stack_top++) = x; +ecl_stack_push(cl_env_ptr env, cl_object x) { + if (env->stack_top >= env->stack_limit) + ecl_stack_grow(env); + *(env->stack_top++) = x; } cl_object -cl_stack_pop() { - if (cl_env.stack_top == cl_env.stack) +ecl_stack_pop(cl_env_ptr env) { + if (env->stack_top == env->stack) FEerror("Internal error: stack underflow.",0); - return *(--cl_env.stack_top); + return *(--env->stack_top); } cl_index -cl_stack_index() { - return cl_env.stack_top - cl_env.stack; +ecl_stack_index(cl_env_ptr env) { + return env->stack_top - env->stack; } void -cl_stack_set_index(cl_index index) { - cl_object *new_top = cl_env.stack + index; - if (new_top > cl_env.stack_top) +ecl_stack_set_index(cl_env_ptr env, cl_index index) { + cl_object *new_top = env->stack + index; + if (new_top > env->stack_top) FEerror("Internal error: tried to advance stack.",0); - cl_env.stack_top = new_top; + env->stack_top = new_top; } void -cl_stack_pop_n(cl_index index) { - cl_object *new_top = cl_env.stack_top - index; - if (new_top < cl_env.stack) +ecl_stack_pop_n(cl_env_ptr env, cl_index index) { + cl_object *new_top = env->stack_top - index; + if (new_top < env->stack) FEerror("Internal error: stack underflow.",0); - cl_env.stack_top = new_top; + env->stack_top = new_top; } cl_index -cl_stack_push_values(void) { +ecl_stack_push_values(cl_env_ptr env) { cl_index i; - for (i=0; invalues; i++) + ecl_stack_push(env, env->values[i]); return i; } void -cl_stack_pop_values(cl_index n) { - NVALUES = n; +ecl_stack_pop_values(cl_env_ptr env, cl_index n) { + env->nvalues = n; while (n > 0) - VALUES(--n) = cl_stack_pop(); + env->values[--n] = ecl_stack_pop(env); } cl_index -cl_stack_push_list(cl_object list) +ecl_stack_push_list(cl_env_ptr env, cl_object list) { cl_index n; cl_object fast, slow; @@ -118,9 +118,9 @@ cl_stack_push_list(cl_object list) /* INV: A list's length always fits in a fixnum */ fast = slow = list; for (n = 0; CONSP(fast); n++, fast = CDR(fast)) { - *cl_env.stack_top = CAR(fast); - if (++cl_env.stack_top >= cl_env.stack_limit) - cl_stack_grow(); + *env->stack_top = CAR(fast); + if (++env->stack_top >= env->stack_limit) + ecl_stack_grow(env); if (n & 1) { /* Circular list? */ if (slow == fast) break; @@ -133,20 +133,21 @@ cl_stack_push_list(cl_object list) } cl_object -ecl_stack_frame_open(cl_object f, cl_index size) +ecl_stack_frame_open(cl_env_ptr env, cl_object f, cl_index size) { - cl_object *top = cl_env.stack_top; + cl_object *top = env->stack_top; if (size) { - if (cl_env.stack_limit - top < size) { + if (env->stack_limit - top < size) { cl_index delta = (size + (LISP_PAGESIZE-1))/LISP_PAGESIZE; - cl_stack_set_size(cl_env.stack_size + delta * LISP_PAGESIZE); - top = cl_env.stack_top; + ecl_stack_set_size(env, env->stack_size + delta * LISP_PAGESIZE); + top = env->stack_top; } } f->frame.t = t_frame; - f->frame.stack = cl_env.stack; + f->frame.stack = env->stack; f->frame.bottom = top; - cl_env.stack_top = f->frame.top = (top + size); + f->frame.env = env; + env->stack_top = f->frame.top = (top + size); return f; } @@ -154,56 +155,59 @@ void ecl_stack_frame_enlarge(cl_object f, cl_index size) { cl_object *top; + cl_env_ptr env = f->frame.env; if (f->frame.stack == 0) { ecl_internal_error("Inconsistency in interpreter stack frame"); } - top = cl_env.stack_top; - if ((cl_env.stack_limit - top) < size) { + top = env->stack_top; + if ((env->stack_limit - top) < size) { cl_index delta = (size + (LISP_PAGESIZE-1))/LISP_PAGESIZE; - cl_stack_set_size(cl_env.stack_size + delta * LISP_PAGESIZE); - f->frame.bottom = (f->frame.bottom - f->frame.stack) + cl_env.stack; - f->frame.stack = cl_env.stack; - top = cl_env.stack_top; + ecl_stack_set_size(env, env->stack_size + delta * LISP_PAGESIZE); + f->frame.bottom = (f->frame.bottom - f->frame.stack) + env->stack; + f->frame.stack = env->stack; + top = env->stack_top; } else if (top != f->frame.top) { - f->frame.bottom = (f->frame.bottom - f->frame.stack) + cl_env.stack; - f->frame.stack = cl_env.stack; - top = cl_env.stack_top; + f->frame.bottom = (f->frame.bottom - f->frame.stack) + env->stack; + f->frame.stack = env->stack; + top = env->stack_top; } - cl_env.stack_top = f->frame.top = (top + size); + env->stack_top = f->frame.top = (top + size); } void ecl_stack_frame_push(cl_object f, cl_object o) { cl_object *top; + cl_env_ptr env = f->frame.env; if (f->frame.stack == 0) { ecl_internal_error("Inconsistency in interpreter stack frame"); } - top = cl_env.stack_top; - if (top >= cl_env.stack_limit) { - cl_stack_grow(); - f->frame.bottom = (f->frame.bottom - f->frame.stack) + cl_env.stack; - f->frame.stack = cl_env.stack; - top = cl_env.stack_top; + top = env->stack_top; + if (top >= env->stack_limit) { + ecl_stack_grow(env); + f->frame.bottom = (f->frame.bottom - f->frame.stack) + env->stack; + f->frame.stack = env->stack; + top = env->stack_top; } else if (top != f->frame.top) { - f->frame.bottom = (f->frame.bottom - f->frame.stack) + cl_env.stack; - f->frame.stack = cl_env.stack; - top = cl_env.stack_top; + f->frame.bottom = (f->frame.bottom - f->frame.stack) + env->stack; + f->frame.stack = env->stack; + top = env->stack_top; } *(top++) = o; - cl_env.stack_top = f->frame.top = top; + env->stack_top = f->frame.top = top; } void ecl_stack_frame_push_values(cl_object f) { + cl_env_ptr env = f->frame.env; if (f->frame.stack == 0) { ecl_internal_error("Inconsistency in interpreter stack frame"); } - cl_stack_push_values(); - f->frame.bottom = (f->frame.bottom - f->frame.stack) + cl_env.stack; - f->frame.stack = cl_env.stack; - f->frame.top = cl_env.stack_top; + ecl_stack_push_values(env); + f->frame.bottom = (f->frame.bottom - f->frame.stack) + env->stack; + f->frame.stack = env->stack; + f->frame.top = env->stack_top; } cl_object @@ -237,10 +241,10 @@ ecl_stack_frame_elt_set(cl_object f, cl_index ndx, cl_object o) } cl_object -ecl_stack_frame_from_va_list(cl_object frame, cl_va_list args) +ecl_stack_frame_from_va_list(cl_env_ptr env, cl_object frame, cl_va_list args) { cl_index nargs = args[0].narg; - ecl_stack_frame_open(frame, nargs); + ecl_stack_frame_open(env, frame, nargs); while (nargs) { *(frame->frame.top-nargs) = cl_va_arg(args); nargs--; @@ -252,7 +256,7 @@ void ecl_stack_frame_close(cl_object f) { if (f->frame.stack) { - cl_stack_set_index(f->frame.bottom - f->frame.stack); + ecl_stack_set_index(f->frame.env, f->frame.bottom - f->frame.stack); } } @@ -260,7 +264,7 @@ cl_object ecl_stack_frame_copy(cl_object dest, cl_object orig) { cl_index size = orig->frame.top - orig->frame.bottom; - dest = ecl_stack_frame_open(dest, size); + dest = ecl_stack_frame_open(orig->frame.env, dest, size); memcpy(dest->frame.bottom, orig->frame.bottom, size * sizeof(cl_object)); return dest; } @@ -456,7 +460,7 @@ close_around(cl_object fun, cl_object lex) { #define STACK_PUSH(the_env,x) { \ cl_object __aux = (x); \ if (the_env->stack_top == the_env->stack_limit) { \ - cl_stack_grow(); \ + ecl_stack_grow(the_env); \ } \ *(the_env->stack_top++) = __aux; } @@ -465,7 +469,7 @@ close_around(cl_object fun, cl_object lex) { #define STACK_PUSH_N(the_env,n) { \ cl_index __aux = (n); \ while ((the_env->stack_limit - the_env->stack_top) <= __aux) { \ - cl_stack_grow(); \ + ecl_stack_grow(the_env); \ } \ the_env->stack_top += __aux; } @@ -499,8 +503,8 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs { ECL_OFFSET_TABLE typedef struct cl_env_struct *cl_env_ptr; - const cl_env_ptr the_env = &cl_env; - volatile cl_index old_bds_top_index = cl_env.bds_top - cl_env.bds_org; + const cl_env_ptr the_env = ecl_process_env(); + volatile cl_index old_bds_top_index = the_env->bds_top - the_env->bds_org; cl_opcode *vector = (cl_opcode*)bytecodes->bytecodes.code + offset; cl_object *data = bytecodes->bytecodes.data; cl_object reg0, reg1, lex_env = env; @@ -1347,7 +1351,7 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs GET_DATA(form, vector, data); SETUP_ENV(the_env); the_env->values[0] = reg0; - n = cl_stack_push_values(); + n = ecl_stack_push_values(the_env); if (a == Ct) { /* We are stepping in, but must first ask the user * what to do. */ @@ -1364,7 +1368,7 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs /* We are not inside a STEP form. This should * actually never happen. */ } - cl_stack_pop_values(n); + ecl_stack_pop_values(the_env, n); reg0 = the_env->values[0]; THREAD_NEXT; } @@ -1386,7 +1390,7 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs cl_index n; SETUP_ENV(the_env); the_env->values[0] = reg0; - n = cl_stack_push_values(); + n = ecl_stack_push_values(the_env); if (a == Ct) { /* We exit one stepping level */ ECL_SETQ(@'si::*step-level*', @@ -1400,7 +1404,7 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs } else { /* Not stepping, nothing to be done. */ } - cl_stack_pop_values(n); + ecl_stack_pop_values(the_env, n); reg0 = the_env->values[0]; THREAD_NEXT; } diff --git a/src/c/main.d b/src/c/main.d index ca1ba5bd6..c15c8bccf 100644 --- a/src/c/main.d +++ b/src/c/main.d @@ -120,7 +120,7 @@ ecl_init_env(cl_env_ptr env) env->stack_top = NULL; env->stack_limit = NULL; env->stack_size = 0; - cl_stack_set_size(ecl_get_option(ECL_OPT_LISP_STACK_SIZE)); + ecl_stack_set_size(env, ecl_get_option(ECL_OPT_LISP_STACK_SIZE)); #if !defined(ECL_CMU_FORMAT) env->print_pretty = FALSE; diff --git a/src/c/mapfun.d b/src/c/mapfun.d index 86415e2d1..748b5a2ad 100644 --- a/src/c/mapfun.d +++ b/src/c/mapfun.d @@ -22,7 +22,8 @@ struct ecl_stack_frame cdrs_frame_aux, cars_frame_aux; \ cl_object cdrs_frame, cars_frame; \ cl_index nargs; \ - cdrs_frame = ecl_stack_frame_from_va_list((cl_object)&cdrs_frame_aux, list); \ + cdrs_frame = ecl_stack_frame_from_va_list(ecl_process_env(),\ + (cl_object)&cdrs_frame_aux, list); \ cars_frame = ecl_stack_frame_copy((cl_object)&cars_frame_aux, cdrs_frame); \ nargs = ECL_STACK_FRAME_SIZE(cars_frame); \ if (nargs == 0) { \ diff --git a/src/c/read.d b/src/c/read.d index 9d657ccee..ad236b694 100644 --- a/src/c/read.d +++ b/src/c/read.d @@ -925,9 +925,10 @@ sharp_left_parenthesis_reader(cl_object in, cl_object c, cl_object d) static cl_object sharp_asterisk_reader(cl_object in, cl_object c, cl_object d) { + cl_env_ptr env = ecl_process_env(); + cl_index sp = ecl_stack_index(env); cl_object last, elt, x; cl_index dim, dimcount, i; - cl_index sp = cl_stack_index(); cl_object rtbl = ecl_current_readtable(); enum ecl_chattrib a; @@ -950,7 +951,7 @@ sharp_asterisk_reader(cl_object in, cl_object c, cl_object d) FEreader_error("Character ~:C is not allowed after #*", in, 1, CODE_CHAR(x)); } - cl_stack_push(MAKE_FIXNUM(x == '1')); + ecl_stack_push(env, MAKE_FIXNUM(x == '1')); } if (Null(d)) { dim = dimcount; @@ -960,17 +961,17 @@ sharp_asterisk_reader(cl_object in, cl_object c, cl_object d) FEreader_error("Too many elements in #*....", in, 0); if (dim && (dimcount == 0)) FEreader_error("Cannot fill the bit-vector #*.", in, 0); - else last = cl_env.stack_top[-1]; + else last = env->stack_top[-1]; } x = ecl_alloc_simple_vector(dim, aet_bit); for (i = 0; i < dim; i++) { - elt = (i < dimcount) ? cl_env.stack[sp+i] : last; + elt = (i < dimcount) ? env->stack[sp+i] : last; if (elt == MAKE_FIXNUM(0)) x->vector.self.bit[i/CHAR_BIT] &= ~(0200 >> i%CHAR_BIT); else x->vector.self.bit[i/CHAR_BIT] |= 0200 >> i%CHAR_BIT; } - cl_stack_pop_n(dimcount); + ecl_stack_pop_n(env, dimcount); @(return x) } diff --git a/src/c/stacks.d b/src/c/stacks.d index 302256634..3c9008701 100644 --- a/src/c/stacks.d +++ b/src/c/stacks.d @@ -409,7 +409,7 @@ _frs_push(register cl_object val) output->frs_bds_top_index = env->bds_top - env->bds_org; output->frs_val = val; output->frs_ihs = env->ihs_top; - output->frs_sp = cl_stack_index(); + output->frs_sp = ecl_stack_index(env); return output; } @@ -422,7 +422,7 @@ ecl_unwind(ecl_frame_ptr fr) --env->frs_top; env->ihs_top = env->frs_top->frs_ihs; bds_unwind(env->frs_top->frs_bds_top_index); - cl_stack_set_index(env->frs_top->frs_sp); + ecl_stack_set_index(env, env->frs_top->frs_sp); ecl_longjmp(env->frs_top->frs_jmpbuf, 1); /* never reached */ } @@ -501,7 +501,7 @@ si_set_stack_size(cl_object type, cl_object size) } else if (type == @'ext::c-stack') { cs_set_size(env, the_size); } else { - cl_stack_set_size(the_size); + ecl_stack_set_size(env, the_size); } @(return) } diff --git a/src/c/string.d b/src/c/string.d index 76a4b2907..7781f34d8 100644 --- a/src/c/string.d +++ b/src/c/string.d @@ -944,14 +944,14 @@ nstring_case(cl_narg narg, cl_object fun, int (*casefun)(int, bool *), cl_va_lis for (i = 0, l = 0; i < narg; i++) { cl_object s = si_coerce_to_base_string(cl_va_arg(args)); if (s->base_string.fillp) { - cl_stack_push(s); + ecl_stack_push(the_env, s); l += s->base_string.fillp; } } /* Do actual copying by recovering those strings */ output = cl_alloc_simple_base_string(l); while (l) { - cl_object s = cl_stack_pop(); + cl_object s = ecl_stack_pop(the_env); size_t bytes = s->base_string.fillp; l -= bytes; memcpy(output->base_string.self + l, s->base_string.self, bytes); diff --git a/src/c/threads.d b/src/c/threads.d index dbcab8d7d..d154039b5 100644 --- a/src/c/threads.d +++ b/src/c/threads.d @@ -134,7 +134,7 @@ thread_entry_point(cl_object process) ecl_init_env(env); init_big_registers(env); ecl_set_process_env(env); - ecl_enable_interrupts(env); + ecl_enable_interrupts_env(env); /* 2) Execute the code. The CATCH_ALL point is the destination * provides us with an elegant way to exit the thread: we just diff --git a/src/cmp/cmpcall.lsp b/src/cmp/cmpcall.lsp index 88858bdde..01540b318 100644 --- a/src/cmp/cmpcall.lsp +++ b/src/cmp/cmpcall.lsp @@ -299,7 +299,7 @@ (format nil "env~D" n))) (defun wt-stack-pointer (narg) - (wt "cl_env.stack_top-" narg)) + (wt "cl_env_copy->stack_top-" narg)) (defun wt-call (fun args &optional fname) (wt fun "(") diff --git a/src/cmp/cmpcatch.lsp b/src/cmp/cmpcatch.lsp index 0c0842fd2..27e593a3c 100644 --- a/src/cmp/cmpcatch.lsp +++ b/src/cmp/cmpcatch.lsp @@ -61,12 +61,12 @@ (*unwind-exit* `((STACK ,sp) ,@*unwind-exit*))) (wt-nl "{") (wt-nl "volatile bool unwinding = FALSE;") - (wt-nl "cl_index " sp "=cl_stack_index()," nargs ";") + (wt-nl "cl_index " sp "=ecl_stack_index(cl_env_copy)," nargs ";") (wt-nl "ecl_frame_ptr next_fr;") ;; Here we compile the form which is protected. When this form ;; is aborted, it continues at the frs_pop() with unwinding=TRUE. (wt-nl "if (frs_push(ECL_PROTECT_TAG)) {") - (wt-nl " unwinding = TRUE; next_fr=cl_env.nlj_fr;") + (wt-nl " unwinding = TRUE; next_fr=cl_env_copy->nlj_fr;") (wt-nl "} else {") (let ((*unwind-exit* (cons 'FRAME *unwind-exit*)) (*destination* 'VALUES)) @@ -76,10 +76,10 @@ ;; Here we save the values of the form which might have been ;; aborted, and execute some cleanup code. This code may also ;; be aborted by some control structure, but is not protected. - (wt-nl nargs "=cl_stack_push_values();") + (wt-nl nargs "=ecl_stack_push_values(cl_env_copy);") (let ((*destination* 'TRASH)) (c2expr* body)) - (wt-nl "cl_stack_pop_values(" nargs ");") + (wt-nl "ecl_stack_pop_values(cl_env_copy," nargs ");") ;; Finally, if the protected form was aborted, jump to the ;; next catch point... (wt-nl "if (unwinding) ecl_unwind(next_fr);") diff --git a/src/cmp/cmpcbk.lsp b/src/cmp/cmpcbk.lsp index c6245f54b..63e789df4 100644 --- a/src/cmp/cmpcbk.lsp +++ b/src/cmp/cmpcbk.lsp @@ -99,7 +99,7 @@ (when return-p (wt-nl return-type-name " output;")) (wt-nl "cl_object aux;") - (wt-nl "ECL_BUILD_STACK_FRAME(frame, helper)") + (wt-nl "ECL_BUILD_STACK_FRAME(cl_env_copy, frame, helper)") (loop for n from 0 and type in arg-types and ct in arg-type-constants diff --git a/src/cmp/cmpexit.lsp b/src/cmp/cmpexit.lsp index 7e9133c63..9e52e2806 100644 --- a/src/cmp/cmpexit.lsp +++ b/src/cmp/cmpexit.lsp @@ -19,7 +19,7 @@ (when stack-frame (if (stringp stack-frame) (wt-nl "ecl_stack_frame_close(" stack-frame ");") - (wt-nl "cl_stack_set_index(" stack-frame ");"))) + (wt-nl "ecl_stack_set_index(cl_env_copy," stack-frame ");"))) (when bds-lcl (wt-nl "bds_unwind(" bds-lcl ");")) (if (< bds-bind 4) @@ -81,7 +81,7 @@ (cond ((eq loc 'VALUES) ;; from multiple-value-prog1 or values (unwind-bds bds-lcl bds-bind stack-frame ihs-p) - (wt-nl "return VALUES(0);")) + (wt-nl "return cl_env_copy->values[0];")) ((eq loc 'RETURN) ;; from multiple-value-prog1 or values (unwind-bds bds-lcl bds-bind stack-frame ihs-p) diff --git a/src/cmp/cmpffi.lsp b/src/cmp/cmpffi.lsp index 7db92f033..b83a8e7fd 100644 --- a/src/cmp/cmpffi.lsp +++ b/src/cmp/cmpffi.lsp @@ -392,7 +392,7 @@ (loop for v in output-vars for i from 0 do (let ((*destination* `(VALUE ,i))) (set-loc v))) - (wt "NVALUES=" (length output-vars) ";") + (wt "cl_env_copy->nvalues=" (length output-vars) ";") 'VALUES)))))) (defun c2c-inline (arguments &rest rest) diff --git a/src/cmp/cmploc.lsp b/src/cmp/cmploc.lsp index 7c4e9da71..1bb307952 100644 --- a/src/cmp/cmploc.lsp +++ b/src/cmp/cmploc.lsp @@ -74,19 +74,21 @@ (case *destination* (VALUES (cond (is-call - (wt-nl "VALUES(0)=") (wt-coerce-loc :object loc) (wt ";")) + (wt-nl "cl_env_copy->values[0]=") (wt-coerce-loc :object loc) (wt ";")) ((eq loc 'VALUES) (return-from set-loc)) (t - (wt-nl "VALUES(0)=") (wt-coerce-loc :object loc) (wt "; NVALUES=1;")))) + (wt-nl "cl_env_copy->values[0]=") (wt-coerce-loc :object loc) + (wt "; cl_env_copy->nvalues=1;")))) (VALUE0 (wt-nl "value0=") (wt-coerce-loc :object loc) (wt ";")) (RETURN (cond ((or is-call (eq loc 'VALUES)) (wt-nl "value0=") (wt-coerce-loc :object loc) (wt ";")) - ((eq loc 'VALUE0) (wt-nl "NVALUES=1;")) + ((eq loc 'VALUE0) (wt-nl "cl_env_copy->nvalues=1;")) ((eq loc 'RETURN) (return-from set-loc)) (t - (wt-nl "value0=") (wt-coerce-loc :object loc) (wt "; NVALUES=1;")))) + (wt-nl "value0=") (wt-coerce-loc :object loc) + (wt "; cl_env_copy->nvalues=1;")))) (TRASH (cond (is-call (wt-nl "(void)" loc ";")) ((and (consp loc) @@ -114,7 +116,7 @@ ((eq loc 'RETURN) (wt "value0")) ; added for last inline-arg ((eq loc 'VALUES) - (wt "VALUES(0)")) + (wt "cl_env_copy->values[0]")) ((eq loc 'VA-ARG) (wt "va_arg(args,cl_object)")) ((eq loc 'CL-VA-ARG) @@ -166,7 +168,7 @@ (defun wt-character (value &optional vv) (wt (format nil "'\\~O'" value))) -(defun wt-value (i) (wt "VALUES(" i ")")) +(defun wt-value (i) (wt "cl_env_copy->values[" i "]")) (defun wt-keyvars (i) (wt "keyvars[" i "]")) diff --git a/src/cmp/cmpmulti.lsp b/src/cmp/cmpmulti.lsp index f4611d804..dce7c143e 100644 --- a/src/cmp/cmpmulti.lsp +++ b/src/cmp/cmpmulti.lsp @@ -81,10 +81,10 @@ ;; of a function. ((endp forms) (cond ((eq *destination* 'RETURN) - (wt-nl "value0=Cnil; NVALUES=0;") + (wt-nl "value0=Cnil; cl_env_copy->nvalues=0;") (unwind-exit 'RETURN)) ((eq *destination* 'VALUES) - (wt-nl "VALUES(0)=Cnil; NVALUES=0;") + (wt-nl "cl_env_copy->values[0]=Cnil; cl_env_copy->nvalues=0;") (unwind-exit 'VALUES)) (t (unwind-exit 'NIL)))) @@ -105,12 +105,12 @@ (forms (nreverse (coerce-locs (inline-args forms))))) ;; By inlining arguments we make sure that VL has no call to funct. ;; Reverse args to avoid clobbering VALUES(0) - (wt-nl "NVALUES=" nv ";") + (wt-nl "cl_env_copy->nvalues=" nv ";") (do ((vl forms (rest vl)) (i (1- (length forms)) (1- i))) ((null vl)) (declare (fixnum i)) - (wt-nl "VALUES(" i ")=" (first vl) ";")) + (wt-nl "cl_env_copy->values[" i "]=" (first vl) ";")) (unwind-exit 'VALUES) (close-inline-blocks))))) @@ -195,7 +195,7 @@ ;; If there are more variables, we have to check whether there ;; are enough values left in the stack. (when vars - (wt-nl "{int " nr "=NVALUES-" min-values ";") + (wt-nl "{int " nr "=cl_env_copy->nvalues-" min-values ";") ;; ;; Loop for assigning values to variables ;; diff --git a/src/cmp/cmpstack.lsp b/src/cmp/cmpstack.lsp index ebf458515..f78016c06 100644 --- a/src/cmp/cmpstack.lsp +++ b/src/cmp/cmpstack.lsp @@ -39,7 +39,7 @@ (let* ((new-destination (tmp-destination *destination*)) (*temp* *temp*)) (wt-nl "{ struct ecl_stack_frame _ecl_inner_frame_aux;") - (wt-nl *volatile* "cl_object _ecl_inner_frame = ecl_stack_frame_open((cl_object)&_ecl_inner_frame_aux,0);") + (wt-nl *volatile* "cl_object _ecl_inner_frame = ecl_stack_frame_open(cl_env_copy,(cl_object)&_ecl_inner_frame_aux,0);") (let* ((*destination* new-destination) (*unwind-exit* `((STACK ,+ecl-stack-frame-variable+) ,@*unwind-exit*))) (c2expr* body)) @@ -72,12 +72,12 @@ (defun c1stack-pop (args) (c1expr `(c-inline ,args (t) (values &rest t) - "VALUES(0)=ecl_stack_frame_pop_values(#0);" + "cl_env_copy->values[0]=ecl_stack_frame_pop_values(#0);" :one-liner nil :side-effects t))) (defun c1apply-from-stack-frame (args) (c1expr `(c-inline ,args (t t) (values &rest t) - "VALUES(0)=ecl_apply_from_stack_frame(#0,#1);" + "cl_env_copy->values[0]=ecl_apply_from_stack_frame(#0,#1);" :one-liner nil :side-effects t))) (put-sysprop 'with-stack 'C1 #'c1with-stack) diff --git a/src/cmp/cmptag.lsp b/src/cmp/cmptag.lsp index a6029c4b1..404389e94 100644 --- a/src/cmp/cmptag.lsp +++ b/src/cmp/cmptag.lsp @@ -156,7 +156,7 @@ (when (and (tag-p tag) (plusp (tag-ref tag))) (setf (tag-label tag) (next-label)) (setf (tag-unwind-exit tag) label) - (wt-nl "if (VALUES(0)==MAKE_FIXNUM(" (tag-index tag) "))") + (wt-nl "if (cl_env_copy->values[0]==MAKE_FIXNUM(" (tag-index tag) "))") (wt-go (tag-label tag)))) (when (var-ref-ccb tag-loc) (wt-nl "ecl_internal_error(\"GO found an inexistent tag\");")) diff --git a/src/cmp/cmptop.lsp b/src/cmp/cmptop.lsp index 8561b4bda..cd58039c5 100644 --- a/src/cmp/cmptop.lsp +++ b/src/cmp/cmptop.lsp @@ -128,6 +128,7 @@ " VLEX" *reservation-cmacro* " CLSR" *reservation-cmacro* " STCK" *reservation-cmacro*) + (wt-nl "const cl_env_ptr cl_env_copy = ecl_process_env();") (wt-nl "cl_object value0;") (wt-nl "cl_object *VVtemp;") (when shared-data @@ -398,7 +399,7 @@ (wt-nl1 "{") (when (compiler-check-args) (wt-nl "check_arg(" (length arg-types) ");")) - (wt-nl "NVALUES=1;") + (wt-nl "cl_env_copy->nvalues=1;") (wt-nl "return " (case return-type (FIXNUM "MAKE_FIXNUM") (CHARACTER "CODE_CHAR") @@ -582,6 +583,7 @@ " VLEX" *reservation-cmacro* " CLSR" *reservation-cmacro* " STCK" *reservation-cmacro*) + (wt-nl "const cl_env_ptr cl_env_copy = ecl_process_env();") (wt-nl *volatile* "cl_object value0;") (when (>= (fun-debug fun) 2) (wt-nl "struct ihs_frame ihs;")) diff --git a/src/cmp/cmpvar.lsp b/src/cmp/cmpvar.lsp index d328872a2..bf39f1000 100644 --- a/src/cmp/cmpvar.lsp +++ b/src/cmp/cmpvar.lsp @@ -336,7 +336,7 @@ (sym-loc (make-lcl-var)) (val-loc (make-lcl-var))) (wt-nl "{cl_object " sym-loc "," val-loc ";") - (wt-nl "cl_index " lcl " = cl_env.bds_top - cl_env.bds_org;") + (wt-nl "cl_index " lcl " = cl_env_copy->bds_top - cl_env_copy->bds_org;") (push lcl *unwind-exit*) (let ((*destination* sym-loc)) (c2expr* symbols)) diff --git a/src/h/external.h b/src/h/external.h index 8a5781e2f..75a227355 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -443,11 +443,11 @@ extern ECL_API cl_object si_eval_with_env _ARGS((cl_narg narg, cl_object form, . /* interpreter.c */ extern ECL_API cl_object si_interpreter_stack _ARGS((cl_narg narg)); -extern ECL_API cl_object ecl_stack_frame_open(cl_object f, cl_index size); +extern ECL_API cl_object ecl_stack_frame_open(cl_env_ptr env, cl_object f, cl_index size); extern ECL_API void ecl_stack_frame_enlarge(cl_object f, cl_index size); extern ECL_API void ecl_stack_frame_push(cl_object f, cl_object o); extern ECL_API void ecl_stack_frame_push_values(cl_object f); -extern ECL_API cl_object ecl_stack_frame_from_va_list(cl_object f, cl_va_list args); +extern ECL_API cl_object ecl_stack_frame_from_va_list(cl_env_ptr env, cl_object f, cl_va_list args); extern ECL_API cl_object ecl_stack_frame_pop_values(cl_object f); extern ECL_API cl_object ecl_stack_frame_elt(cl_object f, cl_index n); extern ECL_API void ecl_stack_frame_elt_set(cl_object f, cl_index n, cl_object o); @@ -459,15 +459,15 @@ extern ECL_API cl_object ecl_apply_from_stack_frame(cl_object f, cl_object o); extern ECL_API void cl_stack_push(cl_object o); extern ECL_API cl_object cl_stack_pop(void); -extern ECL_API cl_index cl_stack_index(void); -extern ECL_API void cl_stack_set_size(cl_index new_size); -extern ECL_API void cl_stack_set_index(cl_index sp); -extern ECL_API void cl_stack_pop_n(cl_index n); -extern ECL_API void cl_stack_insert(cl_index where, cl_index n); -extern ECL_API cl_index cl_stack_push_list(cl_object list); -extern ECL_API void cl_stack_push_n(cl_index n, cl_object *args); -extern ECL_API cl_index cl_stack_push_values(void); -extern ECL_API void cl_stack_pop_values(cl_index n); +extern ECL_API cl_index ecl_stack_index(cl_env_ptr); +extern ECL_API void ecl_stack_set_size(cl_env_ptr env, cl_index new_size); +extern ECL_API void ecl_stack_set_index(cl_env_ptr env, cl_index sp); +extern ECL_API void ecl_stack_pop_n(cl_env_ptr env, cl_index n); +extern ECL_API void ecl_stack_insert(cl_env_ptr env, cl_index where, cl_index n); +extern ECL_API cl_index ecl_stack_push_list(cl_env_ptr env, cl_object list); +extern ECL_API void ecl_stack_push_n(cl_env_ptr env, cl_index n, cl_object *args); +extern ECL_API cl_index ecl_stack_push_values(cl_env_ptr env); +extern ECL_API void ecl_stack_pop_values(cl_env_ptr env, cl_index n); extern ECL_API cl_object ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offset); /* disassembler.c */ diff --git a/src/h/internal.h b/src/h/internal.h index b30af2c82..7719379f8 100644 --- a/src/h/internal.h +++ b/src/h/internal.h @@ -75,12 +75,12 @@ typedef struct cl_compiler_env *cl_compiler_env_ptr; /* interpreter.d */ -#define cl_stack_ref(n) cl_env.stack[n] -#define cl_stack_index() (cl_env.stack_top-cl_env.stack) +#define ecl_stack_ref(env,n) (env)->stack[n] +#define ecl_stack_index(env) ((env)->stack_top-(env)->stack) -#define ECL_BUILD_STACK_FRAME(name,frame) \ +#define ECL_BUILD_STACK_FRAME(env,name,frame) \ struct ecl_stack_frame frame;\ - cl_object name = ecl_stack_frame_open((cl_object)&frame, 0); + cl_object name = ecl_stack_frame_open(env, (cl_object)&frame, 0); /* ffi.d */ diff --git a/src/h/object.h b/src/h/object.h index be3b90fc9..9fa4ce0e7 100644 --- a/src/h/object.h +++ b/src/h/object.h @@ -645,6 +645,7 @@ struct ecl_stack_frame { cl_object *bottom; /* Bottom part */ cl_object *top; /* Top part */ cl_object *stack; /* Is this relative to the lisp stack? */ + cl_object env; }; /* diff --git a/src/h/stacks.h b/src/h/stacks.h index be9ec668b..121836a54 100644 --- a/src/h/stacks.h +++ b/src/h/stacks.h @@ -202,13 +202,15 @@ extern ECL_API ecl_frame_ptr _frs_push(register cl_object val); *********************************/ #define CL_NEWENV_BEGIN {\ - cl_index __i = cl_stack_push_values(); \ + cl_env_ptr the_env = ecl_process_env(); \ + cl_index __i = ecl_stack_push_values(the_env); \ #define CL_NEWENV_END \ - cl_stack_pop_values(__i); } + ecl_stack_pop_values(the_env,__i); } #define CL_UNWIND_PROTECT_BEGIN {\ bool __unwinding; ecl_frame_ptr __next_fr; \ + cl_env_ptr the_env = ecl_process_env(); \ cl_index __nr; \ if (frs_push(ECL_PROTECT_TAG)) { \ __unwinding=1; __next_fr=cl_env.nlj_fr; \ @@ -217,10 +219,10 @@ extern ECL_API ecl_frame_ptr _frs_push(register cl_object val); #define CL_UNWIND_PROTECT_EXIT \ __unwinding=0; } \ frs_pop(); \ - __nr = cl_stack_push_values(); + __nr = ecl_stack_push_values(the_env); #define CL_UNWIND_PROTECT_END \ - cl_stack_pop_values(__nr); \ + ecl_stack_pop_values(the_env,__nr); \ if (__unwinding) ecl_unwind(__next_fr); } #define CL_BLOCK_BEGIN(id) { \ From 0126a558fb4d214d0f3d06ff7d25faa545af9899 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sat, 11 Oct 2008 23:09:45 +0200 Subject: [PATCH 18/60] Eliminate more uses of fake variable cl_env --- src/c/compiler.d | 19 ++++--- src/c/dpp.c | 4 +- src/c/eval.d | 4 +- src/c/format.d | 13 ++--- src/c/gbc.d | 9 ++-- src/c/gfun.d | 29 +++++------ src/c/print.d | 128 ++++++++++++++++++++++++----------------------- src/c/read.d | 10 ++-- src/c/stacks.d | 2 +- src/c/threads.d | 24 +++++---- src/c/unixint.d | 9 ++-- 11 files changed, 133 insertions(+), 118 deletions(-) diff --git a/src/c/compiler.d b/src/c/compiler.d index 7c2a74acd..a5587c034 100644 --- a/src/c/compiler.d +++ b/src/c/compiler.d @@ -151,6 +151,7 @@ pop_maybe_nil(cl_object *l) { static cl_object asm_end(cl_index beginning) { + cl_env_ptr env = ecl_process_env(); cl_object bytecodes; cl_index code_size, data_size, i; cl_opcode *code; @@ -169,7 +170,7 @@ asm_end(cl_index beginning) { bytecodes->bytecodes.file = (file == OBJNULL)? Cnil : file; bytecodes->bytecodes.file_position = (position == OBJNULL)? Cnil : position; for (i = 0, code = (cl_opcode *)bytecodes->bytecodes.code; i < code_size; i++) { - code[i] = (cl_opcode)(cl_fixnum)cl_env.stack[beginning+i]; + code[i] = (cl_opcode)(cl_fixnum)(env->stack[beginning+i]); } for (i=0; i < data_size; i++) { bytecodes->bytecodes.data[i] = CAR(ENV->constants); @@ -219,6 +220,7 @@ asm_jmp(register int op) { static void asm_complete(register int op, register cl_index pc) { + cl_env_ptr env = ecl_process_env(); cl_fixnum delta = current_pc() - pc; /* [1] */ if (op && (asm_ref(pc-1) != op)) FEprogram_error("Non matching codes in ASM-COMPLETE2", 0); @@ -229,14 +231,14 @@ asm_complete(register int op, register cl_index pc) { unsigned char low = delta & 0xFF; char high = delta >> 8; # ifdef WORDS_BIGENDIAN - cl_env.stack[pc] = (cl_object)(cl_fixnum)high; - cl_env.stack[pc+1] = (cl_object)(cl_fixnum)low; + env->stack[pc] = (cl_object)(cl_fixnum)high; + env->stack[pc+1] = (cl_object)(cl_fixnum)low; # else - cl_env.stack[pc] = (cl_object)(cl_fixnum)low; - cl_env.stack[pc+1] = (cl_object)(cl_fixnum)high; + env->stack[pc] = (cl_object)(cl_fixnum)low; + env->stack[pc+1] = (cl_object)(cl_fixnum)high; # endif #else - cl_env.stack[pc] = (cl_object)(cl_fixnum)delta; + env->stack[pc] = (cl_object)(cl_fixnum)delta; #endif } } @@ -1010,7 +1012,8 @@ c_catch(cl_object args, int flags) { static int c_compiler_let(cl_object args, int flags) { cl_object bindings; - cl_index old_bds_top_index = cl_env.bds_top - cl_env.bds_org; + cl_env_ptr env = ecl_process_env(); + cl_index old_bds_top_index = env->bds_top - env->bds_org; for (bindings = pop(&args); !ecl_endp(bindings); ) { cl_object form = pop(&bindings); @@ -2350,7 +2353,7 @@ si_process_lambda_list(cl_object org_lambda_list, cl_object context) #define AT_KEYS 3 #define AT_OTHER_KEYS 4 #define AT_AUXS 5 - + const cl_env_ptr the_env = ecl_process_env(); cl_object v, key, init, spp, lambda_list = org_lambda_list; cl_object reqs = Cnil, opts = Cnil, keys = Cnil, rest = Cnil, auxs = Cnil; int nreq = 0, nopt = 0, nkey = 0, naux = 0, stage = 0; diff --git a/src/c/dpp.c b/src/c/dpp.c index 56948c9bb..55fb619b1 100644 --- a/src/c/dpp.c +++ b/src/c/dpp.c @@ -776,10 +776,10 @@ put_return(void) fprintf(out, "cl_object __value%d = %s;\n", i, result[i]); } put_tabs(t); - fprintf(out, "NVALUES = %d;\n", nres); + fprintf(out, "the_env->nvalues = %d;\n", nres); for (i = nres-1; i > 0; i--) { put_tabs(t); - fprintf(out, "VALUES(%d) = __value%d;\n", i, i); + fprintf(out, "the_env->values[%d] = __value%d;\n", i, i); } put_tabs(t); fprintf(out, "return __value0;\n"); diff --git a/src/c/eval.d b/src/c/eval.d index ee26020fa..6476e216b 100644 --- a/src/c/eval.d +++ b/src/c/eval.d @@ -22,7 +22,7 @@ cl_object * _ecl_va_sp(cl_narg narg) { - return cl_env.stack_top - narg; + return ecl_process_env()->stack_top - narg; } static cl_object @@ -37,7 +37,7 @@ build_funcall_frame(cl_object f, cl_va_list args) p = (cl_object*)(args[0].args); #else cl_index i; - p = cl_env.values; + p = env->values; for (i = 0; i < n; i++) { p[i] = va_arg(args[0].args, cl_object); } diff --git a/src/c/format.d b/src/c/format.d index 4a8b619fe..548e4fdde 100644 --- a/src/c/format.d +++ b/src/c/format.d @@ -102,16 +102,17 @@ static cl_object doformat(cl_narg narg, cl_object strm, cl_object string, cl_va_ static cl_object get_aux_stream(void) { + cl_env_ptr env = ecl_process_env(); cl_object stream; - ecl_disable_interrupts(); - if (cl_env.fmt_aux_stream == Cnil) { + ecl_disable_interrupts_env(env); + if (env->fmt_aux_stream == Cnil) { stream = ecl_make_string_output_stream(64); } else { - stream = cl_env.fmt_aux_stream; - cl_env.fmt_aux_stream = Cnil; + stream = env->fmt_aux_stream; + env->fmt_aux_stream = Cnil; } - ecl_enable_interrupts(); + ecl_enable_interrupts_env(env); return stream; } @@ -1872,7 +1873,7 @@ doformat(cl_narg narg, cl_object strm, cl_object string, cl_va_list args, bool i format(&fmt, string->string.self, string->string.fillp); ecl_force_output(strm); } - cl_env.fmt_aux_stream = fmt.aux_stream; + ecl_process_env()->fmt_aux_stream = fmt.aux_stream; if (!in_formatter) output = Cnil; return output; diff --git a/src/c/gbc.d b/src/c/gbc.d index 608ec60bb..1eb46bd8a 100644 --- a/src/c/gbc.d +++ b/src/c/gbc.d @@ -746,6 +746,7 @@ cl_object (*GC_exit_hook)() = NULL; void ecl_gc(cl_type t) { + const cl_env_ptr env = ecl_process_env(); int i, j; int tm; int gc_start = ecl_runtime(); @@ -775,8 +776,8 @@ ecl_gc(cl_type t) #error "We need to stop all other threads" #endif /* THREADS */ - interrupts = cl_env.disable_interrupts; - cl_env.disable_interrupts = 1; + interrupts = env->disable_interrupts; + env->disable_interrupts = 1; collect_blocks = t > t_end; if (collect_blocks) @@ -863,7 +864,7 @@ ecl_gc(cl_type t) fflush(stdout); } - cl_env.disable_interrupts = interrupts; + env->disable_interrupts = interrupts; if (GC_exit_hook != NULL) (*GC_exit_hook)(); @@ -884,7 +885,7 @@ ecl_gc(cl_type t) fflush(stdout); } - if (cl_env.interrupt_pending) ecl_check_pending_interrupts(); + if (env->interrupt_pending) ecl_check_pending_interrupts(); } /* diff --git a/src/c/gfun.d b/src/c/gfun.d index d46a69425..be48510e8 100644 --- a/src/c/gfun.d +++ b/src/c/gfun.d @@ -201,8 +201,9 @@ vector_hash_key(cl_object keys) */ static cl_object * -search_method_hash(cl_object keys, cl_object table) +search_method_hash(cl_env_ptr env, cl_object keys) { + cl_object table = env->method_hash; cl_index argno = keys->vector.fillp; cl_index i = vector_hash_key(keys); cl_index total_size = table->vector.dim; @@ -211,7 +212,7 @@ search_method_hash(cl_object keys, cl_object table) int k; i = i % total_size; i = i - (i % 3); - min_gen = cl_env.method_generation; + min_gen = env->method_generation; min_e = 0; for (k = 20; k--; ) { cl_object *e = table->vector.self.t + i; @@ -253,7 +254,7 @@ search_method_hash(cl_object keys, cl_object table) ecl_internal_error("search_method_hash"); } RECORD_KEY(min_e) = OBJNULL; - cl_env.method_generation++; + env->method_generation++; FOUND: /* * Once we have reached here, we set the new generation of @@ -261,12 +262,12 @@ search_method_hash(cl_object keys, cl_object table) * generation number does not become too large and we can * expire some elements. */ - gen = cl_env.method_generation; + gen = env->method_generation; RECORD_GEN_SET(min_e, gen); if (gen >= total_size/2) { cl_object *e = table->vector.self.t; gen = 0.5*gen; - cl_env.method_generation -= gen; + env->method_generation -= gen; for (i = table->vector.dim; i; i-= 3, e += 3) { cl_fixnum g = RECORD_GEN(e) - gen; if (g <= 0) { @@ -281,12 +282,12 @@ search_method_hash(cl_object keys, cl_object table) } static cl_object -get_spec_vector(cl_object frame, cl_object gf) +get_spec_vector(cl_env_ptr env, cl_object frame, cl_object gf) { cl_object *args = frame->frame.bottom; cl_index narg = frame->frame.top - args; cl_object spec_how_list = GFUN_SPEC(gf); - cl_object vector = cl_env.method_spec_vector; + cl_object vector = env->method_spec_vector; cl_object *argtype = vector->vector.self.t; int spec_no = 1; argtype[0] = gf; @@ -331,6 +332,7 @@ compute_applicable_method(cl_object frame, cl_object gf) cl_object _ecl_standard_dispatch(cl_object frame, cl_object gf) { + const cl_env_ptr env = ecl_process_env(); cl_object func, vector; /* * We have to copy the frame because it might be stored in cl_env.values @@ -346,23 +348,22 @@ _ecl_standard_dispatch(cl_object frame, cl_object gf) #ifdef ECL_THREADS /* See whether we have to clear the hash from some generic functions right now. */ - if (cl_env.method_hash_clear_list != Cnil) { + if (env->method_hash_clear_list != Cnil) { cl_object clear_list; THREAD_OP_LOCK(); - clear_list = cl_env.method_hash_clear_list; + clear_list = env->method_hash_clear_list; loop_for_on_unsafe(clear_list) { do_clear_method_hash(&cl_env, ECL_CONS_CAR(clear_list)); } end_loop_for_on; - cl_env.method_hash_clear_list = Cnil; + env->method_hash_clear_list = Cnil; THREAD_OP_UNLOCK(); } #endif - vector = get_spec_vector(frame, gf); + vector = get_spec_vector(env, frame, gf); if (vector == OBJNULL) { func = compute_applicable_method(frame, gf); } else { - cl_object table = cl_env.method_hash; - cl_object *e = search_method_hash(vector, table); + cl_object *e = search_method_hash(env, vector); if (RECORD_KEY(e) != OBJNULL) { func = RECORD_VALUE(e); } else { @@ -371,7 +372,7 @@ _ecl_standard_dispatch(cl_object frame, cl_object gf) if (RECORD_KEY(e) != OBJNULL) { /* The cache might have changed while we * computed applicable methods */ - e = search_method_hash(vector, table); + e = search_method_hash(env, vector); } RECORD_KEY(e) = keys; RECORD_VALUE(e) = func; diff --git a/src/c/print.d b/src/c/print.d index ffab2906d..5c61b4fd3 100644 --- a/src/c/print.d +++ b/src/c/print.d @@ -73,59 +73,60 @@ static void flush_queue(bool force, cl_object stream); static void writec_queue(int c, cl_object stream) { - if (cl_env.qc >= ECL_PPRINT_QUEUE_SIZE) + const cl_env_ptr env = ecl_process_env(); + if (env->qc >= ECL_PPRINT_QUEUE_SIZE) flush_queue(FALSE, stream); - if (cl_env.qc >= ECL_PPRINT_QUEUE_SIZE) + if (env->qc >= ECL_PPRINT_QUEUE_SIZE) FEerror("Can't pretty-print.", 0); - cl_env.queue[cl_env.qt] = c; - cl_env.qt = mod(cl_env.qt+1); - cl_env.qc++; + env->queue[env->qt] = c; + env->qt = mod(env->qt+1); + env->qc++; } static void flush_queue(bool force, cl_object stream) { + const cl_env_ptr env = ecl_process_env(); int c, i, j, k, l, i0; - BEGIN: - while (cl_env.qc > 0) { - c = cl_env.queue[cl_env.qh]; + while (env->qc > 0) { + c = env->queue[env->qh]; if (c < 0400) { ecl_write_char(c, stream); } else if (c == MARK) goto DO_MARK; else if (c == UNMARK) - cl_env.isp -= 2; + env->isp -= 2; else if (c == SET_INDENT) - cl_env.indent_stack[cl_env.isp] = ecl_file_column(stream); + env->indent_stack[env->isp] = ecl_file_column(stream); else if (c == INDENT) { goto DO_INDENT; } else if (c == INDENT1) { - i = ecl_file_column(stream)-cl_env.indent_stack[cl_env.isp]; - if (i < 8 && cl_env.indent_stack[cl_env.isp] < LINE_LENGTH/2) { + i = ecl_file_column(stream)-env->indent_stack[env->isp]; + if (i < 8 && env->indent_stack[env->isp] < LINE_LENGTH/2) { ecl_write_char(' ', stream); - cl_env.indent_stack[cl_env.isp] + env->indent_stack[env->isp] = ecl_file_column(stream); } else { - if (cl_env.indent_stack[cl_env.isp] < LINE_LENGTH/2) { - cl_env.indent_stack[cl_env.isp] - = cl_env.indent_stack[cl_env.isp-1] + 4; + if (env->indent_stack[env->isp] < LINE_LENGTH/2) { + env->indent_stack[env->isp] + = env->indent_stack[env->isp-1] + 4; } goto DO_INDENT; } } else if (c == INDENT2) { - cl_env.indent_stack[cl_env.isp] = cl_env.indent_stack[cl_env.isp-1] + 2; + env->indent_stack[env->isp] = env->indent_stack[env->isp-1] + 2; goto PUT_INDENT; } - cl_env.qh = mod(cl_env.qh+1); - --cl_env.qc; + env->qh = mod(env->qh+1); + --env->qc; } return; DO_MARK: k = LINE_LENGTH - 1 - ecl_file_column(stream); - for (i = 1, j = 0, l = 1; l > 0 && i < cl_env.qc && j < k; i++) { - c = cl_env.queue[mod(cl_env.qh + i)]; + for (i = 1, j = 0, l = 1; l > 0 && i < env->qc && j < k; i++) { + c = env->queue[mod(env->qh + i)]; if (c == MARK) l++; else if (c == UNMARK) @@ -137,23 +138,23 @@ DO_MARK: } if (l == 0) goto FLUSH; - if (i == cl_env.qc && !force) + if (i == env->qc && !force) return; - cl_env.qh = mod(cl_env.qh+1); - --cl_env.qc; - if (cl_env.isp >= ECL_PPRINT_INDENTATION_STACK_SIZE-2) + env->qh = mod(env->qh+1); + --env->qc; + if (env->isp >= ECL_PPRINT_INDENTATION_STACK_SIZE-2) FEerror("Can't pretty-print.", 0); - cl_env.isp+=2; - cl_env.indent_stack[cl_env.isp-1] = ecl_file_column(stream); - cl_env.indent_stack[cl_env.isp] = cl_env.indent_stack[cl_env.isp-1]; + env->isp+=2; + env->indent_stack[env->isp-1] = ecl_file_column(stream); + env->indent_stack[env->isp] = env->indent_stack[env->isp-1]; goto BEGIN; DO_INDENT: - if (cl_env.iisp > cl_env.isp) + if (env->iisp > env->isp) goto PUT_INDENT; k = LINE_LENGTH - 1 - ecl_file_column(stream); - for (i0 = 0, i = 1, j = 0, l = 1; i < cl_env.qc && j < k; i++) { - c = cl_env.queue[mod(cl_env.qh + i)]; + for (i0 = 0, i = 1, j = 0, l = 1; i < env->qc && j < k; i++) { + c = env->queue[mod(env->qh + i)]; if (c == MARK) l++; else if (c == UNMARK) { @@ -179,7 +180,7 @@ DO_INDENT: } else if (c < 0400) j++; } - if (i == cl_env.qc && !force) + if (i == env->qc && !force) return; if (i0 == 0) goto PUT_INDENT; @@ -187,23 +188,23 @@ DO_INDENT: goto FLUSH; PUT_INDENT: - cl_env.qh = mod(cl_env.qh+1); - --cl_env.qc; + env->qh = mod(env->qh+1); + --env->qc; ecl_write_char('\n', stream); - for (i = cl_env.indent_stack[cl_env.isp]; i > 0; --i) + for (i = env->indent_stack[env->isp]; i > 0; --i) ecl_write_char(' ', stream); - cl_env.iisp = cl_env.isp; + env->iisp = env->isp; goto BEGIN; FLUSH: for (j = 0; j < i; j++) { - c = cl_env.queue[cl_env.qh]; + c = env->queue[env->qh]; if (c == INDENT || c == INDENT1 || c == INDENT2) ecl_write_char(' ', stream); else if (c < 0400) ecl_write_char(c, stream); - cl_env.qh = mod(cl_env.qh+1); - --cl_env.qc; + env->qh = mod(env->qh+1); + --env->qc; } goto BEGIN; } @@ -211,7 +212,8 @@ FLUSH: static void write_ch(int c, cl_object stream) { - if (cl_env.print_pretty) + const cl_env_ptr env = ecl_process_env(); + if (env->print_pretty) writec_queue(c, stream); else if (c == INDENT || c == INDENT1) ecl_write_char(' ', stream); @@ -226,18 +228,19 @@ call_print_object(cl_object x, cl_object stream) call_structure_print_function(cl_object f, cl_object x, cl_object stream) #endif { + const cl_env_ptr env = ecl_process_env(); short ois[ECL_PPRINT_INDENTATION_STACK_SIZE]; - volatile bool p = cl_env.print_pretty; + volatile bool p = env->print_pretty; volatile int oqh, oqt, oqc, oisp, oiisp; - if ((p = cl_env.print_pretty)) { + if ((p = env->print_pretty)) { flush_queue(TRUE, stream); - oqh = cl_env.qh; - oqt = cl_env.qt; - oqc = cl_env.qc; - oisp = cl_env.isp; - oiisp = cl_env.iisp; - memcpy(ois, cl_env.indent_stack, cl_env.isp * sizeof(*ois)); + oqh = env->qh; + oqt = env->qt; + oqc = env->qc; + oisp = env->isp; + oiisp = env->iisp; + memcpy(ois, env->indent_stack, env->isp * sizeof(*ois)); } CL_UNWIND_PROTECT_BEGIN { #ifdef CLOS @@ -246,13 +249,13 @@ call_structure_print_function(cl_object f, cl_object x, cl_object stream) funcall(4, f, x, stream, MAKE_FIXNUM(0)); #endif } CL_UNWIND_PROTECT_EXIT { - if ((cl_env.print_pretty = p)) { - memcpy(cl_env.indent_stack, ois, oisp * sizeof(*ois)); - cl_env.iisp = oiisp; - cl_env.isp = oisp; - cl_env.qc = oqc; - cl_env.qt = oqt; - cl_env.qh = oqh; + if ((env->print_pretty = p)) { + memcpy(env->indent_stack, ois, oisp * sizeof(*ois)); + env->iisp = oiisp; + env->isp = oisp; + env->qc = oqc; + env->qt = oqt; + env->qh = oqh; } } CL_UNWIND_PROTECT_END; } @@ -1251,7 +1254,7 @@ si_write_ugly_object(cl_object x, cl_object stream) write_ch('(', stream); WRITE_SET_INDENT(stream); #if !defined(ECL_CMU_FORMAT) - if (cl_env.print_pretty && CAR(x) != OBJNULL && + if (ecl_process_env()->print_pretty && CAR(x) != OBJNULL && type_of(CAR(x)) == t_symbol && (r = si_get_sysprop(CAR(x), @'si::pretty-print-format')) != Cnil) goto PRETTY_PRINT_FORMAT; @@ -1673,16 +1676,17 @@ si_write_object_recursive(cl_object x, cl_object stream) #if !defined(ECL_CMU_FORMAT) cl_object si_write_object(cl_object x, cl_object stream) { + const cl_env_ptr env = ecl_process_env(); if (ecl_symbol_value(@'*print-pretty*') == Cnil) { - cl_env.print_pretty = 0; + env->print_pretty = 0; } else { - cl_env.print_pretty = 1; - cl_env.qh = cl_env.qt = cl_env.qc = 0; - cl_env.isp = cl_env.iisp = 0; - cl_env.indent_stack[0] = 0; + env->print_pretty = 1; + env->qh = env->qt = env->qc = 0; + env->isp = env->iisp = 0; + env->indent_stack[0] = 0; } si_write_object_recursive(x, stream); - if (cl_env.print_pretty) + if (env->print_pretty) flush_queue(TRUE, stream); } #endif /* !ECL_CMU_FORMAT */ diff --git a/src/c/read.d b/src/c/read.d index ad236b694..651247eae 100644 --- a/src/c/read.d +++ b/src/c/read.d @@ -43,13 +43,14 @@ read_table_entry(cl_object rdtbl, cl_object c); cl_object si_get_buffer_string() { - cl_object pool = cl_env.string_pool; + const cl_env_ptr env = ecl_process_env(); + cl_object pool = env->string_pool; cl_object output; if (pool == Cnil) { output = cl_alloc_adjustable_base_string(ECL_BUFFER_STRING_SIZE); } else { output = CAR(pool); - cl_env.string_pool = CDR(pool); + env->string_pool = CDR(pool); } output->base_string.fillp = 0; @(return output) @@ -59,7 +60,8 @@ cl_object si_put_buffer_string(cl_object string) { if (string != Cnil) { - cl_object pool = cl_env.string_pool; + const cl_env_ptr env = ecl_process_env(); + cl_object pool = env->string_pool; cl_index l = 0; if (pool != Cnil) { /* We store the size of the pool in the string index */ @@ -71,7 +73,7 @@ si_put_buffer_string(cl_object string) string = cl_alloc_adjustable_base_string(ECL_BUFFER_STRING_SIZE); } string->base_string.fillp = l+1; - cl_env.string_pool = CONS(string, pool); + env->string_pool = CONS(string, pool); } } @(return) diff --git a/src/c/stacks.d b/src/c/stacks.d index 3c9008701..928a3c049 100644 --- a/src/c/stacks.d +++ b/src/c/stacks.d @@ -79,7 +79,7 @@ void bds_bind(cl_object s, cl_object value) { cl_env_ptr env = ecl_process_env(); - struct ecl_hashtable_entry *h = ecl_search_hash(s, cl_env.bindings_hash); + struct ecl_hashtable_entry *h = ecl_search_hash(s, env->bindings_hash); struct bds_bd *slot = ++env->bds_top; if (slot >= env->bds_limit) { bds_overflow(); diff --git a/src/c/threads.d b/src/c/threads.d index d154039b5..30eca661b 100644 --- a/src/c/threads.d +++ b/src/c/threads.d @@ -91,7 +91,7 @@ ecl_set_process_env(cl_env_ptr env) cl_object mp_current_process(void) { - return cl_env.own_process; + return ecl_process_env()->own_process; } /*---------------------------------------------------------------------- @@ -119,7 +119,7 @@ thread_cleanup(void *env) * mp_process_kill(). */ THREAD_OP_LOCK(); - cl_core.processes = ecl_remove_eq(cl_env.own_process, + cl_core.processes = ecl_remove_eq(mp_current_process(), cl_core.processes); THREAD_OP_UNLOCK(); } @@ -177,6 +177,7 @@ alloc_process(cl_object name) static void initialize_process_bindings(cl_object process, cl_object initial_bindings) { + const cl_env_ptr this_env = ecl_process_env(); cl_object hash; /* FIXME! Here we should either use INITIAL-BINDINGS or copy lexical * bindings */ @@ -186,7 +187,7 @@ initialize_process_bindings(cl_object process, cl_object initial_bindings) ecl_make_singlefloat(0.7), Cnil); /* no need for locking */ } else { - hash = si_copy_hash_table(cl_env.bindings_hash); + hash = si_copy_hash_table(this_env->bindings_hash); } process->process.env->bindings_hash = hash; } @@ -338,7 +339,7 @@ mp_exit_process(void) back to the thread entry point, going through all possible UNWIND-PROTECT. */ - ecl_unwind(cl_env.frs_org); + ecl_unwind(ecl_process_env()->frs_org); } } @@ -449,12 +450,13 @@ mp_lock_holder(cl_object lock) cl_object mp_giveup_lock(cl_object lock) { + cl_object own_process = mp_current_process(); int code; if (type_of(lock) != t_lock) FEwrong_type_argument(@'mp::lock', lock); - if (lock->lock.holder != cl_env.own_process) { + if (lock->lock.holder != own_process) { FEerror("Attempt to give up a lock ~S that is not owned by ~S.", 2, - lock, cl_env.own_process); + lock, own_process); } if (--lock->lock.counter == 0) { lock->lock.holder = Cnil; @@ -476,13 +478,13 @@ mp_giveup_lock(cl_object lock) FEwrong_type_argument(@'mp::lock', lock); /* In Windows, all locks are recursive. We simulate the other case. */ /* We will complain always if recursive=0 and try to lock recursively. */ - if (!lock->lock.recursive && (lock->lock.holder == cl_env.own_process)) { + if (!lock->lock.recursive && (lock->lock.holder == the_env->own_process)) { FEerror("A recursive attempt was made to hold lock ~S", 1, lock); } #ifdef ECL_WINDOWS_THREADS switch (WaitForSingleObject(lock->lock.mutex, (wait==Ct?INFINITE:0))) { case WAIT_OBJECT_0: - lock->lock.holder = cl_env.own_process; + lock->lock.holder = env->own_process; lock->lock.counter++; output = Ct; break; @@ -503,7 +505,7 @@ mp_giveup_lock(cl_object lock) rc = pthread_mutex_trylock(&lock->lock.mutex); } if (rc == 0) { - lock->lock.holder = cl_env.own_process; + lock->lock.holder = the_env->own_process; lock->lock.counter++; output = Ct; } else { @@ -548,7 +550,7 @@ mp_condition_variable_wait(cl_object cv, cl_object lock) FEwrong_type_argument(@'mp::lock', lock); if (pthread_cond_wait(&cv->condition_variable.cv, &lock->lock.mutex) == 0) - lock->lock.holder = cl_env.own_process; + lock->lock.holder = mp_current_process(); #endif @(return Ct) } @@ -589,7 +591,7 @@ mp_condition_variable_timedwait(cl_object cv, cl_object lock, cl_object seconds) } if (pthread_cond_timedwait(&cv->condition_variable.cv, &lock->lock.mutex, &ts) == 0) { - lock->lock.holder = cl_env.own_process; + lock->lock.holder = mp_current_process(); @(return Ct) } else { @(return Cnil) diff --git a/src/c/unixint.d b/src/c/unixint.d index d53d8f815..17752f11f 100644 --- a/src/c/unixint.d +++ b/src/c/unixint.d @@ -456,11 +456,12 @@ si_check_pending_interrupts(void) void ecl_check_pending_interrupts(void) { + const cl_env_ptr env = ecl_process_env(); int sig; void *info; - cl_env.disable_interrupts = 0; - info = cl_env.interrupt_info; - sig = cl_env.interrupt_pending; + env->disable_interrupts = 0; + info = env->interrupt_info; + sig = env->interrupt_pending; if (sig) { call_handler(handle_signal_now, sig, info, 0); } @@ -647,6 +648,6 @@ init_unixint(int pass) si_trap_fpe(Ct, Ct); } #endif - cl_env.disable_interrupts = 0; + ecl_process_env()->disable_interrupts = 0; } } From ed584a62c53857f1d6078a20b5ac29b4411d5c85 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sat, 11 Oct 2008 23:14:54 +0200 Subject: [PATCH 19/60] Deprecate name: cl_dealloc (-> ecl_dealloc) --- src/c/alloc_2.d | 2 +- src/c/big.d | 2 +- src/c/ffi.d | 2 +- src/c/file.d | 4 ++-- src/c/gbc.d | 2 +- src/c/interpreter.d | 2 +- src/c/read.d | 4 ++-- src/c/stacks.d | 4 ++-- src/c/unixfsys.d | 2 +- src/h/external.h | 3 +-- 10 files changed, 13 insertions(+), 14 deletions(-) diff --git a/src/c/alloc_2.d b/src/c/alloc_2.d index dcddb5b45..c111d234c 100644 --- a/src/c/alloc_2.d +++ b/src/c/alloc_2.d @@ -210,7 +210,7 @@ ecl_alloc_atomic(cl_index n) } void -cl_dealloc(void *ptr) +ecl_dealloc(void *ptr) { ecl_disable_interrupts(); GC_FREE(ptr); diff --git a/src/c/big.d b/src/c/big.d index 31457d0f4..297f02d6e 100644 --- a/src/c/big.d +++ b/src/c/big.d @@ -278,7 +278,7 @@ mp_free(void *ptr, size_t size) char *x = ptr; if (x < (char *)(cl_env.big_register_limbs) || x > (char *)(cl_env.big_register_limbs+2)) - cl_dealloc(x); + ecl_dealloc(x); } void init_big_registers(cl_env_ptr env) diff --git a/src/c/ffi.d b/src/c/ffi.d index 246e1325b..bf8ddc66e 100644 --- a/src/c/ffi.d +++ b/src/c/ffi.d @@ -130,7 +130,7 @@ si_free_foreign_data(cl_object f) FEwrong_type_argument(@'si::foreign-data', f); } if (f->foreign.size) { - cl_dealloc(f->foreign.data); + ecl_dealloc(f->foreign.data); } f->foreign.size = 0; f->foreign.data = NULL; diff --git a/src/c/file.d b/src/c/file.d index 085fa20dd..5580e3d8b 100644 --- a/src/c/file.d +++ b/src/c/file.d @@ -684,7 +684,7 @@ static void flush_output_stream_binary(cl_object strm); if (fclose(fp) != 0) FElibc_error("Cannot close stream ~S.", 1, strm); #if !defined(GBC_BOEHM) - cl_dealloc(strm->stream.buffer); + ecl_dealloc(strm->stream.buffer); strm->stream.file = NULL; #endif break; @@ -697,7 +697,7 @@ static void flush_output_stream_binary(cl_object strm); wsock_error( "Cannot close Windows Socket ~S~%~A.", strm ); ecl_enable_interrupts(); #if !defined(GBC_BOEHM) - cl_dealloc(strm->stream.buffer); + ecl_dealloc(strm->stream.buffer); strm->stream.file = NULL; #endif break; diff --git a/src/c/gbc.d b/src/c/gbc.d index 1eb46bd8a..75e30ffd5 100644 --- a/src/c/gbc.d +++ b/src/c/gbc.d @@ -727,7 +727,7 @@ contblock_sweep_phase(void) q = p + 4; while (q < e && !get_mark_bit((int *)q)) q += 4; - cl_dealloc(p); + ecl_dealloc(p); p = q + 4; } i = j + 1; diff --git a/src/c/interpreter.d b/src/c/interpreter.d index 0ec20bd58..9fa5dced4 100644 --- a/src/c/interpreter.d +++ b/src/c/interpreter.d @@ -44,7 +44,7 @@ ecl_stack_set_size(cl_env_ptr env, cl_index tentative_new_size) env->stack_limit = env->stack + (new_size - 2*safety_area); ecl_enable_interrupts_env(env); - cl_dealloc(old_stack); + ecl_dealloc(old_stack); /* A stack always has at least one element. This is assumed by cl__va_start * and friends, which take a sp=0 to have no arguments. diff --git a/src/c/read.d b/src/c/read.d index 651247eae..8d9eba63d 100644 --- a/src/c/read.d +++ b/src/c/read.d @@ -516,7 +516,7 @@ ecl_parse_number(cl_object str, cl_index start, cl_index end, output = OBJNULL; } OUTPUT: - cl_dealloc(buffer); + ecl_dealloc(buffer); return output; } } @@ -2164,7 +2164,7 @@ read_VV(cl_object block, void (*entry_point)(cl_object)) if (VVtemp) { block->cblock.temp_data = NULL; block->cblock.temp_data_size = 0; - cl_dealloc(VVtemp); + ecl_dealloc(VVtemp); } bds_unwind1(); } CL_UNWIND_PROTECT_EXIT { diff --git a/src/c/stacks.d b/src/c/stacks.d index 928a3c049..614e0fba4 100644 --- a/src/c/stacks.d +++ b/src/c/stacks.d @@ -195,7 +195,7 @@ bds_set_size(cl_env_ptr env, cl_index size) env->bds_size = size; ecl_enable_interrupts_env(env); - cl_dealloc(old_org); + ecl_dealloc(old_org); } } @@ -375,7 +375,7 @@ frs_set_size(cl_env_ptr env, cl_index size) env->frs_size = size; ecl_enable_interrupts_env(env); - cl_dealloc(old_org); + ecl_dealloc(old_org); } } diff --git a/src/c/unixfsys.d b/src/c/unixfsys.d index c03d772a1..46c4e2071 100644 --- a/src/c/unixfsys.d +++ b/src/c/unixfsys.d @@ -325,7 +325,7 @@ ecl_backup_fopen(const char *filename, const char *option) make_constant_base_string(filename), make_simple_base_string(backupfilename)); } ecl_enable_interrupts(); - cl_dealloc(backupfilename); + ecl_dealloc(backupfilename); return fopen(filename, option); } diff --git a/src/h/external.h b/src/h/external.h index 75a227355..a8ac66205 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -1810,14 +1810,13 @@ extern ECL_API cl_object clos_standard_instance_set _ARGS((cl_narg narg, cl_obje /* * Deprecated names */ -#if 0 #define cl_alloc_instance ecl_alloc_instance #define cl_alloc_object ecl_alloc_object #define cl_alloc ecl_alloc #define cl_alloc_atomic ecl_alloc_atomic #define cl_alloc_align ecl_alloc_align #define cl_alloc_atomic_align ecl_alloc_atomic_align -#endif +#define cl_dealloc ecl_dealloc #endif From 5a41a55a2d82ecc2eaebca62be742e5a0513fdb4 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sat, 11 Oct 2008 23:47:40 +0200 Subject: [PATCH 20/60] Since dpp now generates code that uses 'the_env', it has to be defined in functions that use @(return) --- src/c/alloc_2.d | 3 +++ src/c/array.d | 7 +++++++ src/c/assignment.d | 1 + src/c/cfun.d | 2 ++ src/c/disassembler.d | 2 ++ src/c/hash.d | 1 + src/c/num_co.d | 19 +++++++++++++++++++ src/c/package.d | 1 + src/c/symbol.d | 2 ++ src/c/tcp.d | 1 + src/configure | 2 +- src/configure.in | 2 +- 12 files changed, 41 insertions(+), 2 deletions(-) diff --git a/src/c/alloc_2.d b/src/c/alloc_2.d index c111d234c..25f97f273 100644 --- a/src/c/alloc_2.d +++ b/src/c/alloc_2.d @@ -435,6 +435,7 @@ si_set_finalizer(cl_object o, cl_object finalizer) cl_object si_gc_stats(cl_object enable) { + const cl_env_ptr the_env = ecl_process_env(); cl_object old_status = cl_core.gc_stats? Ct : Cnil; cl_core.gc_stats = (enable != Cnil); if (cl_core.bytes_consed == Cnil) { @@ -585,6 +586,7 @@ ecl_register_root(cl_object *p) cl_object si_gc(cl_object area) { + const cl_env_ptr the_env = ecl_process_env(); ecl_disable_interrupts(); GC_gcollect(); ecl_enable_interrupts(); @@ -594,6 +596,7 @@ si_gc(cl_object area) cl_object si_gc_dump() { + const cl_env_ptr the_env = ecl_process_env(); ecl_disable_interrupts(); GC_dump(); ecl_enable_interrupts(); diff --git a/src/c/array.d b/src/c/array.d index b7b3f21e0..e92403af5 100644 --- a/src/c/array.d +++ b/src/c/array.d @@ -736,6 +736,7 @@ cl_adjustable_array_p(cl_object a) cl_object cl_array_displacement(cl_object a) { + const cl_env_ptr the_env = ecl_process_env(); cl_object to_array; cl_index offset; @@ -787,6 +788,7 @@ cl_array_displacement(cl_object a) cl_object cl_svref(cl_object x, cl_object index) { + const cl_env_ptr the_env = ecl_process_env(); cl_index i; while (type_of(x) != t_vector || @@ -804,6 +806,7 @@ cl_svref(cl_object x, cl_object index) cl_object si_svset(cl_object x, cl_object index, cl_object v) { + const cl_env_ptr the_env = ecl_process_env(); cl_index i; while (type_of(x) != t_vector || @@ -821,6 +824,7 @@ si_svset(cl_object x, cl_object index, cl_object v) cl_object cl_array_has_fill_pointer_p(cl_object a) { + const cl_env_ptr the_env = ecl_process_env(); cl_object r; AGAIN: switch (type_of(a)) { @@ -845,6 +849,7 @@ cl_array_has_fill_pointer_p(cl_object a) cl_object cl_fill_pointer(cl_object a) { + const cl_env_ptr the_env = ecl_process_env(); assert_type_vector(a); if (!a->vector.hasfillp) { a = ecl_type_error(@'fill-pointer', "argument", @@ -859,6 +864,7 @@ cl_fill_pointer(cl_object a) cl_object si_fill_pointer_set(cl_object a, cl_object fp) { + const cl_env_ptr the_env = ecl_process_env(); assert_type_vector(a); AGAIN: if (a->vector.hasfillp) { @@ -881,6 +887,7 @@ si_fill_pointer_set(cl_object a, cl_object fp) cl_object si_replace_array(cl_object olda, cl_object newa) { + const cl_env_ptr the_env = ecl_process_env(); cl_object dlist; if (type_of(olda) != type_of(newa) || (type_of(olda) == t_array && olda->array.rank != newa->array.rank)) diff --git a/src/c/assignment.d b/src/c/assignment.d index 1ca072d48..3293d22e6 100644 --- a/src/c/assignment.d +++ b/src/c/assignment.d @@ -116,6 +116,7 @@ ecl_clear_compiler_properties(cl_object sym) cl_object si_get_sysprop(cl_object sym, cl_object prop) { + cl_env_ptr the_env = ecl_process_env(); cl_object plist = ecl_gethash_safe(sym, cl_core.system_properties, Cnil); prop = ecl_getf(plist, prop, OBJNULL); if (prop == OBJNULL) { diff --git a/src/c/cfun.d b/src/c/cfun.d index 315a911c4..e648b1287 100644 --- a/src/c/cfun.d +++ b/src/c/cfun.d @@ -85,6 +85,7 @@ cl_def_c_function_va(cl_object sym, void *c_function) cl_object si_compiled_function_name(cl_object fun) { + cl_env_ptr the_env = ecl_process_env(); cl_object output; switch(type_of(fun)) { @@ -106,6 +107,7 @@ si_compiled_function_name(cl_object fun) cl_object cl_function_lambda_expression(cl_object fun) { + cl_env_ptr the_env = ecl_process_env(); cl_object output, name = Cnil, lex = Cnil; switch(type_of(fun)) { diff --git a/src/c/disassembler.d b/src/c/disassembler.d index 47c44e4e0..78f777b99 100644 --- a/src/c/disassembler.d +++ b/src/c/disassembler.d @@ -629,6 +629,7 @@ si_bc_disassemble(cl_object v) cl_object si_bc_split(cl_object b) { + const cl_env_ptr the_env = ecl_process_env(); cl_object vector; cl_object data; cl_object lex = Cnil; @@ -649,6 +650,7 @@ si_bc_split(cl_object b) cl_object si_bc_file(cl_object b) { + cl_env_ptr the_env = ecl_process_env(); if (type_of(b) == t_bclosure) { b = b->bclosure.code; } diff --git a/src/c/hash.d b/src/c/hash.d index 5227d5db5..7cd08570f 100644 --- a/src/c/hash.d +++ b/src/c/hash.d @@ -579,6 +579,7 @@ cl_hash_table_count(cl_object ht) static cl_object si_hash_table_iterate(cl_narg narg, cl_object env) { + const cl_env_ptr the_env = ecl_process_env(); cl_object index = CAR(env); cl_object ht = CADR(env); cl_fixnum i; diff --git a/src/c/num_co.d b/src/c/num_co.d index cf5805412..4096e7eeb 100644 --- a/src/c/num_co.d +++ b/src/c/num_co.d @@ -126,6 +126,7 @@ cl_numerator(cl_object x) cl_object cl_denominator(cl_object x) { + const cl_env_ptr the_env = ecl_process_env(); AGAIN: switch (type_of(x)) { case t_ratio: @@ -145,6 +146,7 @@ cl_denominator(cl_object x) cl_object ecl_floor1(cl_object x) { + const cl_env_ptr the_env = ecl_process_env(); cl_object v0, v1; AGAIN: switch (type_of(x)) { @@ -199,6 +201,7 @@ ecl_floor1(cl_object x) cl_object ecl_floor2(cl_object x, cl_object y) { + const cl_env_ptr the_env = ecl_process_env(); cl_object v0, v1; cl_type ty; AGAIN: @@ -425,6 +428,7 @@ ecl_floor2(cl_object x, cl_object y) cl_object ecl_ceiling1(cl_object x) { + const cl_env_ptr the_env = ecl_process_env(); cl_object v0, v1; AGAIN: switch (type_of(x)) { @@ -479,6 +483,7 @@ ecl_ceiling1(cl_object x) cl_object ecl_ceiling2(cl_object x, cl_object y) { + const cl_env_ptr the_env = ecl_process_env(); cl_object v0, v1; cl_type ty; AGAIN: @@ -705,6 +710,7 @@ ecl_ceiling2(cl_object x, cl_object y) cl_object ecl_truncate1(cl_object x) { + const cl_env_ptr the_env = ecl_process_env(); cl_object v0, v1; AGAIN: switch (type_of(x)) { @@ -759,6 +765,7 @@ ecl_truncate1(cl_object x) cl_object ecl_truncate2(cl_object x, cl_object y) { + const cl_env_ptr the_env = ecl_process_env(); if (ecl_plusp(x) != ecl_plusp(y)) return ecl_ceiling2(x, y); else @@ -817,6 +824,7 @@ round_long_double(long double d) cl_object ecl_round1(cl_object x) { + const cl_env_ptr the_env = ecl_process_env(); cl_object v0, v1; AGAIN: switch (type_of(x)) { @@ -867,6 +875,7 @@ ecl_round1(cl_object x) cl_object ecl_round2(cl_object x, cl_object y) { + const cl_env_ptr the_env = ecl_process_env(); cl_object v0, v1; cl_object q; @@ -915,6 +924,7 @@ ecl_round2(cl_object x, cl_object y) cl_object cl_mod(cl_object x, cl_object y) { + const cl_env_ptr the_env = ecl_process_env(); /* INV: #'floor always outputs two values */ @floor(2, x, y); @(return VALUES(1)) @@ -923,6 +933,7 @@ cl_mod(cl_object x, cl_object y) cl_object cl_rem(cl_object x, cl_object y) { + const cl_env_ptr the_env = ecl_process_env(); @truncate(2, x, y); @(return VALUES(1)) } @@ -930,6 +941,7 @@ cl_rem(cl_object x, cl_object y) cl_object cl_decode_float(cl_object x) { + const cl_env_ptr the_env = ecl_process_env(); int e, s; cl_type tx = type_of(x); float f; @@ -989,6 +1001,7 @@ cl_decode_float(cl_object x) cl_object cl_scale_float(cl_object x, cl_object y) { + const cl_env_ptr the_env = ecl_process_env(); cl_fixnum k; AGAIN: if (FIXNUMP(y)) { @@ -1024,6 +1037,7 @@ cl_scale_float(cl_object x, cl_object y) cl_object cl_float_radix(cl_object x) { + const cl_env_ptr the_env = ecl_process_env(); while (cl_floatp(x) != Ct) { x = ecl_type_error(@'float-radix',"argument",x,@'float'); } @@ -1093,6 +1107,7 @@ cl_float_radix(cl_object x) cl_object cl_float_digits(cl_object x) { + const cl_env_ptr the_env = ecl_process_env(); AGAIN: switch (type_of(x)) { #ifdef ECL_SHORT_FLOAT @@ -1119,6 +1134,7 @@ cl_float_digits(cl_object x) cl_object cl_float_precision(cl_object x) { + const cl_env_ptr the_env = ecl_process_env(); int precision; float f; double d; AGAIN: @@ -1197,6 +1213,7 @@ cl_float_precision(cl_object x) cl_object cl_integer_decode_float(cl_object x) { + const cl_env_ptr the_env = ecl_process_env(); int e, s; AGAIN: switch (type_of(x)) { @@ -1297,6 +1314,7 @@ cl_integer_decode_float(cl_object x) cl_object cl_realpart(cl_object x) { + const cl_env_ptr the_env = ecl_process_env(); AGAIN: switch (type_of(x)) { case t_fixnum: @@ -1324,6 +1342,7 @@ cl_realpart(cl_object x) cl_object cl_imagpart(cl_object x) { + const cl_env_ptr the_env = ecl_process_env(); AGAIN: switch (type_of(x)) { case t_fixnum: diff --git a/src/c/package.d b/src/c/package.d index e14b10ab9..3e214c7fe 100644 --- a/src/c/package.d +++ b/src/c/package.d @@ -1051,6 +1051,7 @@ BEGIN: cl_object si_package_hash_tables(cl_object p) { + const cl_env_ptr the_env = ecl_process_env(); cl_object he, hi, u; assert_type_package(p); PACKAGE_LOCK(p); diff --git a/src/c/symbol.d b/src/c/symbol.d index 943b3394a..dca61b4aa 100644 --- a/src/c/symbol.d +++ b/src/c/symbol.d @@ -288,6 +288,7 @@ cl_symbol_plist(cl_object sym) cl_object cl_get_properties(cl_object place, cl_object indicator_list) { + const cl_env_ptr the_env = ecl_process_env(); cl_object l; #ifdef ECL_SAFE @@ -408,6 +409,7 @@ cl_keywordp(cl_object sym) cl_object si_rem_f(cl_object plist, cl_object indicator) { + cl_env_ptr the_env = ecl_process_env(); bool found = remf(&plist, indicator); @(return plist (found? Ct : Cnil)) } diff --git a/src/c/tcp.d b/src/c/tcp.d index b64bc3f86..60cea2fd4 100644 --- a/src/c/tcp.d +++ b/src/c/tcp.d @@ -351,6 +351,7 @@ si_open_unix_socket_stream(cl_object path) cl_object si_lookup_host_entry(cl_object host_or_address) { + const cl_env_ptr the_env = ecl_process_env(); struct hostent *he; unsigned long l; char address[4]; diff --git a/src/configure b/src/configure index 1a15e8990..907fe3933 100755 --- a/src/configure +++ b/src/configure @@ -5196,7 +5196,7 @@ if test "${with_fpe}" != yes; then _ACEOF fi -if test "${with_signed_zero}" == yes; then +if test "${with_signed_zero}" = yes; then cat >>confdefs.h <<\_ACEOF #define ECL_SIGNED_ZERO 1 _ACEOF diff --git a/src/configure.in b/src/configure.in index 3423901ef..4b9e3a06e 100644 --- a/src/configure.in +++ b/src/configure.in @@ -430,7 +430,7 @@ dnl Deactivate floating point exceptions if asked to if test "${with_fpe}" != yes; then AC_DEFINE(ECL_AVOID_FPE_H) fi -if test "${with_signed_zero}" == yes; then +if test "${with_signed_zero}" = yes; then AC_DEFINE(ECL_SIGNED_ZERO) fi From 5f2fdff0086e094e6df0b3005eb07ffc871cbd04 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sun, 12 Oct 2008 00:07:10 +0200 Subject: [PATCH 21/60] Protect shared library operations from interrupts. --- src/c/load.d | 50 ++++++++++++++++++++++++++++++++------------------ 1 file changed, 32 insertions(+), 18 deletions(-) diff --git a/src/c/load.d b/src/c/load.d index 874081e23..77c8e985a 100644 --- a/src/c/load.d +++ b/src/c/load.d @@ -61,6 +61,7 @@ copy_object_file(cl_object original) int err; cl_object s, copy = make_constant_base_string("TMP:ECL"); copy = si_coerce_to_filename(si_mkstemp(copy)); + ecl_disable_interrupts(); #ifdef HAVE_LSTAT err = unlink(copy->base_string.self) || symlink(original->base_string.self, copy->base_string.self); @@ -71,6 +72,7 @@ copy_object_file(cl_object original) err = 1; #endif #endif + ecl_enable_interrupts(); if (err) { FEerror("Unable to copy file ~A to ~A", 2, original, copy); } @@ -150,6 +152,7 @@ ecl_library_open(cl_object filename, bool force_reload) { block = ecl_alloc_object(t_codeblock); block->cblock.self_destruct = self_destruct; block->cblock.name = filename; + ecl_disable_interrupts(); #ifdef HAVE_DLFCN_H block->cblock.handle = dlopen(filename->base_string.self, RTLD_NOW|RTLD_GLOBAL); @@ -172,6 +175,7 @@ ecl_library_open(cl_object filename, bool force_reload) { #if defined(mingw32) || defined(_MSC_VER) block->cblock.handle = LoadLibrary(filename->base_string.self); #endif + ecl_enable_interrupts(); /* * A second pass to ensure that the dlopen routine has not * returned a library that we had already loaded. If this is @@ -209,6 +213,7 @@ ecl_library_symbol(cl_object block, const char *symbol, bool lock) { } } } + ecl_disable_interrupts(); #if defined(mingw32) || defined(_MSC_VER) { HANDLE hndSnap = NULL; @@ -226,16 +231,18 @@ ecl_library_symbol(cl_object block, const char *symbol, bool lock) { } CloseHandle(hndSnap); } - return hnd; + p = (void*)hnd; } #endif #ifdef HAVE_DLFCN_H - return dlsym(0, symbol); + p = dlsym(0, symbol); #endif #if !defined(mingw32) && !defined(_MSC_VER) && !defined(HAVE_DLFCN_H) - return 0; + p = 0; #endif + ecl_enable_interrupts(); } else { + ecl_disable_interrupts(); #ifdef HAVE_DLFCN_H p = dlsym(block->cblock.handle, symbol); #endif @@ -253,38 +260,45 @@ ecl_library_symbol(cl_object block, const char *symbol, bool lock) { p = NSAddressOfSymbol(sym); } #endif + ecl_enable_interrupts(); /* Libraries whose symbols are being referenced by the FFI should not * get garbage collected. Until we find a better solution we simply lock * them for the rest of the runtime */ if (p) { block->cblock.locked |= lock; } - return p; } + return p; } cl_object ecl_library_error(cl_object block) { - const char *message; + cl_object output; + ecl_disable_interrupts(); #ifdef HAVE_DLFCN_H - message = dlerror(); + output = make_base_string_copy(dlerror()); #endif #ifdef HAVE_MACH_O_DYLD_H - NSLinkEditErrors c; - int number; - const char *filename; - NSLinkEditError(&c, &number, &filename, &message); + { + NSLinkEditErrors c; + int number; + const char *filename; + NSLinkEditError(&c, &number, &filename, &message); + output = make_base_string_copy(message); + } #endif #if defined(mingw32) || defined(_MSC_VER) - cl_object output; - FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | - FORMAT_MESSAGE_ALLOCATE_BUFFER, - 0, GetLastError(), 0, (void*)&message, 0, NULL); - output = make_base_string_copy(message); - LocalFree(message); - return output; + { + const char *message; + FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | + FORMAT_MESSAGE_ALLOCATE_BUFFER, + 0, GetLastError(), 0, (void*)&message, 0, NULL); + output = make_base_string_copy(message); + LocalFree(message); + } #endif - return make_base_string_copy(message); + ecl_enable_interrupts(); + return output; } void From 29bc665a5ebf8d968729dd38dfd5c71e51d82541 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sun, 12 Oct 2008 00:07:43 +0200 Subject: [PATCH 22/60] Protect shared library operations from interrupts. --- src/c/load.d | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/c/load.d b/src/c/load.d index 77c8e985a..87be3204d 100644 --- a/src/c/load.d +++ b/src/c/load.d @@ -319,6 +319,7 @@ ecl_library_close(cl_object block) { if (verbose) { fprintf(stderr, ";;; Freeing library %s\n", filename); } + ecl_disable_interrupts(); #ifdef HAVE_DLFCN_H dlclose(block->cblock.handle); #endif @@ -328,6 +329,7 @@ ecl_library_close(cl_object block) { #if defined(mingw32) || defined(_MSC_VER) FreeLibrary(block->cblock.handle); #endif + ecl_enable_interrupts(); } if (block->cblock.self_destruct) { if (verbose) { From 5cfb4c0919b607a1ee4e17bebeab471031cf1e15 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sun, 12 Oct 2008 00:26:05 +0200 Subject: [PATCH 23/60] Use of lists to keep the list of libraries is safe against threads and signal race conditions. --- src/c/alloc_2.d | 6 ++---- src/c/load.d | 50 +++++++++++++++++-------------------------------- src/c/main.d | 4 +--- src/c/threads.d | 3 ++- 4 files changed, 22 insertions(+), 41 deletions(-) diff --git a/src/c/alloc_2.d b/src/c/alloc_2.d index 25f97f273..514d52277 100644 --- a/src/c/alloc_2.d +++ b/src/c/alloc_2.d @@ -540,15 +540,13 @@ stacks_scanner() cl_object l; l = cl_core.libraries; if (l) { - int i; - for (i = 0; i < l->vector.fillp; i++) { - cl_object dll = l->vector.self.t[i]; + for (; l != Cnil; l = ECL_CONS_CDR(l)) { + cl_object dll = ECL_CONS_CAR(l); if (dll->cblock.locked) { GC_push_conditional((void *)dll, (void *)(&dll->cblock + 1), 1); GC_set_mark_bit((void *)dll); } } - GC_set_mark_bit((void *)l->vector.self.t); } GC_push_all((void *)(&cl_core), (void *)(&cl_core + 1)); GC_push_all((void *)cl_symbols, (void *)(cl_symbols + cl_num_symbols_in_core)); diff --git a/src/c/load.d b/src/c/load.d index 87be3204d..9e37a07e7 100644 --- a/src/c/load.d +++ b/src/c/load.d @@ -83,10 +83,9 @@ copy_object_file(cl_object original) static cl_object ecl_library_find_by_name(cl_object filename) { - cl_object libraries = cl_core.libraries; - cl_index i; - for (i = 0; i < libraries->vector.fillp; i++) { - cl_object other = libraries->vector.self.t[i]; + cl_object l; + for (l = cl_core.libraries; l != Cnil; l = ECL_CONS_CDR(l)) { + cl_object other = ECL_CONS_CAR(l); cl_object name = other->cblock.name; if (!Null(name) && ecl_string_eq(name, filename)) { return other; @@ -98,10 +97,9 @@ ecl_library_find_by_name(cl_object filename) static cl_object ecl_library_find_by_handle(void *handle) { - cl_object libraries = cl_core.libraries; - cl_index i; - for (i = 0; i < libraries->vector.fillp; i++) { - cl_object other = libraries->vector.self.t[i]; + cl_object l; + for (l = cl_core.libraries; l != Cnil; l = ECL_CONS_CDR(l)) { + cl_object other = ECL_CONS_CAR(l); if (handle == other->cblock.handle) { return other; } @@ -112,7 +110,6 @@ ecl_library_find_by_handle(void *handle) cl_object ecl_library_open(cl_object filename, bool force_reload) { cl_object block; - cl_object libraries = cl_core.libraries; bool self_destruct = 0; cl_index i; @@ -192,7 +189,7 @@ ecl_library_open(cl_object filename, bool force_reload) { block = other; } else { si_set_finalizer(block, Ct); - cl_vector_push_extend(2, block, libraries); + cl_core.libraries = CONS(block, cl_core.libraries); } } return block; @@ -202,16 +199,11 @@ void * ecl_library_symbol(cl_object block, const char *symbol, bool lock) { void *p; if (block == @':default') { - cl_object l = cl_core.libraries; - if (l) { - cl_index i; - for (i = 0; i < l->vector.fillp; i++) { - cl_object block = l->vector.self.t[i]; - p = ecl_library_symbol(block, symbol, lock); - if (p) { - return p; - } - } + cl_object l; + for (l = cl_core.libraries; l != Cnil; l = ECL_CONS_CDR(l)) { + cl_object block = ECL_CONS_CAR(l); + p = ecl_library_symbol(block, symbol, lock); + if (p) return p; } ecl_disable_interrupts(); #if defined(mingw32) || defined(_MSC_VER) @@ -305,7 +297,7 @@ void ecl_library_close(cl_object block) { const char *filename; bool verbose = SYM_VAL(@'si::*gc-verbose*') != Cnil; - cl_object libraries = cl_core.libraries; + cl_object l; int i; if (Null(block->cblock.name)) @@ -337,23 +329,15 @@ ecl_library_close(cl_object block) { } unlink(filename); } - for (i = 0; i < libraries->vector.fillp; i++) { - if (libraries->vector.self.t[i] == block) { - memmove(libraries->vector.self.t+i, - libraries->vector.self.t+i+1, - (libraries->vector.fillp-i-1) * sizeof(cl_object)); - libraries->vector.fillp--; - break; - } - } + cl_core.libraries = ecl_remove_eq(block, cl_core.libraries); } void ecl_library_close_all(void) { - int i; - while ((i = cl_core.libraries->vector.fillp)) - ecl_library_close(cl_core.libraries->vector.self.t[--i]); + while (cl_core.libraries != Cnil) { + ecl_library_close(ECL_CONS_CAR(cl_core.libraries)); + } } cl_object diff --git a/src/c/main.d b/src/c/main.d index c15c8bccf..5d864270c 100644 --- a/src/c/main.d +++ b/src/c/main.d @@ -389,9 +389,7 @@ cl_boot(int argc, char **argv) /* LIBRARIES is an adjustable vector of objects. It behaves as a vector of weak pointers thanks to the magic in gbc.d/alloc_2.d */ - cl_core.libraries = si_make_vector(@'t', MAKE_FIXNUM(0), - @'t', MAKE_FIXNUM(0), - @'nil', @'nil'); + cl_core.libraries = Cnil; #if 0 /* FINALIZERS and FINALIZABLE_OBJECTS are also like LIBRARIES */ cl_core.finalizable_objects = si_make_vector(@'t', MAKE_FIXNUM(512), diff --git a/src/c/threads.d b/src/c/threads.d index 30eca661b..59cae12bb 100644 --- a/src/c/threads.d +++ b/src/c/threads.d @@ -346,7 +346,8 @@ mp_exit_process(void) cl_object mp_all_processes(void) { - /* Isn't it a race condition? */ + /* No race condition here because this list is never destructively + * modified. When we add or remove processes, we create new lists. */ @(return cl_copy_list(cl_core.processes)) } From b7efe80e7dcf3103887ad302b615a2ddffa7ce92 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sun, 12 Oct 2008 12:50:35 +0200 Subject: [PATCH 24/60] Functions compiled with (OPTIMIZE (SAFETY >= 2)) have an explicit stack overflow check. --- src/CHANGELOG | 3 +++ src/cmp/cmpenv.lsp | 4 ++++ src/cmp/cmptop.lsp | 2 ++ 3 files changed, 9 insertions(+) diff --git a/src/CHANGELOG b/src/CHANGELOG index 45a16548d..99fcb4d6f 100644 --- a/src/CHANGELOG +++ b/src/CHANGELOG @@ -77,6 +77,9 @@ ECL 8.9.0: - ECL builds using thread local storage when configured with --with-__thread and the feature works on that platform. + - Functions compiled with (OPTIMIZE (SAFETY >= 2)) have an explicit stack + overflow check. + * Embedding: - ECL now implements a more transparent interface for setting and querying diff --git a/src/cmp/cmpenv.lsp b/src/cmp/cmpenv.lsp index 8a08588a2..166afc739 100644 --- a/src/cmp/cmpenv.lsp +++ b/src/cmp/cmpenv.lsp @@ -613,6 +613,10 @@ (space (third x)) (speed (fourth x))))) +(defun policy-check-stack-overflow (&optional (env *cmp-env*)) + "Do we add a stack check to every function?" + (>= (cmp-env-optimization 'safety env) 2)) + (defun policy-inline-slot-access-p (&optional (env *cmp-env*)) "Do we inline access to structures and sealed classes?" (or (< (cmp-env-optimization 'safety env) 2) diff --git a/src/cmp/cmptop.lsp b/src/cmp/cmptop.lsp index cd58039c5..cc6a7ad64 100644 --- a/src/cmp/cmptop.lsp +++ b/src/cmp/cmptop.lsp @@ -587,6 +587,8 @@ (wt-nl *volatile* "cl_object value0;") (when (>= (fun-debug fun) 2) (wt-nl "struct ihs_frame ihs;")) + (when (policy-check-stack-overflow) + (wt-nl "ecl_cs_check(value0);")) (when (eq (fun-closure fun) 'CLOSURE) (let ((clv-used (remove-if #'(lambda (x) From 4d11eaa81adf926e4c041a05e5030244d3ea9cf4 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sun, 12 Oct 2008 13:00:53 +0200 Subject: [PATCH 25/60] ecl_cs_check() now takes an environment parameter. --- src/c/interpreter.d | 3 +-- src/cmp/cmptop.lsp | 2 +- src/h/stacks.h | 4 ++-- 3 files changed, 4 insertions(+), 5 deletions(-) diff --git a/src/c/interpreter.d b/src/c/interpreter.d index 9fa5dced4..41224b88d 100644 --- a/src/c/interpreter.d +++ b/src/c/interpreter.d @@ -502,7 +502,6 @@ cl_object ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offset) { ECL_OFFSET_TABLE - typedef struct cl_env_struct *cl_env_ptr; const cl_env_ptr the_env = ecl_process_env(); volatile cl_index old_bds_top_index = the_env->bds_top - the_env->bds_org; cl_opcode *vector = (cl_opcode*)bytecodes->bytecodes.code + offset; @@ -512,7 +511,7 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs struct ecl_stack_frame frame_aux; volatile struct ihs_frame ihs; - /*ecl_cs_check(ihs);*/ + ecl_cs_check(the_env, ihs); if (type_of(bytecodes) != t_bytecodes) FEinvalid_function(bytecodes); diff --git a/src/cmp/cmptop.lsp b/src/cmp/cmptop.lsp index cc6a7ad64..fd7b875f6 100644 --- a/src/cmp/cmptop.lsp +++ b/src/cmp/cmptop.lsp @@ -588,7 +588,7 @@ (when (>= (fun-debug fun) 2) (wt-nl "struct ihs_frame ihs;")) (when (policy-check-stack-overflow) - (wt-nl "ecl_cs_check(value0);")) + (wt-nl "ecl_cs_check(cl_env_copy,value0);")) (when (eq (fun-closure fun) 'CLOSURE) (let ((clv-used (remove-if #'(lambda (x) diff --git a/src/h/stacks.h b/src/h/stacks.h index 121836a54..5e175b68c 100644 --- a/src/h/stacks.h +++ b/src/h/stacks.h @@ -23,9 +23,9 @@ extern "C" { ***********/ #ifdef ECL_DOWN_STACK -#define ecl_cs_check(var) if ((int*)(&var) <= cl_env.cs_limit) ecl_cs_overflow() +#define ecl_cs_check(env,var) if ((int*)(&var) <= (env)->cs_limit) ecl_cs_overflow() #else -#define ecl_cs_check(var) if ((int*)(&var) >= cl_env.cs_limit) ecl_cs_overflow() +#define ecl_cs_check(env,var) if ((int*)(&var) >= (env)->cs_limit) ecl_cs_overflow() #endif /************** From 70c64f9652ac05f5f498ac110907f4b07babee5f Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sun, 12 Oct 2008 16:44:29 +0200 Subject: [PATCH 26/60] The macros/functions for accessing and changing symbol values require an environment value. --- src/c/assignment.d | 3 +- src/c/cinit.d | 8 ++-- src/c/compiler.d | 50 +++++++++++---------- src/c/disassembler.d | 5 ++- src/c/error.d | 2 +- src/c/file.d | 1 + src/c/format.d | 20 +++++---- src/c/instance.d | 8 ++-- src/c/interpreter.d | 66 ++++++++++++++-------------- src/c/load.d | 17 ++++---- src/c/main.d | 5 ++- src/c/package.d | 14 +++--- src/c/print.d | 92 ++++++++++++++++++++------------------ src/c/read.d | 102 ++++++++++++++++++++++++------------------- src/c/reference.d | 8 +++- src/c/stacks.d | 38 +++++++--------- src/c/symbol.d | 27 ++++++------ src/c/threads.d | 4 +- src/c/typespec.d | 2 +- src/c/unixfsys.d | 4 +- src/c/unixsys.d | 24 ++++++---- src/cmp/cmpbind.lsp | 4 +- src/cmp/cmpexit.lsp | 8 ++-- src/cmp/cmptop.lsp | 2 +- src/cmp/cmpvar.lsp | 6 +-- src/cmp/sysfun.lsp | 2 +- src/h/external.h | 19 ++------ src/h/stacks.h | 61 ++++++++++++++------------ 28 files changed, 322 insertions(+), 280 deletions(-) diff --git a/src/c/assignment.d b/src/c/assignment.d index 3293d22e6..6638724ee 100644 --- a/src/c/assignment.d +++ b/src/c/assignment.d @@ -21,9 +21,10 @@ cl_object cl_set(cl_object var, cl_object val) { + const cl_env_ptr env = ecl_process_env(); if (ecl_symbol_type(var) & stp_constant) FEinvalid_variable("Cannot assign to the constant ~S.", var); - return1(ECL_SETQ(var, val)); + return1(ECL_SETQ(env, var, val)); } @(defun si::fset (fname def &optional macro pprint) diff --git a/src/c/cinit.d b/src/c/cinit.d index 0bd6153d4..e0f9d07ad 100644 --- a/src/c/cinit.d +++ b/src/c/cinit.d @@ -109,16 +109,16 @@ main(int argc, char **args) si_trap_fpe(Ct, Cnil); #ifdef ECL_CMU_FORMAT - SYM_VAL(@'*load-verbose*') = Cnil; + ECL_SET(@'*load-verbose*', Cnil); #endif - SYM_VAL(@'*package*') = cl_core.system_package; + ECL_SET(@'*package*', cl_core.system_package); - features = SYM_VAL(@'*features*'); + features = ecl_symbol_value(@'*features*'); features = CONS(ecl_make_keyword("ECL-MIN"), features); #ifdef HAVE_UNAME features = CONS(ecl_make_keyword("UNAME"), features); #endif - SYM_VAL(@'*features*') = features; + ECL_SET(@'*features*', features); top_level = _ecl_intern("TOP-LEVEL", cl_core.system_package); cl_def_c_function(top_level, si_simple_toplevel, 0); funcall(1, top_level); diff --git a/src/c/compiler.d b/src/c/compiler.d index a5587c034..df4d9d482 100644 --- a/src/c/compiler.d +++ b/src/c/compiler.d @@ -155,8 +155,8 @@ asm_end(cl_index beginning) { cl_object bytecodes; cl_index code_size, data_size, i; cl_opcode *code; - cl_object file = SYM_VAL(@'*load-truename*'); - cl_object position = cl_cdr(SYM_VAL(@'ext::*source-location*')); + cl_object file = ECL_SYM_VAL(env,@'*load-truename*'); + cl_object position = cl_cdr(ECL_SYM_VAL(env,@'ext::*source-location*')); /* Save bytecodes from this session in a new vector */ code_size = current_pc() - beginning; @@ -599,7 +599,7 @@ c_var_ref(cl_object var, int allow_symbol_macro, bool ensure_defined) } } if (ensure_defined) { - l = SYM_VAL(@'si::*action-on-undefined-variable*'); + l = ecl_symbol_value(@'si::*action-on-undefined-variable*'); if (l != Cnil) { funcall(3, l, make_simple_base_string("Undefined variable referenced in interpreted code.~%Name: ~A"), var); @@ -1012,17 +1012,17 @@ c_catch(cl_object args, int flags) { static int c_compiler_let(cl_object args, int flags) { cl_object bindings; - cl_env_ptr env = ecl_process_env(); + const cl_env_ptr env = ecl_process_env(); cl_index old_bds_top_index = env->bds_top - env->bds_org; for (bindings = pop(&args); !ecl_endp(bindings); ) { cl_object form = pop(&bindings); cl_object var = pop(&form); cl_object value = pop_maybe_nil(&form); - bds_bind(var, value); + ecl_bds_bind(env, var, value); } flags = compile_body(args, flags); - bds_unwind(old_bds_top_index); + ecl_bds_unwind(env, old_bds_top_index); return flags; } @@ -1952,16 +1952,17 @@ c_values(cl_object args, int flags) { static int compile_form(cl_object stmt, int flags) { - cl_object code_walker = SYM_VAL(@'si::*code-walker*'); + const cl_env_ptr env = ecl_process_env(); + cl_object code_walker = ECL_SYM_VAL(env,@'si::*code-walker*'); compiler_record *l; cl_object function; bool push = flags & FLAG_PUSH; int new_flags; - bds_bind(@'si::*current-form*', stmt); + ecl_bds_bind(env, @'si::*current-form*', stmt); BEGIN: if (code_walker != OBJNULL) { - stmt = funcall(3, SYM_VAL(@'si::*code-walker*'), stmt, + stmt = funcall(3, ECL_SYM_VAL(env,@'si::*code-walker*'), stmt, CONS(ENV->variables, ENV->macros)); } /* @@ -2095,7 +2096,7 @@ for special form ~S.", 1, function); } else if (new_flags & FLAG_PUSH) { FEerror("Internal error in bytecodes compiler", 0); } - bds_unwind1(); + ecl_bds_unwind1(env); return flags; } @@ -2518,17 +2519,21 @@ ILLEGAL_LAMBDA: static cl_object c_default(cl_index base_pc, cl_object deflt) { cl_type t = type_of(deflt); - if (((t == t_symbol) && (ecl_symbol_type(deflt) & stp_constant) && - !FIXNUMP(SYM_VAL(deflt)))) { - /* FIXME! Shouldn't this happen only in unsafe mode */ - deflt = SYM_VAL(deflt); - } else if (CONSP(deflt) && (CAR(deflt) == @'quote') && !FIXNUMP(CADR(deflt))) { - deflt = CADR(deflt); - } else if ((t == t_symbol) || (t == t_list) || (t == t_fixnum)) { + if ((t == t_symbol) && (ecl_symbol_type(deflt) & stp_constant)) { + cl_object value = ecl_symbol_value(deflt); + if (!FIXNUMP(value)) { + /* FIXME! Shouldn't this happen only in unsafe mode */ + return value; + } + } + if (CONSP(deflt) && (CAR(deflt) == @'quote') && !FIXNUMP(CADR(deflt))) { + return CADR(deflt); + } + if ((t == t_symbol) || (t == t_list) || (t == t_fixnum)) { cl_index pc = current_pc()-base_pc; compile_form(deflt, FLAG_VALUES); asm_op(OP_EXIT); - deflt = MAKE_FIXNUM(pc); + return MAKE_FIXNUM(pc); } return deflt; } @@ -2564,9 +2569,10 @@ ecl_make_lambda(cl_object name, cl_object lambda) { int nopts, nkeys; cl_index handle; struct cl_compiler_env *old_c_env, new_c_env; + const cl_env_ptr env = ecl_process_env(); - bds_bind(@'si::*current-form*', - @list*(3, @'ext::lambda-block', name, lambda)); + ecl_bds_bind(env, @'si::*current-form*', + @list*(3, @'ext::lambda-block', name, lambda)); old_c_env = ENV; c_new_env(&new_c_env, Cnil, old_c_env); @@ -2668,12 +2674,12 @@ ecl_make_lambda(cl_object name, cl_object lambda) { output = asm_end(handle); output->bytecodes.name = name; output->bytecodes.specials = specials; - output->bytecodes.definition = Null(SYM_VAL(@'si::*keep-definitions*'))? + output->bytecodes.definition = Null(ecl_symbol_value(@'si::*keep-definitions*'))? Cnil : lambda; ENV = old_c_env; - bds_unwind1(); + ecl_bds_unwind1(env); return output; } diff --git a/src/c/disassembler.d b/src/c/disassembler.d index 78f777b99..4f5b582c4 100644 --- a/src/c/disassembler.d +++ b/src/c/disassembler.d @@ -64,10 +64,11 @@ disassemble_vars(const char *message, cl_object *data, cl_index step) { static void disassemble_lambda(cl_object bytecodes) { + const cl_env_ptr env = ecl_process_env(); cl_object *data; cl_opcode *vector; - bds_bind(@'*print-pretty*', Cnil); + ecl_bds_bind(env, @'*print-pretty*', Cnil); if (bytecodes->bytecodes.name == OBJNULL || bytecodes->bytecodes.name == @'si::bytecodes') { @@ -109,7 +110,7 @@ NO_ARGS: base = vector = (cl_opcode *)bytecodes->bytecodes.code; disassemble(bytecodes, vector); - bds_unwind1(); + ecl_bds_unwind1(env); } /* -------------------- DISASSEMBLER CORE -------------------- */ diff --git a/src/c/error.d b/src/c/error.d index 253e23637..0214de3d2 100644 --- a/src/c/error.d +++ b/src/c/error.d @@ -81,7 +81,7 @@ FEprogram_error(const char *s, int narg, ...) /* When FEprogram_error is invoked from the compiler, we can * provide information about the offending form. */ - cl_object stmt = SYM_VAL(@'si::*current-form*'); + cl_object stmt = ecl_symbol_value(@'si::*current-form*'); if (stmt != Cnil) { real_args = @list(3, stmt, text, real_args); text = make_constant_base_string("In form~%~S~%~?"); diff --git a/src/c/file.d b/src/c/file.d index 5580e3d8b..8bc73ee6e 100644 --- a/src/c/file.d +++ b/src/c/file.d @@ -3103,6 +3103,7 @@ ecl_stream_to_handle(cl_object s, bool output) void init_file(void) { + const cl_env_ptr env = ecl_process_env(); cl_object standard_input; cl_object standard_output; cl_object error_output; diff --git a/src/c/format.d b/src/c/format.d index 548e4fdde..3c80acde8 100644 --- a/src/c/format.d +++ b/src/c/format.d @@ -411,15 +411,16 @@ static void fmt_integer(format_stack fmt, cl_object x, bool colon, bool atsign, int radix, int mincol, int padchar, int commachar) { + const cl_env_ptr env = ecl_process_env(); int l, l1; int s; if (!FIXNUMP(x) && type_of(x) != t_bignum) { fmt_prepare_aux_stream(fmt); - bds_bind(@'*print-escape*', Cnil); - bds_bind(@'*print-base*', MAKE_FIXNUM(radix)); + ecl_bds_bind(env, @'*print-escape*', Cnil); + ecl_bds_bind(env, @'*print-base*', MAKE_FIXNUM(radix)); si_write_object(x, fmt->aux_stream); - bds_unwind_n(2); + ecl_bds_unwind_n(env, 2); l = fmt->aux_string->string.fillp; mincol -= l; while (mincol-- > 0) @@ -429,10 +430,10 @@ fmt_integer(format_stack fmt, cl_object x, bool colon, bool atsign, return; } fmt_prepare_aux_stream(fmt); - bds_bind(@'*print-radix*', Cnil); - bds_bind(@'*print-base*', MAKE_FIXNUM(radix)); + ecl_bds_bind(env, @'*print-radix*', Cnil); + ecl_bds_bind(env, @'*print-base*', MAKE_FIXNUM(radix)); si_write_object(x, fmt->aux_stream); - bds_unwind_n(2); + ecl_bds_unwind_n(env, 2); l = l1 = fmt->aux_string->string.fillp; s = 0; if (tempstr(fmt, s) == '-') @@ -624,6 +625,7 @@ fmt_roman(format_stack fmt, int i, int one, int five, int ten, bool colon) static void fmt_radix(format_stack fmt, bool colon, bool atsign) { + const cl_env_ptr env = ecl_process_env(); int radix, mincol, padchar, commachar; cl_object x; int i, j, k; @@ -650,10 +652,10 @@ fmt_radix(format_stack fmt, bool colon, bool atsign) return; } fmt_prepare_aux_stream(fmt); - bds_bind(@'*print-radix*', Cnil); - bds_bind(@'*print-base*', MAKE_FIXNUM(10)); + ecl_bds_bind(env, @'*print-radix*', Cnil); + ecl_bds_bind(env, @'*print-base*', MAKE_FIXNUM(10)); si_write_object(x, fmt->aux_stream); - bds_unwind_n(2); + ecl_bds_unwind_n(env, 2); s = 0; i = fmt->aux_string->string.fillp; if (i == 1 && tempstr(fmt, s) == '0') { diff --git a/src/c/instance.d b/src/c/instance.d index fc147e4d4..8e4829f8a 100644 --- a/src/c/instance.d +++ b/src/c/instance.d @@ -186,9 +186,10 @@ si_copy_instance(cl_object x) } @(defun find-class (name &optional (errorp Ct) env) - cl_object class; + cl_object class, hash; @ - class = ecl_gethash_safe(name, SYM_VAL(@'si::*class-name-hash-table*'), Cnil); + hash = ECL_SYM_VAL(the_env, @'si::*class-name-hash-table*'); + class = ecl_gethash_safe(name, hash, Cnil); if (class == Cnil) { if (!Null(errorp)) FEerror("No class named ~S.", 1, name); @@ -264,6 +265,7 @@ enum ecl_built_in_classes { cl_object cl_class_of(cl_object x) { + cl_env_ptr the_env = ecl_process_env(); size_t index; cl_type tp = type_of(x); if (tp == t_instance) @@ -358,7 +360,7 @@ cl_class_of(cl_object x) } { cl_object output; - x = SYM_VAL(@'clos::*builtin-classes*'); + x = ECL_SYM_VAL(the_env, @'clos::*builtin-classes*'); /* We have to be careful because *builtin-classes* might be empty! */ if (Null(x)) { output = cl_find_class(1,@'t'); diff --git a/src/c/interpreter.d b/src/c/interpreter.d index 41224b88d..b7076d6c5 100644 --- a/src/c/interpreter.d +++ b/src/c/interpreter.d @@ -295,10 +295,11 @@ ecl_lex_env_get_record(register cl_object env, register int s) static cl_object lambda_bind_var(cl_object env, cl_object var, cl_object val, cl_object specials) { + const cl_env_ptr the_env = ecl_process_env(); if (!ecl_member_eq(var, specials)) env = bind_var(env, var, val); else - bds_bind(var, val); + ecl_bds_bind(the_env, var, val); return env; } @@ -431,14 +432,6 @@ lambda_bind(cl_object env, cl_narg narg, cl_object lambda, cl_object *sp) /* -------------------- AIDS TO THE INTERPRETER -------------------- */ -static cl_object -search_global(register cl_object s) { - cl_object x = SYM_VAL(s); - if (x == OBJNULL) - FEunbound_variable(s); - return x; -} - static cl_object close_around(cl_object fun, cl_object lex) { cl_object v = ecl_alloc_object(t_bclosure); @@ -553,7 +546,9 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs CASE(OP_VARS); { cl_object var_name; GET_DATA(var_name, vector, data); - reg0 = search_global(var_name); + reg0 = ECL_SYM_VAL(the_env, var_name); + if (reg0 == OBJNULL) + FEunbound_variable(var_name); THREAD_NEXT; } @@ -627,9 +622,11 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs VAR should be either a special variable or a constant. */ CASE(OP_PUSHVS); { - cl_object var_name; + cl_object var_name, value; GET_DATA(var_name, vector, data); - STACK_PUSH(the_env, search_global(var_name)); + value = ECL_SYM_VAL(the_env, var_name); + if (value == OBJNULL) FEunbound_variable(var_name); + STACK_PUSH(the_env, value); THREAD_NEXT; } @@ -789,7 +786,7 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs */ CASE(OP_EXIT); { ihs_pop(); - bds_unwind(old_bds_top_index); + ecl_bds_unwind(the_env, old_bds_top_index); return reg0; } /* OP_FLET nfun{arg}, fun1{object} @@ -987,7 +984,7 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs CASE(OP_UNBINDS); { cl_oparg n; GET_OPARG(n, vector); - bds_unwind_n(n); + ecl_bds_unwind_n(the_env, n); THREAD_NEXT; } /* OP_BIND name{symbol} @@ -1024,13 +1021,13 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs CASE(OP_BINDS); { cl_object var_name; GET_DATA(var_name, vector, data); - bds_bind(var_name, reg0); + ecl_bds_bind(the_env, var_name, reg0); THREAD_NEXT; } CASE(OP_PBINDS); { cl_object var_name; GET_DATA(var_name, vector, data); - bds_bind(var_name, STACK_POP(the_env)); + ecl_bds_bind(the_env, var_name, STACK_POP(the_env)); THREAD_NEXT; } CASE(OP_VBINDS); { @@ -1038,7 +1035,8 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs cl_object var_name; GET_OPARG(n, vector); GET_DATA(var_name, vector, data); - bds_bind(var_name, (n < the_env->nvalues) ? the_env->values[n] : Cnil); + ecl_bds_bind(the_env, var_name, + (n < the_env->nvalues) ? the_env->values[n] : Cnil); THREAD_NEXT; } /* OP_SETQ n{arg} @@ -1065,7 +1063,7 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs /* INV: Not NIL, and of type t_symbol */ if (var->symbol.stype & stp_constant) FEassignment_to_constant(var); - ECL_SETQ(var, reg0); + ECL_SETQ(the_env, var, reg0); THREAD_NEXT; } CASE(OP_PSETQ); { @@ -1078,7 +1076,7 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs cl_object var; GET_DATA(var, vector, data); /* INV: Not NIL, and of type t_symbol */ - ECL_SETQ(var, STACK_POP(the_env)); + ECL_SETQ(the_env, var, STACK_POP(the_env)); THREAD_NEXT; } CASE(OP_VSETQ); { @@ -1096,7 +1094,7 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs GET_DATA(var, vector, data); GET_OPARG(index, vector); v = (index >= the_env->nvalues)? Cnil : the_env->values[index]; - ECL_SETQ(var, v); + ECL_SETQ(the_env, var, v); THREAD_NEXT; } @@ -1297,7 +1295,7 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs THREAD_NEXT; } CASE(OP_PROTECT_NORMAL); { - bds_unwind(the_env->frs_top->frs_bds_top_index); + ecl_bds_unwind(the_env, the_env->frs_top->frs_bds_top_index); frs_pop(the_env); STACK_POP(the_env); lex_env = STACK_POP(the_env); @@ -1328,9 +1326,9 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs for (n = 0; !ecl_endp(vars); n++, vars = ECL_CONS_CDR(vars)) { cl_object var = ECL_CONS_CAR(vars); if (values == Cnil) { - bds_bind(var, OBJNULL); + ecl_bds_bind(the_env, var, OBJNULL); } else { - bds_bind(var, cl_car(values)); + ecl_bds_bind(the_env, var, cl_car(values)); values = ECL_CONS_CDR(values); } } @@ -1339,13 +1337,13 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs } CASE(OP_EXIT_PROGV); { cl_index n = fix(STACK_POP(the_env)); - bds_unwind_n(n); + ecl_bds_unwind_n(the_env, n); THREAD_NEXT; } CASE(OP_STEPIN); { cl_object form; - cl_object a = SYM_VAL(@'si::*step-action*'); + cl_object a = ECL_SYM_VAL(the_env, @'si::*step-action*'); cl_index n; GET_DATA(form, vector, data); SETUP_ENV(the_env); @@ -1354,15 +1352,15 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs if (a == Ct) { /* We are stepping in, but must first ask the user * what to do. */ - ECL_SETQ(@'si::*step-level*', - cl_1P(SYM_VAL(@'si::*step-level*'))); + ECL_SETQ(the_env, @'si::*step-level*', + cl_1P(ECL_SYM_VAL(the_env, @'si::*step-level*'))); STACK_PUSH(the_env, form); INTERPRET_FUNCALL(form, the_env, frame_aux, 1, @'si::stepper'); } else if (a != Cnil) { /* The user told us to step over. *step-level* contains * an integer number that, when it becomes 0, means * that we have finished stepping over. */ - ECL_SETQ(@'si::*step-action*', cl_1P(a)); + ECL_SETQ(the_env, @'si::*step-action*', cl_1P(a)); } else { /* We are not inside a STEP form. This should * actually never happen. */ @@ -1378,28 +1376,28 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs cl_fixnum n; GET_OPARG(n, vector); SETUP_ENV(the_env); - if (SYM_VAL(@'si::*step-action*') == Ct) { + if (ECL_SYM_VAL(the_env, @'si::*step-action*') == Ct) { STACK_PUSH(the_env, reg0); INTERPRET_FUNCALL(reg0, the_env, frame_aux, 1, @'si::stepper'); } INTERPRET_FUNCALL(reg0, the_env, frame_aux, n, reg0); } CASE(OP_STEPOUT); { - cl_object a = SYM_VAL(@'si::*step-action*'); + cl_object a = ECL_SYM_VAL(the_env, @'si::*step-action*'); cl_index n; SETUP_ENV(the_env); the_env->values[0] = reg0; n = ecl_stack_push_values(the_env); if (a == Ct) { /* We exit one stepping level */ - ECL_SETQ(@'si::*step-level*', - cl_1M(SYM_VAL(@'si::*step-level*'))); + ECL_SETQ(the_env, @'si::*step-level*', + cl_1M(ECL_SYM_VAL(the_env, @'si::*step-level*'))); } else if (a == MAKE_FIXNUM(0)) { /* We are back to the level in which the user * selected to step over. */ - ECL_SETQ(@'si::*step-action*', Ct); + ECL_SETQ(the_env, @'si::*step-action*', Ct); } else if (a != Cnil) { - ECL_SETQ(@'si::*step-action*', cl_1M(a)); + ECL_SETQ(the_env, @'si::*step-action*', cl_1M(a)); } else { /* Not stepping, nothing to be done. */ } diff --git a/src/c/load.d b/src/c/load.d index 9e37a07e7..5efc585bd 100644 --- a/src/c/load.d +++ b/src/c/load.d @@ -296,7 +296,7 @@ ecl_library_error(cl_object block) { void ecl_library_close(cl_object block) { const char *filename; - bool verbose = SYM_VAL(@'si::*gc-verbose*') != Cnil; + bool verbose = ecl_symbol_value(@'si::*gc-verbose*') != Cnil; cl_object l; int i; @@ -414,6 +414,7 @@ OUTPUT: cl_object si_load_source(cl_object source, cl_object verbose, cl_object print) { + cl_env_ptr the_env = ecl_process_env(); cl_object x, strm; /* Source may be either a stream or a filename */ @@ -428,7 +429,7 @@ si_load_source(cl_object source, cl_object verbose, cl_object print) CL_UNWIND_PROTECT_BEGIN { cl_object form_index = MAKE_FIXNUM(0); cl_object location = CONS(source, form_index); - bds_bind(@'ext::*source-location*', location); + ecl_bds_bind(the_env, @'ext::*source-location*', location); for (;;) { x = cl_read(3, strm, Cnil, OBJNULL); if (x == OBJNULL) @@ -441,7 +442,7 @@ si_load_source(cl_object source, cl_object verbose, cl_object print) form_index = ecl_plus(MAKE_FIXNUM(1),form_index); ECL_RPLACD(location, form_index); } - bds_unwind1(); + ecl_bds_unwind1(the_env); } CL_UNWIND_PROTECT_EXIT { /* We do not want to come back here if close_stream fails, therefore, first we frs_pop() current jump point, then @@ -524,10 +525,10 @@ NOT_A_FILENAME: cl_format(3, Ct, make_constant_base_string("~&;;; Loading ~s~%"), filename); } - bds_bind(@'*package*', ecl_symbol_value(@'*package*')); - bds_bind(@'*readtable*', ecl_symbol_value(@'*readtable*')); - bds_bind(@'*load-pathname*', not_a_filename? Cnil : source); - bds_bind(@'*load-truename*', not_a_filename? Cnil : cl_truename(filename)); + ecl_bds_bind(the_env, @'*package*', ecl_symbol_value(@'*package*')); + ecl_bds_bind(the_env, @'*readtable*', ecl_symbol_value(@'*readtable*')); + ecl_bds_bind(the_env, @'*load-pathname*', not_a_filename? Cnil : source); + ecl_bds_bind(the_env, @'*load-truename*', not_a_filename? Cnil : cl_truename(filename)); if (!Null(function)) { ok = funcall(4, function, filename, verbose, print); } else { @@ -549,7 +550,7 @@ NOT_A_FILENAME: #endif ok = si_load_source(filename, verbose, print); } - bds_unwind_n(4); + ecl_bds_unwind_n(the_env, 4); if (!Null(ok)) FEerror("LOAD: Could not load file ~S (Error: ~S)", 2, filename, ok); diff --git a/src/c/main.d b/src/c/main.d index 5d864270c..f49666831 100644 --- a/src/c/main.d +++ b/src/c/main.d @@ -227,8 +227,9 @@ _ecl_alloc_env() int cl_shutdown(void) { + const cl_env_ptr env = ecl_process_env(); if (ecl_get_option(ECL_OPT_BOOTED) > 0) { - cl_object l = SYM_VAL(@'si::*exit-hooks*'); + cl_object l = ecl_symbol_value(@'si::*exit-hooks*'); cl_object form = cl_list(2, @'funcall', Cnil); while (CONSP(l)) { ecl_elt_set(form, 1, ECL_CONS_CAR(l)); @@ -642,6 +643,7 @@ si_getenv(cl_object var) cl_object si_setenv(cl_object var, cl_object value) { + const cl_env_ptr the_env = ecl_process_env(); cl_fixnum ret_val; var = ecl_check_cl_type(@'ext::setenv', var, t_base_string); @@ -682,6 +684,7 @@ si_setenv(cl_object var, cl_object value) cl_object si_pointer(cl_object x) { + const cl_env_ptr the_env = ecl_process_env(); @(return ecl_make_unsigned_integer((cl_index)x)) } diff --git a/src/c/package.d b/src/c/package.d index 3e214c7fe..1f0e6b231 100644 --- a/src/c/package.d +++ b/src/c/package.d @@ -279,7 +279,7 @@ ecl_find_package_nolock(cl_object name) /* Note that this function may actually be called _before_ symbols are set up * and bound! */ if (ecl_get_option(ECL_OPT_BOOTED) && - SYM_VAL(@'si::*relative-package-names*') != Cnil) { + ECL_SYM_VAL(ecl_process_env(), @'si::*relative-package-names*') != Cnil) { return si_find_relative_package(1, name); } #endif @@ -301,15 +301,14 @@ si_coerce_to_package(cl_object p) cl_object ecl_current_package(void) { - cl_object x; - - x = ecl_symbol_value(@'*package*'); + cl_object x = ecl_symbol_value(@'*package*'); if (type_of(x) != t_package) { - ECL_SETQ(@'*package*', cl_core.user_package); + const cl_env_ptr env = ecl_process_env(); + ECL_SETQ(env, @'*package*', cl_core.user_package); FEerror("The value of *PACKAGE*, ~S, was not a package", 1, x); } - return(x); + return x; } /* @@ -782,8 +781,9 @@ ecl_unuse_package(cl_object x, cl_object p) cl_object si_select_package(cl_object pack_name) { + const cl_env_ptr the_env = ecl_process_env(); cl_object p = si_coerce_to_package(pack_name); - @(return (ECL_SETQ(@'*package*', p))) + @(return (ECL_SETQ(the_env, @'*package*', p))) } cl_object diff --git a/src/c/print.d b/src/c/print.d index 5c61b4fd3..913c254f2 100644 --- a/src/c/print.d +++ b/src/c/print.d @@ -284,9 +284,9 @@ static cl_object stream_or_default_output(cl_object stream) { if (Null(stream)) - return SYM_VAL(@'*standard-output*'); + return ECL_SYM_VAL(ecl_process_env(),@'*standard-output*'); else if (stream == Ct) - return SYM_VAL(@'*terminal-io*'); + return ECL_SYM_VAL(ecl_process_env(),@'*terminal-io*'); return stream; } @@ -296,7 +296,7 @@ ecl_print_base(void) cl_object object = ecl_symbol_value(@'*print-base*'); cl_fixnum base; if (!FIXNUMP(object) || (base = fix(object)) < 2 || base > 36) { - ECL_SETQ(@'*print-base*', MAKE_FIXNUM(10)); + ECL_SETQ(ecl_process_env(), @'*print-base*', MAKE_FIXNUM(10)); FEerror("~S is an illegal PRINT-BASE.", 1, object); } return base; @@ -312,7 +312,7 @@ ecl_print_level(void) } else if (FIXNUMP(object)) { level = fix(object); if (level < 0) { - ERROR: ECL_SETQ(@'*print-level*', Cnil); + ERROR: ECL_SETQ(ecl_process_env(), @'*print-level*', Cnil); FEerror("~S is an illegal PRINT-LEVEL.", 1, object); } } else if (type_of(object) != t_bignum) { @@ -333,7 +333,7 @@ ecl_print_length(void) } else if (FIXNUMP(object)) { length = fix(object); if (length < 0) { - ERROR: ECL_SETQ(@'*print-length*', Cnil); + ERROR: ECL_SETQ(ecl_process_env(), @'*print-length*', Cnil); FEerror("~S is an illegal PRINT-LENGTH.", 1, object); } } else if (type_of(object) != t_bignum) { @@ -356,7 +356,7 @@ ecl_print_case(void) cl_object output = ecl_symbol_value(@'*print-case*'); if (output != @':upcase' && output != @':downcase' && output != @':capitalize') { - ECL_SETQ(@'*print-case*', @':downcase'); + ECL_SETQ(ecl_process_env(), @'*print-case*', @':downcase'); FEerror("~S is an illegal PRINT-CASE.", 1, output); } return output; @@ -901,6 +901,7 @@ write_character(int i, cl_object stream) static void write_array(bool vector, cl_object x, cl_object stream) { + cl_env_ptr env = ecl_process_env(); const cl_index *adims; cl_index subscripts[ARANKLIM]; cl_fixnum n, j, m, k, i; @@ -955,7 +956,7 @@ write_array(bool vector, cl_object x, cl_object stream) if (print_level >= n) { /* We can write the elements of the array */ print_level -= n; - bds_bind(@'*print-level*', MAKE_FIXNUM(print_level)); + ecl_bds_bind(env, @'*print-level*', MAKE_FIXNUM(print_level)); } else { /* The elements of the array are not printed */ n = print_level; @@ -1012,7 +1013,7 @@ write_array(bool vector, cl_object x, cl_object stream) m += k; } if (print_level >= 0) { - bds_unwind1(); + ecl_bds_unwind1(env); } if (readably) { write_ch(')', stream); @@ -1079,16 +1080,18 @@ si_write_ugly_object(cl_object x, cl_object stream) write_ch('.', stream); break; } - case t_ratio: + case t_ratio: { + const cl_env_ptr env = ecl_process_env(); if (ecl_print_radix()) { write_base(ecl_print_base(), stream); } - bds_bind(@'*print-radix*', Cnil); + ecl_bds_bind(env, @'*print-radix*', Cnil); si_write_ugly_object(x->ratio.num, stream); write_ch('/', stream); si_write_ugly_object(x->ratio.den, stream); - bds_unwind1(); + ecl_bds_unwind1(env); break; + } #ifdef ECL_SHORT_FLOAT case t_shortfloat: r = ecl_symbol_value(@'*read-default-float-format*'); @@ -1193,6 +1196,7 @@ si_write_ugly_object(cl_object x, cl_object stream) break; case t_list: { + const cl_env_ptr env = ecl_process_env(); bool circle; cl_fixnum print_level, print_length; if (Null(x)) { @@ -1249,7 +1253,7 @@ si_write_ugly_object(cl_object x, cl_object stream) write_ch('#', stream); break; } - bds_bind(@'*print-level*', MAKE_FIXNUM(print_level-1)); + ecl_bds_bind(env, @'*print-level*', MAKE_FIXNUM(print_level-1)); WRITE_MARK(stream); write_ch('(', stream); WRITE_SET_INDENT(stream); @@ -1286,7 +1290,7 @@ si_write_ugly_object(cl_object x, cl_object stream) RIGHT_PAREN: write_ch(')', stream); WRITE_UNMARK(stream); - bds_unwind1(); + ecl_bds_unwind1(env); break; #if !defined(ECL_CMU_FORMAT) PRETTY_PRINT_FORMAT: @@ -1636,18 +1640,19 @@ si_write_object_recursive(cl_object x, cl_object stream) bool print; circle_counter = ecl_symbol_value(@'si::*circle-counter*'); if (circle_counter == Cnil) { + cl_env_ptr env = ecl_process_env(); cl_object hash = cl__make_hash_table(@'eq', MAKE_FIXNUM(1024), ecl_make_singlefloat(1.5f), ecl_make_singlefloat(0.75f), Cnil); - bds_bind(@'si::*circle-counter*', Ct); - bds_bind(@'si::*circle-stack*', hash); + ecl_bds_bind(env, @'si::*circle-counter*', Ct); + ecl_bds_bind(env, @'si::*circle-stack*', hash); si_write_object(x, cl_core.null_stream); - ECL_SETQ(@'si::*circle-counter*', MAKE_FIXNUM(0)); + ECL_SETQ(env, @'si::*circle-counter*', MAKE_FIXNUM(0)); si_write_object(x, stream); cl_clrhash(hash); - bds_unwind_n(2); + ecl_bds_unwind_n(env, 2); return x; } code = search_print_circle(x); @@ -1747,7 +1752,8 @@ search_print_circle(cl_object x) cl_fixnum new_code = fix(circle_counter) + 1; circle_counter = MAKE_FIXNUM(new_code); ecl_sethash(x, circle_stack, circle_counter); - ECL_SETQ(@'si::*circle-counter*', circle_counter); + ECL_SETQ(ecl_process_env(), @'si::*circle-counter*', + circle_counter); return -new_code; } else { return fix(code); @@ -1817,27 +1823,27 @@ potential_number_p(cl_object strng, int base) (readably ecl_symbol_value(@'*print-readably*')) (right_margin ecl_symbol_value(@'*print-right-margin*'))) @{ - bds_bind(@'*print-array*', array); - bds_bind(@'*print-base*', base); - bds_bind(@'*print-case*', cas); - bds_bind(@'*print-circle*', circle); - bds_bind(@'*print-escape*', escape); - bds_bind(@'*print-gensym*', gensym); - bds_bind(@'*print-level*', level); - bds_bind(@'*print-length*', length); - bds_bind(@'*print-lines*', lines); - bds_bind(@'*print-miser-width*', miser_width); - bds_bind(@'*print-pprint-dispatch*', pprint_dispatch); - bds_bind(@'*print-pretty*', pretty); - bds_bind(@'*print-radix*', radix); - bds_bind(@'*print-readably*', readably); - bds_bind(@'*print-right-margin*', right_margin); + ecl_bds_bind(the_env, @'*print-array*', array); + ecl_bds_bind(the_env, @'*print-base*', base); + ecl_bds_bind(the_env, @'*print-case*', cas); + ecl_bds_bind(the_env, @'*print-circle*', circle); + ecl_bds_bind(the_env, @'*print-escape*', escape); + ecl_bds_bind(the_env, @'*print-gensym*', gensym); + ecl_bds_bind(the_env, @'*print-level*', level); + ecl_bds_bind(the_env, @'*print-length*', length); + ecl_bds_bind(the_env, @'*print-lines*', lines); + ecl_bds_bind(the_env, @'*print-miser-width*', miser_width); + ecl_bds_bind(the_env, @'*print-pprint-dispatch*', pprint_dispatch); + ecl_bds_bind(the_env, @'*print-pretty*', pretty); + ecl_bds_bind(the_env, @'*print-radix*', radix); + ecl_bds_bind(the_env, @'*print-readably*', readably); + ecl_bds_bind(the_env, @'*print-right-margin*', right_margin); strm = stream_or_default_output(strm); si_write_object(x, strm); ecl_force_output(strm); - bds_unwind_n(15); + ecl_bds_unwind_n(the_env, 15); @(return x) @) @@ -1856,12 +1862,12 @@ potential_number_p(cl_object strng, int base) @(defun pprint (obj &optional strm) @ strm = stream_or_default_output(strm); - bds_bind(@'*print-escape*', Ct); - bds_bind(@'*print-pretty*', Ct); + ecl_bds_bind(the_env, @'*print-escape*', Ct); + ecl_bds_bind(the_env, @'*print-pretty*', Ct); ecl_write_char('\n', strm); si_write_object(obj, strm); ecl_force_output(strm); - bds_unwind_n(2); + ecl_bds_unwind_n(the_env, 2); @(return) @) @@ -1969,22 +1975,24 @@ cl_write_byte(cl_object integer, cl_object binary_output_stream) cl_object ecl_princ(cl_object obj, cl_object strm) { + const cl_env_ptr the_env = ecl_process_env(); strm = stream_or_default_output(strm); - bds_bind(@'*print-escape*', Cnil); - bds_bind(@'*print-readably*', Cnil); + ecl_bds_bind(the_env, @'*print-escape*', Cnil); + ecl_bds_bind(the_env, @'*print-readably*', Cnil); si_write_object(obj, strm); - bds_unwind_n(2); + ecl_bds_unwind_n(the_env, 2); return obj; } cl_object ecl_prin1(cl_object obj, cl_object strm) { + const cl_env_ptr the_env = ecl_process_env(); strm = stream_or_default_output(strm); - bds_bind(@'*print-escape*', Ct); + ecl_bds_bind(the_env, @'*print-escape*', Ct); si_write_object(obj, strm); ecl_force_output(strm); - bds_unwind1(); + ecl_bds_unwind1(the_env); return obj; } diff --git a/src/c/read.d b/src/c/read.d index 8d9eba63d..cbadaebff 100644 --- a/src/c/read.d +++ b/src/c/read.d @@ -33,7 +33,7 @@ #undef _complex #define cat(rtbl,c) ((rtbl)->readtable.table[c].syntax_type) -#define read_suppress (SYM_VAL(@'*read-suppress*') != Cnil) +#define read_suppress (ecl_symbol_value(@'*read-suppress*') != Cnil) static struct ecl_readtable_entry* read_table_entry(cl_object rdtbl, cl_object c); @@ -87,14 +87,14 @@ cl_object ecl_read_object_non_recursive(cl_object in) { cl_object x; + const cl_env_ptr env = ecl_process_env(); - bds_bind(@'si::*sharp-eq-context*', Cnil); - bds_bind(@'si::*backq-level*', MAKE_FIXNUM(0)); + ecl_bds_bind(env, @'si::*sharp-eq-context*', Cnil); + ecl_bds_bind(env, @'si::*backq-level*', MAKE_FIXNUM(0)); x = ecl_read_object(in); - if (!Null(SYM_VAL(@'si::*sharp-eq-context*'))) + if (!Null(ECL_SYM_VAL(env, @'si::*sharp-eq-context*'))) x = patch_sharp(x); - bds_unwind1(); - bds_unwind1(); + ecl_bds_unwind_n(env, 2); return(x); } @@ -580,7 +580,8 @@ static cl_object comma_reader(cl_object in, cl_object c) { cl_object x, y; - cl_fixnum backq_level = fix(SYM_VAL(@'si::*backq-level*')); + const cl_env_ptr env = ecl_process_env(); + cl_fixnum backq_level = fix(ECL_SYM_VAL(env, @'si::*backq-level*')); if (backq_level <= 0) FEreader_error("A comma has appeared out of a backquote.", in, 0); @@ -595,19 +596,20 @@ cl_object comma_reader(cl_object in, cl_object c) } else { x = @'si::unquote'; } - ECL_SETQ(@'si::*backq-level*', MAKE_FIXNUM(backq_level-1)); + ECL_SETQ(env, @'si::*backq-level*', MAKE_FIXNUM(backq_level-1)); y = ecl_read_object(in); - ECL_SETQ(@'si::*backq-level*', MAKE_FIXNUM(backq_level)); + ECL_SETQ(env, @'si::*backq-level*', MAKE_FIXNUM(backq_level)); return cl_list(2, x, y); } static cl_object backquote_reader(cl_object in, cl_object c) { - cl_fixnum backq_level = fix(SYM_VAL(@'si::*backq-level*')); - ECL_SETQ(@'si::*backq-level*', MAKE_FIXNUM(backq_level+1)); + const cl_env_ptr the_env = ecl_process_env(); + cl_fixnum backq_level = fix(ECL_SYM_VAL(the_env, @'si::*backq-level*')); + ECL_SETQ(the_env, @'si::*backq-level*', MAKE_FIXNUM(backq_level+1)); in = ecl_read_object(in); - ECL_SETQ(@'si::*backq-level*', MAKE_FIXNUM(backq_level)); + ECL_SETQ(the_env, @'si::*backq-level*', MAKE_FIXNUM(backq_level)); #if 0 @(return cl_macroexpand_1(2, cl_list(2, @'si::quasiquote', in), Cnil)); #else @@ -732,6 +734,7 @@ semicolon_reader(cl_object in, cl_object c) static cl_object sharp_C_reader(cl_object in, cl_object c, cl_object d) { + const cl_env_ptr the_env = ecl_process_env(); cl_object x, real, imag; if (d != Cnil && !read_suppress) @@ -750,7 +753,7 @@ sharp_C_reader(cl_object in, cl_object c, cl_object d) structures, we cannot check the types of the elements, and we must build the complex number by hand. */ if ((CONSP(real) || CONSP(imag)) && - !Null(SYM_VAL(@'si::*sharp-eq-context*'))) + !Null(ECL_SYM_VAL(the_env, @'si::*sharp-eq-context*'))) { x = ecl_alloc_object(t_complex); x->complex.real = real; @@ -764,15 +767,16 @@ sharp_C_reader(cl_object in, cl_object c, cl_object d) static cl_object sharp_backslash_reader(cl_object in, cl_object c, cl_object d) { + const cl_env_ptr env = ecl_process_env(); cl_object nc, token; if (d != Cnil && !read_suppress) if (!FIXNUMP(d) || fix(d) != 0) FEreader_error("~S is an illegal CHAR-FONT.", in, 1, d); /* assuming that CHAR-FONT-LIMIT is 1 */ - bds_bind(@'*readtable*', cl_core.standard_readtable); + ecl_bds_bind(env, @'*readtable*', cl_core.standard_readtable); token = ecl_read_object_with_delimiter(in, EOF, 1, cat_single_escape); - bds_unwind_n(1); + ecl_bds_unwind1(env); if (token == Cnil) { c = Cnil; } else if (token->base_string.fillp == 1) { @@ -871,8 +875,9 @@ static cl_object sharp_left_parenthesis_reader(cl_object in, cl_object c, cl_object d) { extern int _cl_backq_car(cl_object *); + const cl_env_ptr the_env = ecl_process_env(); cl_object v; - if (fix(SYM_VAL(@'si::*backq-level*')) > 0) { + if (fix(ECL_SYM_VAL(the_env, @'si::*backq-level*')) > 0) { /* First case: ther might be unquoted elements in the vector. * Then we just create a form that generates the vector. */ @@ -1123,8 +1128,9 @@ sharp_R_reader(cl_object in, cl_object c, cl_object d) static cl_object sharp_eq_reader(cl_object in, cl_object c, cl_object d) { + const cl_env_ptr the_env = ecl_process_env(); cl_object pair, value; - cl_object sharp_eq_context = SYM_VAL(@'si::*sharp-eq-context*'); + cl_object sharp_eq_context = ECL_SYM_VAL(the_env, @'si::*sharp-eq-context*'); if (read_suppress) @(return) if (Null(d)) @@ -1132,7 +1138,7 @@ sharp_eq_reader(cl_object in, cl_object c, cl_object d) if (ecl_assql(d, sharp_eq_context) != Cnil) FEreader_error("Duplicate definitions for #~D=.", in, 1, d); pair = ecl_list1(d); - ECL_SETQ(@'si::*sharp-eq-context*', CONS(pair, sharp_eq_context)); + ECL_SETQ(the_env, @'si::*sharp-eq-context*', CONS(pair, sharp_eq_context)); value = ecl_read_object(in); if (value == pair) FEreader_error("#~D# is defined by itself.", in, 1, d); @@ -1143,12 +1149,13 @@ sharp_eq_reader(cl_object in, cl_object c, cl_object d) static cl_object sharp_sharp_reader(cl_object in, cl_object c, cl_object d) { + const cl_env_ptr the_env = ecl_process_env(); cl_object pair; if (read_suppress) @(return Cnil) if (Null(d)) FEreader_error("The ## readmacro requires an argument.", in, 0); - pair = ecl_assq(d, SYM_VAL(@'si::*sharp-eq-context*')); + pair = ecl_assq(d, ECL_SYM_VAL(the_env, @'si::*sharp-eq-context*')); if (pair != Cnil) @(return pair) FEreader_error("#~D# is undefined.", in, 1, d); @@ -1208,7 +1215,9 @@ do_patch_sharp(cl_object x) static cl_object patch_sharp(cl_object x) { - cl_object pairs, sharp_eq_context = SYM_VAL(@'si::*sharp-eq-context*'); + const cl_env_ptr the_env = ecl_process_env(); + cl_object sharp_eq_context = ECL_SYM_VAL(the_env, @'si::*sharp-eq-context*'); + cl_object pairs; pairs = sharp_eq_context; loop_for_in(pairs) { @@ -1349,41 +1358,45 @@ ecl_copy_readtable(cl_object from, cl_object to) cl_object ecl_current_readtable(void) { + const cl_env_ptr the_env = ecl_process_env(); cl_object r; /* INV: *readtable* always has a value */ - r = SYM_VAL(@'*readtable*'); + r = ECL_SYM_VAL(the_env, @'*readtable*'); if (type_of(r) != t_readtable) { - ECL_SETQ(@'*readtable*', ecl_copy_readtable(cl_core.standard_readtable, Cnil)); + ECL_SETQ(the_env, @'*readtable*', + ecl_copy_readtable(cl_core.standard_readtable, Cnil)); FEerror("The value of *READTABLE*, ~S, was not a readtable.", 1, r); } - return(r); + return r; } int ecl_current_read_base(void) { + const cl_env_ptr the_env = ecl_process_env(); cl_object x; /* INV: *READ-BASE* always has a value */ - x = SYM_VAL(@'*read_base*'); + x = ECL_SYM_VAL(the_env, @'*read_base*'); if (FIXNUMP(x)) { cl_fixnum b = fix(x); if (b >= 2 && b <= 36) return b; } - ECL_SETQ(@'*read_base*', MAKE_FIXNUM(10)); + ECL_SETQ(the_env, @'*read_base*', MAKE_FIXNUM(10)); FEerror("The value of *READ-BASE*, ~S, was illegal.", 1, x); } char ecl_current_read_default_float_format(void) { + const cl_env_ptr the_env = ecl_process_env(); cl_object x; /* INV: *READ-DEFAULT-FLOAT-FORMAT* is always bound to something */ - x = SYM_VAL(@'*read-default-float-format*'); + x = ECL_SYM_VAL(the_env, @'*read-default-float-format*'); if (x == @'single-float' || x == @'short-float') return 'F'; if (x == @'double-float') @@ -1395,7 +1408,7 @@ ecl_current_read_default_float_format(void) return 'D'; #endif } - ECL_SETQ(@'*read-default-float-format*', @'single-float'); + ECL_SETQ(the_env, @'*read-default-float-format*', @'single-float'); FEerror("The value of *READ-DEFAULT-FLOAT-FORMAT*, ~S, was illegal.", 1, x); } @@ -1403,10 +1416,11 @@ ecl_current_read_default_float_format(void) static cl_object stream_or_default_input(cl_object stream) { + const cl_env_ptr the_env = ecl_process_env(); if (Null(stream)) - return SYM_VAL(@'*standard-input*'); + return ECL_SYM_VAL(the_env, @'*standard-input*'); if (stream == Ct) - return SYM_VAL(@'*terminal-io*'); + return ECL_SYM_VAL(the_env, @'*terminal-io*'); return stream; } @@ -1507,13 +1521,12 @@ do_read_delimited_list(int d, cl_object in, bool proper_list) if (Null(recursivep)) { l = do_read_delimited_list(delimiter, strm, 1); } else { - bds_bind(@'si::*sharp-eq-context*', Cnil); - bds_bind(@'si::*backq-level*', MAKE_FIXNUM(0)); + ecl_bds_bind(the_env, @'si::*sharp-eq-context*', Cnil); + ecl_bds_bind(the_env, @'si::*backq-level*', MAKE_FIXNUM(0)); l = do_read_delimited_list(delimiter, strm, 1); - if (!Null(SYM_VAL(@'si::*sharp-eq-context*'))) + if (!Null(ECL_SYM_VAL(the_env, @'si::*sharp-eq-context*'))) l = patch_sharp(l); - bds_unwind1(); - bds_unwind1(); + ecl_bds_unwind_n(the_env, 2); } @(return l) @) @@ -2073,6 +2086,7 @@ init_read(void) cl_object read_VV(cl_object block, void (*entry_point)(cl_object)) { + const cl_env_ptr env = ecl_process_env(); volatile cl_object old_eptbc = cl_core.packages_to_be_created; volatile cl_object x; cl_index i, len, perm_len, temp_len; @@ -2087,7 +2101,7 @@ read_VV(cl_object block, void (*entry_point)(cl_object)) in = OBJNULL; CL_UNWIND_PROTECT_BEGIN { - bds_bind(@'si::*cblock*', block); + ecl_bds_bind(env, @'si::*cblock*', block); if (cl_core.packages_to_be_created == OBJNULL) cl_core.packages_to_be_created = Cnil; @@ -2113,12 +2127,12 @@ read_VV(cl_object block, void (*entry_point)(cl_object)) /* Read all data for the library */ in=ecl_make_string_input_stream(make_constant_base_string(block->cblock.data_text), 0, block->cblock.data_text_size); - bds_bind(@'*read-base*', MAKE_FIXNUM(10)); - bds_bind(@'*read-default-float-format*', @'single-float'); - bds_bind(@'*read-suppress*', Cnil); - bds_bind(@'*readtable*', cl_core.standard_readtable); - bds_bind(@'*package*', cl_core.lisp_package); - bds_bind(@'si::*sharp-eq-context*', Cnil); + ecl_bds_bind(env, @'*read-base*', MAKE_FIXNUM(10)); + ecl_bds_bind(env, @'*read-default-float-format*', @'single-float'); + ecl_bds_bind(env, @'*read-suppress*', Cnil); + ecl_bds_bind(env, @'*readtable*', cl_core.standard_readtable); + ecl_bds_bind(env, @'*package*', cl_core.lisp_package); + ecl_bds_bind(env, @'si::*sharp-eq-context*', Cnil); for (i = 0 ; i < len; i++) { x = ecl_read_object(in); if (x == OBJNULL) @@ -2128,7 +2142,7 @@ read_VV(cl_object block, void (*entry_point)(cl_object)) else VVtemp[i-perm_len] = x; } - if (!Null(SYM_VAL(@'si::*sharp-eq-context*'))) { + if (!Null(ECL_SYM_VAL(env, @'si::*sharp-eq-context*'))) { while (i--) { if (i < perm_len) { VV[i] = patch_sharp(VV[i]); @@ -2137,7 +2151,7 @@ read_VV(cl_object block, void (*entry_point)(cl_object)) } } } - bds_unwind_n(6); + ecl_bds_unwind_n(env, 6); if (i < len) FEreader_error("Not enough data while loading binary file", in, 0); NO_DATA_LABEL: @@ -2166,7 +2180,7 @@ read_VV(cl_object block, void (*entry_point)(cl_object)) block->cblock.temp_data_size = 0; ecl_dealloc(VVtemp); } - bds_unwind1(); + ecl_bds_unwind1(env); } CL_UNWIND_PROTECT_EXIT { if (in != OBJNULL) cl_close(1,in); diff --git a/src/c/reference.d b/src/c/reference.d index e00c5dbb4..0188de1ca 100644 --- a/src/c/reference.d +++ b/src/c/reference.d @@ -126,14 +126,16 @@ si_coerce_to_function(cl_object fun) cl_object cl_symbol_value(cl_object sym) { + const cl_env_ptr the_env = ecl_process_env(); cl_object value; if (Null(sym)) { value = sym; } else { + const cl_env_ptr env = ecl_process_env(); if (!SYMBOLP(sym)) { FEtype_error_symbol(sym); } - value = SYM_VAL(sym); + value = ECL_SYM_VAL(the_env, sym); if (value == OBJNULL) FEunbound_variable(sym); } @@ -143,13 +145,14 @@ cl_symbol_value(cl_object sym) cl_object cl_boundp(cl_object sym) { + const cl_env_ptr the_env = ecl_process_env(); cl_object output; if (Null(sym)) { output = Ct; } else { if (!SYMBOLP(sym)) FEtype_error_symbol(sym); - if (SYM_VAL(sym) == OBJNULL) + if (ECL_SYM_VAL(the_env, sym) == OBJNULL) output = Cnil; else output = Ct; @@ -160,6 +163,7 @@ cl_boundp(cl_object sym) cl_object cl_special_operator_p(cl_object form) { + const cl_env_ptr the_env = ecl_process_env(); int special = ecl_symbol_type(form) & stp_special_form; @(return (special? Ct : Cnil)) } diff --git a/src/c/stacks.d b/src/c/stacks.d index 614e0fba4..5ad40cb71 100644 --- a/src/c/stacks.d +++ b/src/c/stacks.d @@ -76,13 +76,12 @@ ecl_cs_overflow(void) #ifdef ECL_THREADS void -bds_bind(cl_object s, cl_object value) +ecl_bds_bind(cl_env_ptr env, cl_object s, cl_object value) { - cl_env_ptr env = ecl_process_env(); struct ecl_hashtable_entry *h = ecl_search_hash(s, env->bindings_hash); struct bds_bd *slot = ++env->bds_top; if (slot >= env->bds_limit) { - bds_overflow(); + ecl_bds_overflow(); slot = env->bds_top; } if (h->key == OBJNULL) { @@ -100,13 +99,12 @@ bds_bind(cl_object s, cl_object value) } void -bds_push(cl_object s) +ecl_bds_push(cl_env_ptr env, cl_object s) { - cl_env_ptr env = ecl_process_env(); struct ecl_hashtable_entry *h = ecl_search_hash(s, env->bindings_hash); struct bds_bd *slot = ++env->bds_top; if (slot >= env->bds_limit) { - bds_overflow(); + ecl_bds_overflow(); slot = env->bds_top; } if (h->key == OBJNULL) { @@ -123,9 +121,8 @@ bds_push(cl_object s) } void -bds_unwind1(void) +ecl_bds_unwind1(cl_env_ptr env) { - cl_env_ptr env = ecl_process_env(); struct bds_bd *slot = env->bds_top--; cl_object s = slot->symbol; struct ecl_hashtable_entry *h = ecl_search_hash(s, env->bindings_hash); @@ -141,12 +138,11 @@ bds_unwind1(void) } cl_object * -ecl_symbol_slot(cl_object s) +ecl_symbol_slot(cl_env_ptr env, cl_object s) { if (Null(s)) s = Cnil_symbol; if (s->symbol.dynamic) { - cl_env_ptr env = ecl_process_env(); struct ecl_hashtable_entry *h = ecl_search_hash(s, env->bindings_hash); if (h->key != OBJNULL) return &h->value; @@ -155,10 +151,9 @@ ecl_symbol_slot(cl_object s) } cl_object -ecl_set_symbol(cl_object s, cl_object value) +ecl_set_symbol(cl_env_ptr env, cl_object s, cl_object value) { if (s->symbol.dynamic) { - cl_env_ptr env = ecl_process_env(); struct ecl_hashtable_entry *h = ecl_search_hash(s, env->bindings_hash); if (h->key != OBJNULL) { return (h->value = value); @@ -169,13 +164,13 @@ ecl_set_symbol(cl_object s, cl_object value) #endif void -bds_unwind_n(int n) +ecl_bds_unwind_n(cl_env_ptr env, int n) { - while (n--) bds_unwind1(); + while (n--) ecl_bds_unwind1(env); } static void -bds_set_size(cl_env_ptr env, cl_index size) +ecl_bds_set_size(cl_env_ptr env, cl_index size) { bds_ptr old_org = env->bds_org; cl_index limit = env->bds_top - old_org; @@ -200,7 +195,7 @@ bds_set_size(cl_env_ptr env, cl_index size) } void -bds_overflow(void) +ecl_bds_overflow(void) { cl_env_ptr env = ecl_process_env(); cl_index margin = ecl_get_option(ECL_OPT_BIND_STACK_SAFETY_AREA); @@ -214,18 +209,17 @@ bds_overflow(void) cl_cerror(6, make_constant_base_string("Extend stack size"), @'ext::stack-overflow', @':size', MAKE_FIXNUM(size), @':type', @'ext::binding-stack'); - bds_set_size(env, size + (size / 2)); + ecl_bds_set_size(env, size + (size / 2)); } void -bds_unwind(cl_index new_bds_top_index) +ecl_bds_unwind(cl_env_ptr env, cl_index new_bds_top_index) { - cl_env_ptr env = ecl_process_env(); bds_ptr new_bds_top = new_bds_top_index + env->bds_org; bds_ptr bds = env->bds_top; for (; bds > new_bds_top; bds--) #ifdef ECL_THREADS - bds_unwind1(); + ecl_bds_unwind1(env); #else bds->symbol->symbol.value = bds->value; #endif @@ -421,7 +415,7 @@ ecl_unwind(ecl_frame_ptr fr) while (env->frs_top != fr && env->frs_top->frs_val != ECL_PROTECT_TAG) --env->frs_top; env->ihs_top = env->frs_top->frs_ihs; - bds_unwind(env->frs_top->frs_bds_top_index); + ecl_bds_unwind(env, env->frs_top->frs_bds_top_index); ecl_stack_set_index(env, env->frs_top->frs_sp); ecl_longjmp(env->frs_top->frs_jmpbuf, 1); /* never reached */ @@ -497,7 +491,7 @@ si_set_stack_size(cl_object type, cl_object size) if (type == @'ext::frame-stack') { frs_set_size(env, the_size); } else if (type == @'ext::binding-stack') { - bds_set_size(env, the_size); + ecl_bds_set_size(env, the_size); } else if (type == @'ext::c-stack') { cs_set_size(env, the_size); } else { diff --git a/src/c/symbol.d b/src/c/symbol.d index dca61b4aa..242becfec 100644 --- a/src/c/symbol.d +++ b/src/c/symbol.d @@ -145,7 +145,8 @@ ecl_symbol_value(cl_object s) return s; } else { /* FIXME: Should we check symbol type? */ - cl_object value = SYM_VAL(s); + const cl_env_ptr the_env = ecl_process_env(); + cl_object value = ECL_SYM_VAL(the_env, s); if (value == OBJNULL) FEunbound_variable(s); return value; @@ -336,7 +337,7 @@ cl_symbol_name(cl_object x) @ { AGAIN: if (ecl_stringp(prefix)) { - counter = SYM_VAL(@'*gensym-counter*'); + counter = ECL_SYM_VAL(the_env, @'*gensym-counter*'); increment = 1; } else if ((t = type_of(prefix)) == t_fixnum || t == t_bignum) { counter = prefix; @@ -348,16 +349,16 @@ cl_symbol_name(cl_object x) goto AGAIN; } output = ecl_make_string_output_stream(64); - bds_bind(@'*print-escape*', Cnil); - bds_bind(@'*print-readably*', Cnil); - bds_bind(@'*print-base*', MAKE_FIXNUM(10)); - bds_bind(@'*print-radix*', Cnil); + ecl_bds_bind(the_env, @'*print-escape*', Cnil); + ecl_bds_bind(the_env, @'*print-readably*', Cnil); + ecl_bds_bind(the_env, @'*print-base*', MAKE_FIXNUM(10)); + ecl_bds_bind(the_env, @'*print-radix*', Cnil); si_write_ugly_object(prefix, output); si_write_ugly_object(counter, output); - bds_unwind_n(4); + ecl_bds_unwind_n(the_env, 4); output = cl_make_symbol(cl_get_output_stream_string(output)); if (increment) - ECL_SETQ(@'*gensym-counter*',ecl_one_plus(counter)); + ECL_SETQ(the_env, @'*gensym-counter*',ecl_one_plus(counter)); @(return output); } @) @@ -369,13 +370,13 @@ cl_symbol_name(cl_object x) pack = si_coerce_to_package(pack); ONCE_MORE: output = ecl_make_string_output_stream(64); - bds_bind(@'*print-escape*', Cnil); - bds_bind(@'*print-readably*', Cnil); - bds_bind(@'*print-base*', MAKE_FIXNUM(10)); - bds_bind(@'*print-radix*', Cnil); + ecl_bds_bind(the_env, @'*print-escape*', Cnil); + ecl_bds_bind(the_env, @'*print-readably*', Cnil); + ecl_bds_bind(the_env, @'*print-base*', MAKE_FIXNUM(10)); + ecl_bds_bind(the_env, @'*print-radix*', Cnil); si_write_ugly_object(prefix, output); si_write_ugly_object(cl_core.gentemp_counter, output); - bds_unwind_n(4); + ecl_bds_unwind_n(the_env, 4); cl_core.gentemp_counter = ecl_one_plus(cl_core.gentemp_counter); s = ecl_intern(cl_get_output_stream_string(output), pack, &intern_flag); if (intern_flag != 0) diff --git a/src/c/threads.d b/src/c/threads.d index 59cae12bb..78f580c1c 100644 --- a/src/c/threads.d +++ b/src/c/threads.d @@ -142,9 +142,9 @@ thread_entry_point(cl_object process) */ process->process.active = 1; CL_CATCH_ALL_BEGIN { - bds_bind(@'mp::*current-process*', process); + ecl_bds_bind(env, @'mp::*current-process*', process); cl_apply(2, process->process.function, process->process.args); - bds_unwind1(); + ecl_bds_unwind1(env); } CL_CATCH_ALL_END; process->process.active = 0; diff --git a/src/c/typespec.d b/src/c/typespec.d index 776c4557d..d1861fc92 100644 --- a/src/c/typespec.d +++ b/src/c/typespec.d @@ -75,7 +75,7 @@ void FEcircular_list(cl_object x) { /* FIXME: Is this the right way to rebind it? */ - bds_bind(@'*print-circle*', Ct); + ecl_bds_bind(ecl_process_env(), @'*print-circle*', Ct); cl_error(9, @'simple-type-error', @':format-control', make_constant_base_string("Circular list ~D"), @':format-arguments', cl_list(1, x), diff --git a/src/c/unixfsys.d b/src/c/unixfsys.d index 46c4e2071..741cd7172 100644 --- a/src/c/unixfsys.d +++ b/src/c/unixfsys.d @@ -861,7 +861,7 @@ dir_recursive(cl_object pathname, cl_object directory) @ cl_object output = cl_parse_namestring(3, current_dir(), Cnil, Cnil); if (!Null(change_d_p_d)) { - ECL_SETQ(@'*default-pathname-defaults*', output); + ECL_SETQ(the_env, @'*default-pathname-defaults*', output); } @(return output) @) @@ -901,7 +901,7 @@ si_get_library_pathname(void) FElibc_error("Can't change the current directory to ~A", 1, namestring); if (change_d_p_d != Cnil) - ECL_SETQ(@'*default-pathname-defaults*', directory); + ECL_SETQ(the_env, @'*default-pathname-defaults*', directory); @(return previous) @) diff --git a/src/c/unixsys.d b/src/c/unixsys.d index 5ba2619e1..7e61c6cdf 100644 --- a/src/c/unixsys.d +++ b/src/c/unixsys.d @@ -130,7 +130,8 @@ si_make_pipe() /* The child inherits a duplicate of our input handle. Creating a duplicate avoids problems when the child closes it */ - int stream_handle = ecl_stream_to_handle(SYM_VAL(@'*standard-input*'), 0); + cl_object input_stream = ecl_symbol_value(@'*standard-input*'); + int stream_handle = ecl_stream_to_handle(input_stream, 0); if (stream_handle >= 0) DuplicateHandle(current, _get_osfhandle(stream_handle) /*GetStdHandle(STD_INPUT_HANDLE)*/, current, &child_stdin, 0, TRUE, @@ -162,7 +163,8 @@ si_make_pipe() /* The child inherits a duplicate of our output handle. Creating a duplicate avoids problems when the child closes it */ - int stream_handle = ecl_stream_to_handle(SYM_VAL(@'*standard-output*'), 1); + cl_object output_stream = ecl_symbol_value(@'*standard-output*'); + int stream_handle = ecl_stream_to_handle(output_stream, 1); if (stream_handle >= 0) DuplicateHandle(current, _get_osfhandle(stream_handle) /*GetStdHandle(STD_OUTPUT_HANDLE)*/, current, &child_stdout, 0, TRUE, @@ -183,7 +185,8 @@ si_make_pipe() /* The child inherits a duplicate of our output handle. Creating a duplicate avoids problems when the child closes it */ - int stream_handle = ecl_stream_to_handle(SYM_VAL(@'*error-output*'), 1); + cl_object error_stream = ecl_symbol_value(@'*error-output*'); + int stream_handle = ecl_stream_to_handle(error_stream, 1); if (stream_handle >= 0) DuplicateHandle(current, _get_osfhandle(stream_handle) /*GetStdHandle(STD_ERROR_HANDLE)*/, current, &child_stderr, 0, TRUE, @@ -274,8 +277,10 @@ si_make_pipe() child_stdin = fd[0]; } else { child_stdin = -1; - if (input == @'t') - child_stdin = ecl_stream_to_handle(SYM_VAL(@'*standard-input*'), 0); + if (input == @'t') { + cl_object input_stream = ecl_symbol_value(@'*standard-input*'); + child_stdin = ecl_stream_to_handle(input_stream, 0); + } if (child_stdin >= 0) child_stdin = dup(child_stdin); else @@ -288,8 +293,10 @@ si_make_pipe() child_stdout = fd[1]; } else { child_stdout = -1; - if (output == @'t') - child_stdout = ecl_stream_to_handle(SYM_VAL(@'*standard-output*'), 1); + if (output == @'t') { + cl_object output_stream = ecl_symbol_value(@'*standard-output*'); + child_stdout = ecl_stream_to_handle(output_stream, 1); + } if (child_stdout >= 0) child_stdout = dup(child_stdout); else @@ -298,7 +305,8 @@ si_make_pipe() if (error == @':output') { child_stderr = child_stdout; } else if (error == @'t') { - child_stderr = ecl_stream_to_handle(SYM_VAL(@'*error-output*'), 1); + cl_object error_stream = ecl_symbol_value(@'*error-output*'); + child_stderr = ecl_stream_to_handle(error_stream, 1); } else { child_stderr = -1; } diff --git a/src/cmp/cmpbind.lsp b/src/cmp/cmpbind.lsp index 00a5d03c4..40dbf6453 100644 --- a/src/cmp/cmpbind.lsp +++ b/src/cmp/cmpbind.lsp @@ -86,9 +86,9 @@ (cond ((and (var-p loc) (member (var-kind loc) '(global special)) (eq (var-name loc) (var-name var))) - (wt-nl "bds_push(" (var-loc var) ");")) + (wt-nl "ecl_bds_push(cl_env_copy," (var-loc var) ");")) (t - (wt-nl "bds_bind(" (var-loc var) ",") + (wt-nl "ecl_bds_bind(cl_env_copy," (var-loc var) ",") (wt-coerce-loc :object loc) (wt ");"))) (push 'BDS-BIND *unwind-exit*) diff --git a/src/cmp/cmpexit.lsp b/src/cmp/cmpexit.lsp index 9e52e2806..a65ef89af 100644 --- a/src/cmp/cmpexit.lsp +++ b/src/cmp/cmpexit.lsp @@ -21,10 +21,12 @@ (wt-nl "ecl_stack_frame_close(" stack-frame ");") (wt-nl "ecl_stack_set_index(cl_env_copy," stack-frame ");"))) (when bds-lcl - (wt-nl "bds_unwind(" bds-lcl ");")) + (wt-nl "ecl_bds_unwind(cl_env_copy," bds-lcl ");")) (if (< bds-bind 4) - (dotimes (n bds-bind) (declare (fixnum n)) (wt-nl "bds_unwind1();")) - (wt-nl "bds_unwind_n(" bds-bind ");")) + (dotimes (n bds-bind) + (declare (fixnum n)) + (wt-nl "ecl_bds_unwind1(cl_env_copy);")) + (wt-nl "ecl_bds_unwind_n(cl_env_copy," bds-bind ");")) (when ihs-p (wt-nl "ihs_pop();"))) diff --git a/src/cmp/cmptop.lsp b/src/cmp/cmptop.lsp index fd7b875f6..0b86c8115 100644 --- a/src/cmp/cmptop.lsp +++ b/src/cmp/cmptop.lsp @@ -345,7 +345,7 @@ " CLSR" *reservation-cmacro* " STCK" *reservation-cmacro*) (wt-nl "cl_object value0;") - (when sp (wt-nl "bds_check;")) + (when sp (wt-nl "ecl_bds_check(cl_env_copy);")) ; (when (compiler-push-events) (wt-nl "ihs_check;")) ) diff --git a/src/cmp/cmpvar.lsp b/src/cmp/cmpvar.lsp index bf39f1000..10ccd3790 100644 --- a/src/cmp/cmpvar.lsp +++ b/src/cmp/cmpvar.lsp @@ -217,7 +217,7 @@ ((SPECIAL GLOBAL) (if (safe-compile) (wt "ecl_symbol_value(" var-loc ")") - (wt "SYM_VAL(" var-loc ")"))) + (wt "ECL_SYM_VAL(cl_env_copy," var-loc ")"))) (t (wt var-loc)) )) @@ -348,8 +348,8 @@ (wt-nl "if(type_of(CAR(" sym-loc "))!=t_symbol)") (wt-nl "FEinvalid_variable(\"~s is not a symbol.\",CAR(" sym-loc "));")) - (wt-nl "if(ecl_endp(" val-loc "))bds_bind(CAR(" sym-loc "),OBJNULL);") - (wt-nl "else{bds_bind(CAR(" sym-loc "),CAR(" val-loc "));") + (wt-nl "if(ecl_endp(" val-loc "))ecl_bds_bind(cl_env_copy,CAR(" sym-loc "),OBJNULL);") + (wt-nl "else{ecl_bds_bind(cl_env_copy,CAR(" sym-loc "),CAR(" val-loc "));") (wt-nl val-loc "=CDR(" val-loc ");}") (wt-nl sym-loc "=CDR(" sym-loc ");}") diff --git a/src/cmp/sysfun.lsp b/src/cmp/sysfun.lsp index f9714fc86..225a0fab1 100644 --- a/src/cmp/sysfun.lsp +++ b/src/cmp/sysfun.lsp @@ -1108,7 +1108,7 @@ type_of(#0)==t_bitvector") (proclaim-function fboundp (symbol) t :predicate t) (proclaim-function symbol-value (symbol) t) (proclaim-function boundp (symbol) t :predicate t :no-side-effects t) -(def-inline boundp :always (symbol) :bool "SYM_VAL(#0)!=OBJNULL") +(def-inline boundp :always (symbol) :bool "ECL_SYM_VAL(cl_env_copy,#0)!=OBJNULL") (proclaim-function macro-function (symbol) t) (proclaim-function special-operator-p (symbol) t :predicate t) diff --git a/src/h/external.h b/src/h/external.h index a8ac66205..24675703c 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -9,7 +9,7 @@ extern "C" { * Per-thread data. */ -typedef struct cl_env_struct { +struct cl_env_struct { /* Flag for disabling interrupts while we call C library functions. */ volatile int disable_interrupts; @@ -116,7 +116,7 @@ typedef struct cl_env_struct { /* Alternative stack for processing signals */ void *altstack; cl_index altstack_size; -} *cl_env_ptr; +}; #ifndef __GNUC__ #define __attribute__(x) @@ -1330,8 +1330,8 @@ extern ECL_API cl_object si_sch_frs_base(cl_object fr, cl_object ihs); extern ECL_API cl_object si_reset_stack_limits(void); extern ECL_API cl_object si_set_stack_size(cl_object type, cl_object size); -extern ECL_API void bds_overflow(void) /*__attribute__((noreturn))*/; -extern ECL_API void bds_unwind(cl_index new_bds_top_index); +extern ECL_API void ecl_bds_overflow(void) /*__attribute__((noreturn))*/; +extern ECL_API void ecl_bds_unwind(cl_env_ptr env, cl_index new_bds_top_index); extern ECL_API void ecl_unwind(ecl_frame_ptr fr) /*__attribute__((noreturn))*/; extern ECL_API ecl_frame_ptr frs_sch(cl_object frame_id); extern ECL_API ecl_frame_ptr frs_sch_catch(cl_object frame_id); @@ -1807,17 +1807,6 @@ extern ECL_API cl_object clos_install_method _ARGS((cl_narg narg, cl_object V1, extern ECL_API cl_object clos_standard_instance_set _ARGS((cl_narg narg, cl_object V1, cl_object V2, cl_object V3, ...)); #endif -/* - * Deprecated names - */ -#define cl_alloc_instance ecl_alloc_instance -#define cl_alloc_object ecl_alloc_object -#define cl_alloc ecl_alloc -#define cl_alloc_atomic ecl_alloc_atomic -#define cl_alloc_align ecl_alloc_align -#define cl_alloc_atomic_align ecl_alloc_atomic_align -#define cl_dealloc ecl_dealloc - #endif #ifdef __cplusplus diff --git a/src/h/stacks.h b/src/h/stacks.h index 5e175b68c..c3c4c1771 100644 --- a/src/h/stacks.h +++ b/src/h/stacks.h @@ -5,6 +5,7 @@ /* Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya. Copyright (c) 1990, Giuseppe Attardi. + Copyright (c) 2000, Juan Jose Garcia-Ripoll ECoLisp is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public @@ -37,39 +38,45 @@ typedef struct bds_bd { cl_object value; /* previous value of the symbol */ } *bds_ptr; -#define bds_check \ - ((cl_env.bds_top >= cl_env.bds_limit)? bds_overflow() : (void)0) +#define ecl_bds_check(env) \ + ((env->bds_top >= env->bds_limit)? ecl_bds_overflow() : (void)0) #ifdef ECL_THREADS -extern ECL_API void bds_bind(cl_object symbol, cl_object value); -extern ECL_API void bds_push(cl_object symbol); -extern ECL_API void bds_unwind1(); -extern ECL_API cl_object *ecl_symbol_slot(cl_object s); -#define SYM_VAL(s) (*ecl_symbol_slot(s)) -#if 0 +typedef struct cl_env_struct *cl_env_ptr; +extern ECL_API void ecl_bds_bind(cl_env_ptr env, cl_object symbol, cl_object v); +extern ECL_API void ecl_bds_push(cl_env_ptr env, cl_object symbol); +extern ECL_API void ecl_bds_unwind1(cl_env_ptr env); +extern ECL_API cl_object *ecl_symbol_slot(cl_env_ptr env, cl_object s); +extern ECL_API cl_object ecl_set_symbol(cl_env_ptr env, cl_object s, cl_object v); +#define ECL_SYM_VAL(env,s) (*ecl_symbol_slot(env,s)) #define ECL_SET(s,v) ((s)->symbol.value=(v)) -#define ECL_SETQ(s,v) (*ecl_symbol_slot(s)=(v)) +#define ECL_SETQ(env,s,v) (ecl_set_symbol(env,s,v)) #else -extern ECL_API cl_object ecl_set_symbol(cl_object s, cl_object v); -#define ECL_SET(s,v) (ecl_set_symbol(s,v)) -#define ECL_SETQ(s,v) (ecl_set_symbol(s,v)) -#endif -#else -#define SYM_VAL(s) ((s)->symbol.value) +#define ECL_SYM_VAL(env,s) ((s)->symbol.value) #define ECL_SET(s,v) ((s)->symbol.value=(v)) -#define ECL_SETQ(s,v) ((s)->symbol.value=(v)) -#define bds_bind(sym, val) \ - (bds_check,(++cl_env.bds_top)->symbol = (sym), \ - cl_env.bds_top->value = SYM_VAL(sym), \ - SYM_VAL(sym) = (val)) - -#define bds_push(sym) \ - (bds_check,(++cl_env.bds_top)->symbol = (sym), cl_env.bds_top->value = SYM_VAL(sym)) - -#define bds_unwind1() \ - (SYM_VAL(cl_env.bds_top->symbol) = cl_env.bds_top->value, --cl_env.bds_top) +#define ECL_SETQ(env,s,v) ((s)->symbol.value=(v)) +#define ecl_bds_bind(env,sym,val) do { \ + const cl_env_ptr env_copy = (env); \ + const cl_object s = (sym); \ + const cl_object v = (val); \ + ecl_bds_check(env_copy); \ + (++(env_copy->bds_top))->symbol = s, \ + env_copy->bds_top->value = s->symbol.value; \ + s->symbol.value = v; } while (0) +#define ecl_bds_push(env,sym) do { \ + const cl_env_ptr env_copy = (env); \ + const cl_object s = (sym); \ + const cl_object v = (val); \ + ecl_bds_check(env_copy); \ + (++(env_copy->bds_top))->symbol = s, \ + env_copy->bds_top->value = s->symbol.value; } while (0); +#define ecl_bds_unwind1(env) do { \ + const cl_env_ptr env_copy = (env); \ + const cl_object s = env_copy->bds_top->symbol; \ + s->symbol.value = env_copy->bds_top->value; \ + --(env_copy->bds_top); } while (0) #endif /* ECL_THREADS */ -extern ECL_API void bds_unwind_n(int n); +extern ECL_API void ecl_bds_unwind_n(cl_env_ptr env, int n); /**************************** * INVOCATION HISTORY STACK From 53e19181691afa415f420da6c852abecf2df1e4e Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sun, 12 Oct 2008 22:12:57 +0200 Subject: [PATCH 27/60] We have to use ECL_SETQ to assign values to bound special variables. --- src/cmp/cmpvar.lsp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cmp/cmpvar.lsp b/src/cmp/cmpvar.lsp index 10ccd3790..661edd8cd 100644 --- a/src/cmp/cmpvar.lsp +++ b/src/cmp/cmpvar.lsp @@ -241,7 +241,7 @@ ((SPECIAL GLOBAL) (if (safe-compile) (wt-nl "cl_set(" var-loc ",") - (wt-nl "ECL_SET(" var-loc ",")) + (wt-nl "ECL_SETQ(cl_env_copy," var-loc ",")) (wt-coerce-loc (var-rep-type var) loc) (wt ");")) (t From 0210ca16d03d9ea21b37eaf82b88e657bbfe3330 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sun, 12 Oct 2008 23:28:13 +0200 Subject: [PATCH 28/60] Removed debugging statement --- src/c/alloc_2.d | 1 - 1 file changed, 1 deletion(-) diff --git a/src/c/alloc_2.d b/src/c/alloc_2.d index 514d52277..0c8df6c58 100644 --- a/src/c/alloc_2.d +++ b/src/c/alloc_2.d @@ -246,7 +246,6 @@ init_alloc(void) GC_time_limit = GC_TIME_UNLIMITED; GC_init(); if (ecl_get_option(ECL_OPT_INCREMENTAL_GC)) { - printf("Enable incremental\n"); GC_enable_incremental(); } GC_register_displacement(1); From 46aa17b1d975595eae1e34a888470d055290782a Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Mon, 13 Oct 2008 22:34:18 +0200 Subject: [PATCH 29/60] frs_push, frs_pop and ecl_unwind tak an environment as arg --- src/c/cmpaux.d | 30 +++++++++++------------ src/c/compiler.d | 4 ++-- src/c/ffi.d | 2 +- src/c/interpreter.d | 17 ++++++------- src/c/load.d | 5 ++-- src/c/print.d | 4 ++-- src/c/read.d | 2 +- src/c/stacks.d | 6 ++--- src/c/threads.d | 5 ++-- src/c/unixfsys.d | 5 ++-- src/c/unixint.d | 6 ++--- src/cmp/cmpblock.lsp | 2 +- src/cmp/cmpcatch.lsp | 14 +++++------ src/cmp/cmpexit.lsp | 4 ++-- src/cmp/cmptag.lsp | 2 +- src/h/external.h | 2 +- src/h/stacks.h | 57 +++++++++++++++++++++++--------------------- 17 files changed, 84 insertions(+), 83 deletions(-) diff --git a/src/c/cmpaux.d b/src/c/cmpaux.d index 377d82218..b0fb022b1 100644 --- a/src/c/cmpaux.d +++ b/src/c/cmpaux.d @@ -169,31 +169,31 @@ ecl_aset_bv(cl_object x, cl_index index, int value) void cl_throw(cl_object tag) { - ecl_frame_ptr fr = frs_sch(tag); - if (fr == NULL) - FEcontrol_error("THROW: The catch ~S is undefined.", 1, tag); - ecl_unwind(fr); + ecl_frame_ptr fr = frs_sch(tag); + if (fr == NULL) + FEcontrol_error("THROW: The catch ~S is undefined.", 1, tag); + ecl_unwind(ecl_process_env(), fr); } void cl_return_from(cl_object block_id, cl_object block_name) { - ecl_frame_ptr fr = frs_sch(block_id); - if (fr == NULL) - FEcontrol_error("RETURN-FROM: The block ~S with id ~S is missing.", - 2, block_name, block_id); - ecl_unwind(fr); + ecl_frame_ptr fr = frs_sch(block_id); + if (fr == NULL) + FEcontrol_error("RETURN-FROM: The block ~S with id ~S is missing.", + 2, block_name, block_id); + ecl_unwind(ecl_process_env(), fr); } void cl_go(cl_object tag_id, cl_object label) { - ecl_frame_ptr fr = frs_sch(tag_id); - if (fr == NULL) - FEcontrol_error("GO: The tagbody ~S is missing.", 1, tag_id); - VALUES(0)=label; - NVALUES=1; - ecl_unwind(fr); + ecl_frame_ptr fr = frs_sch(tag_id); + if (fr == NULL) + FEcontrol_error("GO: The tagbody ~S is missing.", 1, tag_id); + VALUES(0)=label; + NVALUES=1; + ecl_unwind(ecl_process_env(), fr); } cl_object diff --git a/src/c/compiler.d b/src/c/compiler.d index df4d9d482..5ebd6d8da 100644 --- a/src/c/compiler.d +++ b/src/c/compiler.d @@ -2717,7 +2717,7 @@ si_make_lambda(cl_object name, cl_object rest) struct cl_compiler_env new_c_env; c_new_env(&new_c_env, Cnil, 0); - CL_UNWIND_PROTECT_BEGIN { + CL_UNWIND_PROTECT_BEGIN(ecl_process_env()) { lambda = ecl_make_lambda(name,rest); } CL_UNWIND_PROTECT_EXIT { ENV = old_c_env; @@ -2747,7 +2747,7 @@ si_make_lambda(cl_object name, cl_object rest) ENV->lex_env = env; ENV->stepping = stepping != Cnil; handle = asm_begin(); - CL_UNWIND_PROTECT_BEGIN { + CL_UNWIND_PROTECT_BEGIN(ecl_process_env()) { compile_form(form, FLAG_VALUES); asm_op(OP_EXIT); bytecodes = asm_end(handle); diff --git a/src/c/ffi.d b/src/c/ffi.d index bf8ddc66e..9268745c0 100644 --- a/src/c/ffi.d +++ b/src/c/ffi.d @@ -420,7 +420,7 @@ si_load_foreign_module(cl_object filename) #ifdef ECL_THREADS mp_get_lock(1, ecl_symbol_value(@'mp::+load-compile-lock+')); - CL_UNWIND_PROTECT_BEGIN { + CL_UNWIND_PROTECT_BEGIN(ecl_process_env()) { #endif output = ecl_library_open(filename, 0); if (output->cblock.handle == NULL) diff --git a/src/c/interpreter.d b/src/c/interpreter.d index b7076d6c5..554dc43f3 100644 --- a/src/c/interpreter.d +++ b/src/c/interpreter.d @@ -440,9 +440,6 @@ close_around(cl_object fun, cl_object lex) { return v; } -#undef frs_pop -#define frs_pop(the_env) { the_env->frs_top--; } - /* * Manipulation of the interpreter stack. As shown here, we omit may * security checks, assuming that the interpreted code is consistent. @@ -1130,7 +1127,7 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs GET_LABEL(exit, vector); STACK_PUSH(the_env, lex_env); STACK_PUSH(the_env, (cl_object)exit); - if (frs_push(reg1) == 0) { + if (ecl_frs_push(the_env,reg1) == 0) { THREAD_NEXT; } else { reg0 = the_env->values[0]; @@ -1158,7 +1155,7 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs STACK_PUSH(the_env, lex_env); STACK_PUSH(the_env, (cl_object)vector); /* FIXME! */ vector += n * OPARG_SIZE; - if (frs_push(reg1) != 0) { + if (ecl_frs_push(the_env,reg1) != 0) { /* Wait here for gotos. Each goto sets VALUES(0) to an integer which ranges from 0 to ntags-1, depending on the tag. These @@ -1176,7 +1173,7 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs } CASE(OP_EXIT_FRAME); { DO_EXIT_FRAME: - frs_pop(the_env); + ecl_frs_pop(the_env); STACK_POP_N(the_env, 2); lex_env = ECL_CONS_CDR(lex_env); THREAD_NEXT; @@ -1284,8 +1281,8 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs GET_LABEL(exit, vector); STACK_PUSH(the_env, lex_env); STACK_PUSH(the_env, (cl_object)exit); - if (frs_push(ECL_PROTECT_TAG) != 0) { - frs_pop(the_env); + if (ecl_frs_push(the_env,ECL_PROTECT_TAG) != 0) { + ecl_frs_pop(the_env); vector = (cl_opcode *)STACK_POP(the_env); lex_env = STACK_POP(the_env); reg0 = the_env->values[0]; @@ -1296,7 +1293,7 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs } CASE(OP_PROTECT_NORMAL); { ecl_bds_unwind(the_env, the_env->frs_top->frs_bds_top_index); - frs_pop(the_env); + ecl_frs_pop(the_env); STACK_POP(the_env); lex_env = STACK_POP(the_env); STACK_PUSH(the_env, MAKE_FIXNUM(1)); @@ -1309,7 +1306,7 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs reg0 = the_env->values[0]; n = fix(STACK_POP(the_env)); if (n <= 0) - ecl_unwind(the_env->frs_top + n); + ecl_unwind(the_env, the_env->frs_top + n); THREAD_NEXT; } diff --git a/src/c/load.d b/src/c/load.d index 5efc585bd..62c45eda6 100644 --- a/src/c/load.d +++ b/src/c/load.d @@ -343,6 +343,7 @@ ecl_library_close_all(void) cl_object si_load_binary(cl_object filename, cl_object verbose, cl_object print) { + const cl_env_ptr the_env = ecl_process_env(); cl_object block; cl_object basename; cl_object prefix; @@ -363,7 +364,7 @@ si_load_binary(cl_object filename, cl_object verbose, cl_object print) to load the same file, we may end up initializing twice the same module. */ mp_get_lock(1, ecl_symbol_value(@'mp::+load-compile-lock+')); - CL_UNWIND_PROTECT_BEGIN { + CL_UNWIND_PROTECT_BEGIN(the_env) { #endif /* Try to load shared object file */ block = ecl_library_open(filename, 1); @@ -426,7 +427,7 @@ si_load_source(cl_object source, cl_object verbose, cl_object print) if (Null(strm)) @(return Cnil) } - CL_UNWIND_PROTECT_BEGIN { + CL_UNWIND_PROTECT_BEGIN(the_env) { cl_object form_index = MAKE_FIXNUM(0); cl_object location = CONS(source, form_index); ecl_bds_bind(the_env, @'ext::*source-location*', location); diff --git a/src/c/print.d b/src/c/print.d index 913c254f2..8ecce4913 100644 --- a/src/c/print.d +++ b/src/c/print.d @@ -242,7 +242,7 @@ call_structure_print_function(cl_object f, cl_object x, cl_object stream) oiisp = env->iisp; memcpy(ois, env->indent_stack, env->isp * sizeof(*ois)); } - CL_UNWIND_PROTECT_BEGIN { + CL_UNWIND_PROTECT_BEGIN(env) { #ifdef CLOS funcall(3, @'print-object', x, stream); #else @@ -685,7 +685,7 @@ write_bignum(cl_object x, cl_object stream) struct powers powers[num_powers]; #else struct powers *powers = (struct powers*)malloc(sizeof(struct powers)*num_powers); - CL_UNWIND_PROTECT_BEGIN { + CL_UNWIND_PROTECT_BEGIN(ecl_process_env()) { #endif cl_object p; cl_index i, n_digits; diff --git a/src/c/read.d b/src/c/read.d index cbadaebff..8f8e20d57 100644 --- a/src/c/read.d +++ b/src/c/read.d @@ -2100,7 +2100,7 @@ read_VV(cl_object block, void (*entry_point)(cl_object)) block->cblock.entry = entry_point; in = OBJNULL; - CL_UNWIND_PROTECT_BEGIN { + CL_UNWIND_PROTECT_BEGIN(env) { ecl_bds_bind(env, @'si::*cblock*', block); if (cl_core.packages_to_be_created == OBJNULL) cl_core.packages_to_be_created = Cnil; diff --git a/src/c/stacks.d b/src/c/stacks.d index 5ad40cb71..1df60cda1 100644 --- a/src/c/stacks.d +++ b/src/c/stacks.d @@ -392,9 +392,8 @@ frs_overflow(void) /* used as condition in list.d */ } ecl_frame_ptr -_frs_push(register cl_object val) +_ecl_frs_push(register cl_env_ptr env, register cl_object val) { - cl_env_ptr env = ecl_process_env(); ecl_frame_ptr output = ++env->frs_top; if (output >= env->frs_limit) { frs_overflow(); @@ -408,9 +407,8 @@ _frs_push(register cl_object val) } void -ecl_unwind(ecl_frame_ptr fr) +ecl_unwind(cl_env_ptr env, ecl_frame_ptr fr) { - cl_env_ptr env = ecl_process_env(); env->nlj_fr = fr; while (env->frs_top != fr && env->frs_top->frs_val != ECL_PROTECT_TAG) --env->frs_top; diff --git a/src/c/threads.d b/src/c/threads.d index 78f580c1c..8c2b5f0be 100644 --- a/src/c/threads.d +++ b/src/c/threads.d @@ -141,7 +141,7 @@ thread_entry_point(cl_object process) * do an unwind up to frs_top. */ process->process.active = 1; - CL_CATCH_ALL_BEGIN { + CL_CATCH_ALL_BEGIN(env) { ecl_bds_bind(env, @'mp::*current-process*', process); cl_apply(2, process->process.function, process->process.args); ecl_bds_unwind1(env); @@ -339,7 +339,8 @@ mp_exit_process(void) back to the thread entry point, going through all possible UNWIND-PROTECT. */ - ecl_unwind(ecl_process_env()->frs_org); + const cl_env_ptr env = ecl_process_env(); + ecl_unwind(env, env->frs_org); } } diff --git a/src/c/unixfsys.d b/src/c/unixfsys.d index 741cd7172..04be7425e 100644 --- a/src/c/unixfsys.d +++ b/src/c/unixfsys.d @@ -230,6 +230,7 @@ si_readlink(cl_object filename) { cl_object cl_truename(cl_object orig_pathname) { + const cl_env_ptr the_env = ecl_process_env(); cl_object dir; cl_object previous = current_dir(); @@ -244,7 +245,7 @@ cl_truename(cl_object orig_pathname) * then we resolve the value of the symlink and continue traversing * the filesystem. */ - CL_UNWIND_PROTECT_BEGIN { + CL_UNWIND_PROTECT_BEGIN(the_env) { cl_object kind, filename; BEGIN: filename = si_coerce_to_filename(pathname); @@ -845,7 +846,7 @@ dir_recursive(cl_object pathname, cl_object directory) cl_object prev_dir = Cnil; cl_object output; @ - CL_UNWIND_PROTECT_BEGIN { + CL_UNWIND_PROTECT_BEGIN(the_env) { prev_dir = current_dir(); mask = coerce_to_file_pathname(mask); change_drive(mask); diff --git a/src/c/unixint.d b/src/c/unixint.d index 17752f11f..5c1d07d70 100644 --- a/src/c/unixint.d +++ b/src/c/unixint.d @@ -208,7 +208,7 @@ jump_to_sigsegv_handler(cl_env_ptr the_env) ecl_frame_ptr destination = frs_sch(OBJNULL); if (destination) { the_env->nvalues = 0; - ecl_unwind(destination); + ecl_unwind(the_env, destination); } ecl_internal_error("SIGSEGV without handler to jump to."); } @@ -259,7 +259,7 @@ define_handler(lisp_signal_handler, int sig, siginfo_t *info, void *aux) ecl_frame_ptr destination = frs_sch(OBJNULL); if (destination) { the_env->nvalues = 0; - ecl_unwind(destination); + ecl_unwind(the_env, destination); } ecl_internal_error("SIGSEGV without handler to jump to."); } @@ -267,7 +267,7 @@ define_handler(lisp_signal_handler, int sig, siginfo_t *info, void *aux) ecl_frame_ptr destination = frs_sch(OBJNULL); if (destination) { the_env->nvalues = 0; - ecl_unwind(destination); + ecl_unwind(the_env, destination); } ecl_internal_error("SIGSEGV without handler to jump to."); } diff --git a/src/cmp/cmpblock.lsp b/src/cmp/cmpblock.lsp index a9b483994..5960503c4 100644 --- a/src/cmp/cmpblock.lsp +++ b/src/cmp/cmpblock.lsp @@ -60,7 +60,7 @@ (wt-nl *volatile* "cl_object env" (incf *env-lvl*) " = env" env-lvl ";"))) (bind "new_frame_id()" blk-var) - (wt-nl "if (frs_push(" blk-var ")!=0) {") + (wt-nl "if (ecl_frs_push(cl_env_copy," blk-var ")!=0) {") (let ((*unwind-exit* (cons 'FRAME *unwind-exit*))) (unwind-exit 'VALUES) (wt-nl "} else {") diff --git a/src/cmp/cmpcatch.lsp b/src/cmp/cmpcatch.lsp index 27e593a3c..765a960a4 100644 --- a/src/cmp/cmpcatch.lsp +++ b/src/cmp/cmpcatch.lsp @@ -30,18 +30,18 @@ (*unwind-exit* (list* *exit* 'FRAME *unwind-exit*))) (if (member new-destination '(TRASH VALUES)) (progn - (wt-nl "if (frs_push(" 'VALUE0 ")==0) {") + (wt-nl "if (ecl_frs_push(cl_env_copy," 'VALUE0 ")==0) {") (wt-comment "BEGIN CATCH " code nil) (c2expr body) (wt-nl "}")) (progn - (wt-nl "if (frs_push(" 'VALUE0 ")) {") + (wt-nl "if (ecl_frs_push(cl_env_copy," 'VALUE0 ")) {") (wt-comment "BEGIN CATCH " code nil) (unwind-exit 'VALUES t) (wt-nl "}") (c2expr body))) (wt-label *exit*) - (wt-nl "frs_pop();") + (wt-nl "ecl_frs_pop(cl_env_copy);") (wt-comment "END CATCH " code nil) ) (unwind-exit new-destination))) @@ -64,15 +64,15 @@ (wt-nl "cl_index " sp "=ecl_stack_index(cl_env_copy)," nargs ";") (wt-nl "ecl_frame_ptr next_fr;") ;; Here we compile the form which is protected. When this form - ;; is aborted, it continues at the frs_pop() with unwinding=TRUE. - (wt-nl "if (frs_push(ECL_PROTECT_TAG)) {") + ;; is aborted, it continues at the ecl_frs_pop() with unwinding=TRUE. + (wt-nl "if (ecl_frs_push(cl_env_copy,ECL_PROTECT_TAG)) {") (wt-nl " unwinding = TRUE; next_fr=cl_env_copy->nlj_fr;") (wt-nl "} else {") (let ((*unwind-exit* (cons 'FRAME *unwind-exit*)) (*destination* 'VALUES)) (c2expr* form)) (wt-nl "}") - (wt-nl "frs_pop();") + (wt-nl "ecl_frs_pop(cl_env_copy);") ;; Here we save the values of the form which might have been ;; aborted, and execute some cleanup code. This code may also ;; be aborted by some control structure, but is not protected. @@ -82,7 +82,7 @@ (wt-nl "ecl_stack_pop_values(cl_env_copy," nargs ");") ;; Finally, if the protected form was aborted, jump to the ;; next catch point... - (wt-nl "if (unwinding) ecl_unwind(next_fr);") + (wt-nl "if (unwinding) ecl_unwind(cl_env_copy,next_fr);") ;; ... or simply return the values of the protected form. (unwind-exit 'VALUES) (wt "}"))) diff --git a/src/cmp/cmpexit.lsp b/src/cmp/cmpexit.lsp index a65ef89af..ddb73faaf 100644 --- a/src/cmp/cmpexit.lsp +++ b/src/cmp/cmpexit.lsp @@ -118,7 +118,7 @@ (let ((*destination* (tmp-destination *destination*))) (set-loc loc) (setq loc *destination*)) - (wt-nl "frs_pop();")) + (wt-nl "ecl_frs_pop(cl_env_copy);")) (TAIL-RECURSION-MARK) (JUMP (setq jump-p t)) (t (baboon)))))) @@ -145,7 +145,7 @@ (baboon)) ;;; Never reached ) - ((eq ue 'FRAME) (wt-nl "frs_pop();")) + ((eq ue 'FRAME) (wt-nl "ecl_frs_pop(cl_env_copy);")) ((eq ue 'TAIL-RECURSION-MARK) (if (eq exit 'TAIL-RECURSION-MARK) (progn (unwind-bds bds-lcl bds-bind stack-frame ihs-p) diff --git a/src/cmp/cmptag.lsp b/src/cmp/cmptag.lsp index 404389e94..523d88f7e 100644 --- a/src/cmp/cmptag.lsp +++ b/src/cmp/cmptag.lsp @@ -150,7 +150,7 @@ (wt-nl "{ cl_object " tag-loc ";") (setq env-grows t)) ; just to ensure closing the block (bind "new_frame_id()" tag-loc) - (wt-nl "if (frs_push(" tag-loc ")) {") + (wt-nl "if (ecl_frs_push(cl_env_copy," tag-loc ")) {") ;; Allocate labels. (dolist (tag body) (when (and (tag-p tag) (plusp (tag-ref tag))) diff --git a/src/h/external.h b/src/h/external.h index 24675703c..9a711a9c5 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -1332,7 +1332,7 @@ extern ECL_API cl_object si_set_stack_size(cl_object type, cl_object size); extern ECL_API void ecl_bds_overflow(void) /*__attribute__((noreturn))*/; extern ECL_API void ecl_bds_unwind(cl_env_ptr env, cl_index new_bds_top_index); -extern ECL_API void ecl_unwind(ecl_frame_ptr fr) /*__attribute__((noreturn))*/; +extern ECL_API void ecl_unwind(cl_env_ptr env, ecl_frame_ptr fr) /*__attribute__((noreturn))*/; extern ECL_API ecl_frame_ptr frs_sch(cl_object frame_id); extern ECL_API ecl_frame_ptr frs_sch_catch(cl_object frame_id); extern ECL_API cl_object new_frame_id(void); diff --git a/src/h/stacks.h b/src/h/stacks.h index c3c4c1771..4f6c15053 100644 --- a/src/h/stacks.h +++ b/src/h/stacks.h @@ -109,16 +109,16 @@ extern ECL_API cl_object ihs_top_function_name(void); * Frames are established, for instance, by CATCH, BLOCK, TAGBODY, * LAMBDA, UNWIND-PROTECT, etc. * - * Frames are established by frs_push(). For each call to frs_push() - * there must be a corresponding frs_pop(). More precisely, since our + * Frames are established by ecl_frs_push(). For each call to ecl_frs_push() + * there must be a corresponding ecl_frs_pop(). More precisely, since our * frame mechanism relies on the C stack and on the setjmp/longjmp * functions, any function that creates a frame must also destroy it - * with frs_pop() before returning. + * with ecl_frs_pop() before returning. * * Frames are identified by a value frs_val. This can be either a * unique identifier, created for each CATCH, BLOCK, etc, or a common * one ECL_PROTECT_TAG, used by UNWIND-PROTECT forms. The first type - * of frames can be target of a search frs_sch() and thus one can jump + * of frames can be target of a search ecl_frs_sch() and thus one can jump * to them. The second type of frames are like barriers designed to * intercept the jumps to the outer frames and are called * automatically by the function unwind() whenever it jumps to a frame @@ -133,9 +133,9 @@ typedef struct ecl_frame { cl_index frs_sp; } *ecl_frame_ptr; -extern ECL_API ecl_frame_ptr _frs_push(register cl_object val); -#define frs_push(val) ecl_setjmp(_frs_push(val)->frs_jmpbuf) -#define frs_pop() (cl_env.frs_top--) +extern ECL_API ecl_frame_ptr _ecl_frs_push(register cl_env_ptr, register cl_object); +#define ecl_frs_push(env,val) ecl_setjmp(_ecl_frs_push(env,val)->frs_jmpbuf) +#define ecl_frs_pop(env) ((env)->frs_top--) /******************* * ARGUMENTS STACK @@ -209,49 +209,52 @@ extern ECL_API ecl_frame_ptr _frs_push(register cl_object val); *********************************/ #define CL_NEWENV_BEGIN {\ - cl_env_ptr the_env = ecl_process_env(); \ + const cl_env_ptr the_env = ecl_process_env(); \ cl_index __i = ecl_stack_push_values(the_env); \ #define CL_NEWENV_END \ ecl_stack_pop_values(the_env,__i); } -#define CL_UNWIND_PROTECT_BEGIN {\ +#define CL_UNWIND_PROTECT_BEGIN(the_env) do { \ bool __unwinding; ecl_frame_ptr __next_fr; \ - cl_env_ptr the_env = ecl_process_env(); \ + const cl_env_ptr __the_env = (the_env); \ cl_index __nr; \ - if (frs_push(ECL_PROTECT_TAG)) { \ - __unwinding=1; __next_fr=cl_env.nlj_fr; \ + if (ecl_frs_push(__the_env,ECL_PROTECT_TAG)) { \ + __unwinding=1; __next_fr=__the_env->nlj_fr; \ } else { #define CL_UNWIND_PROTECT_EXIT \ __unwinding=0; } \ - frs_pop(); \ - __nr = ecl_stack_push_values(the_env); + ecl_frs_pop(__the_env); \ + __nr = ecl_stack_push_values(__the_env); #define CL_UNWIND_PROTECT_END \ - ecl_stack_pop_values(the_env,__nr); \ - if (__unwinding) ecl_unwind(__next_fr); } + ecl_stack_pop_values(__the_env,__nr); \ + if (__unwinding) ecl_unwind(__the_env,__next_fr); } while(0) -#define CL_BLOCK_BEGIN(id) { \ - cl_object id = new_frame_id(); \ - if (frs_push(id) == 0) +#define CL_BLOCK_BEGIN(the_env,id) do { \ + const cl_object __id = new_frame_id(); \ + const cl_env_ptr __the_env = (the_env); \ + if (ecl_frs_push(__the_env,__id) == 0) -#define CL_BLOCK_END } \ - frs_pop() +#define CL_BLOCK_END \ + ecl_frs_pop(__the_env); } while(0) -#define CL_CATCH_BEGIN(tag) \ - if (frs_push(tag) == 0) { +#define CL_CATCH_BEGIN(the_env,tag) do { \ + const cl_env_ptr __the_env = (the_env); \ + if (ecl_frs_push(__the_env,tag) == 0) { #define CL_CATCH_END } \ - frs_pop(); + frs_pop(); } while (0) -#define CL_CATCH_ALL_BEGIN \ - if (frs_push(ECL_PROTECT_TAG) == 0) { +#define CL_CATCH_ALL_BEGIN(the_env) do { \ + const cl_env_ptr __the_env = (the_env); \ + if (ecl_frs_push(__the_env,ECL_PROTECT_TAG) == 0) { #define CL_CATCH_ALL_IF_CAUGHT } else { #define CL_CATCH_ALL_END } \ - frs_pop() + ecl_frs_pop(__the_env); } while(0) #ifdef __cplusplus } From 7452875f32d35fd7cbf06541a9b974956be62f8a Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Mon, 13 Oct 2008 22:48:37 +0200 Subject: [PATCH 30/60] ihs_push now requires the lisp environment. --- src/c/compiler.d | 4 ++-- src/c/interpreter.d | 4 ++-- src/cmp/cmptop.lsp | 2 +- src/h/stacks.h | 19 ++++++++++++------- 4 files changed, 17 insertions(+), 12 deletions(-) diff --git a/src/c/compiler.d b/src/c/compiler.d index 5ebd6d8da..27bfaedac 100644 --- a/src/c/compiler.d +++ b/src/c/compiler.d @@ -2761,7 +2761,7 @@ si_make_lambda(cl_object name, cl_object rest) /* * Interpret using the given lexical environment. */ - ihs_push(&ihs, bytecodes, Cnil); + ecl_ihs_push(the_env, &ihs, bytecodes, Cnil); VALUES(0) = Cnil; NVALUES = 0; { @@ -2771,7 +2771,7 @@ si_make_lambda(cl_object name, cl_object rest) GC_free(bytecodes->bytecodes.data); GC_free(bytecodes); #endif - ihs_pop(); + ecl_ihs_pop(the_env); return output; } @) diff --git a/src/c/interpreter.d b/src/c/interpreter.d index 554dc43f3..8661585a8 100644 --- a/src/c/interpreter.d +++ b/src/c/interpreter.d @@ -506,7 +506,7 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs if (type_of(bytecodes) != t_bytecodes) FEinvalid_function(bytecodes); - ihs_push(&ihs, bytecodes, lex_env); + ecl_ihs_push(the_env, &ihs, bytecodes, lex_env); frame_aux.t = t_frame; frame_aux.stack = frame_aux.top = frame_aux.bottom = 0; reg0 = Cnil; @@ -782,7 +782,7 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs or a function. */ CASE(OP_EXIT); { - ihs_pop(); + ecl_ihs_pop(the_env); ecl_bds_unwind(the_env, old_bds_top_index); return reg0; } diff --git a/src/cmp/cmptop.lsp b/src/cmp/cmptop.lsp index 0b86c8115..7c5648946 100644 --- a/src/cmp/cmptop.lsp +++ b/src/cmp/cmptop.lsp @@ -626,7 +626,7 @@ ;; name into the invocation stack (when (>= (fun-debug fun) 2) (push 'IHS *unwind-exit*) - (wt-nl "ihs_push(&ihs," (add-symbol (fun-name fun)) ",Cnil);")) + (wt-nl "ihs_push(cl_env_copy,&ihs," (add-symbol (fun-name fun)) ",Cnil);")) (c2lambda-expr (c1form-arg 0 lambda-expr) (c1form-arg 2 lambda-expr) diff --git a/src/h/stacks.h b/src/h/stacks.h index 4f6c15053..176780db0 100644 --- a/src/h/stacks.h +++ b/src/h/stacks.h @@ -89,15 +89,20 @@ typedef struct ihs_frame { cl_index index; } *ihs_ptr; -#define ihs_push(r,f,e) do { \ - (r)->next=cl_env.ihs_top; (r)->function=(f); (r)->lex_env=(e); \ - (r)->index=cl_env.ihs_top->index+1;\ - cl_env.ihs_top = (r); \ +#define ecl_ihs_push(env,rec,fun,lisp_env) do { \ + const cl_env_ptr __the_env = (env); \ + struct ihs_frame * const r = (rec); \ + r->next=__the_env->ihs_top; \ + r->function=(fun); \ + r->lex_env=(lisp_env); \ + r->index=__the_env->ihs_top->index+1; \ + __the_env->ihs_top = r; \ } while(0) -#define ihs_pop() do {\ - if (cl_env.ihs_top->next == NULL) ecl_internal_error("Underflow in IHS stack"); \ - cl_env.ihs_top = cl_env.ihs_top->next; \ +#define ecl_ihs_pop(env) do { \ + const cl_env_ptr __the_env = (env); \ + struct ihs_frame *r = __the_env->ihs_top; \ + if (r) __the_env->ihs_top = r->next; \ } while(0) extern ECL_API cl_object ihs_top_function_name(void); From 35fa30dc2242ddede17b496caf17328bc50c4383 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Mon, 13 Oct 2008 22:57:46 +0200 Subject: [PATCH 31/60] There was one occurrence of ihs_push->ecl_ihs_push left --- src/cmp/cmptop.lsp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cmp/cmptop.lsp b/src/cmp/cmptop.lsp index 7c5648946..256e5e85a 100644 --- a/src/cmp/cmptop.lsp +++ b/src/cmp/cmptop.lsp @@ -626,7 +626,7 @@ ;; name into the invocation stack (when (>= (fun-debug fun) 2) (push 'IHS *unwind-exit*) - (wt-nl "ihs_push(cl_env_copy,&ihs," (add-symbol (fun-name fun)) ",Cnil);")) + (wt-nl "ecl_ihs_push(cl_env_copy,&ihs," (add-symbol (fun-name fun)) ",Cnil);")) (c2lambda-expr (c1form-arg 0 lambda-expr) (c1form-arg 2 lambda-expr) From d41b3b6ac6a44f69846c0b9c917edcd20ae35b57 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Tue, 14 Oct 2008 00:07:18 +0200 Subject: [PATCH 32/60] Fix last occurrence of ihs_pop --- src/cmp/cmpexit.lsp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cmp/cmpexit.lsp b/src/cmp/cmpexit.lsp index ddb73faaf..48082fc1d 100644 --- a/src/cmp/cmpexit.lsp +++ b/src/cmp/cmpexit.lsp @@ -28,7 +28,7 @@ (wt-nl "ecl_bds_unwind1(cl_env_copy);")) (wt-nl "ecl_bds_unwind_n(cl_env_copy," bds-bind ");")) (when ihs-p - (wt-nl "ihs_pop();"))) + (wt-nl "ecl_ihs_pop(cl_env_copy);"))) (defun unwind-exit (loc &optional (jump-p nil) &aux (bds-lcl nil) (bds-bind 0) (stack-frame nil) (ihs-p nil)) (declare (fixnum bds-bind)) From c27fddb3290a8a61ea8444099997f3873691ebfe Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Tue, 14 Oct 2008 00:07:23 +0200 Subject: [PATCH 33/60] Binary streams now can only read or write bytes whose size is a multiple of 8. --- src/CHANGELOG | 2 + src/c/file.d | 264 +++-------------------------------------------- src/c/load.d | 2 +- src/h/external.h | 2 +- src/h/object.h | 4 - 5 files changed, 19 insertions(+), 255 deletions(-) diff --git a/src/CHANGELOG b/src/CHANGELOG index 99fcb4d6f..c4173eb08 100644 --- a/src/CHANGELOG +++ b/src/CHANGELOG @@ -80,6 +80,8 @@ ECL 8.9.0: - Functions compiled with (OPTIMIZE (SAFETY >= 2)) have an explicit stack overflow check. + - Binary streams now can only read or write bytes whose size is a multiple of 8. + * Embedding: - ECL now implements a more transparent interface for setting and querying diff --git a/src/c/file.d b/src/c/file.d index 8bc73ee6e..6bd90f9c0 100644 --- a/src/c/file.d +++ b/src/c/file.d @@ -438,7 +438,7 @@ wsock_error( const char *err_msg, cl_object strm ) cl_object ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, cl_object if_does_not_exist, cl_fixnum byte_size, - bool char_stream_p, bool use_header_p) + bool char_stream_p) { cl_env_ptr the_env = &cl_env; cl_object x; @@ -446,7 +446,6 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, cl_object filename = si_coerce_to_filename(fn); char *fname = filename->base_string.self; bool signed_bytes, appending = FALSE; - uint8_t binary_header = 0, bit_buffer = 0, bits_left = 0; if (byte_size < 0) { signed_bytes = 1; @@ -479,38 +478,12 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, fn = if_does_not_exist; goto INVALID_OPTION; } - } else if (!char_stream_p && use_header_p) { - /* Read the binary header */ - int c = getc(fp); - if (c != EOF) { - binary_header = c & 0xFF; - if (binary_header & ~7) { - goto INVALID_HEADER; - } - } - ecl_fseeko(fp, 0, SEEK_SET); } } else if (smm == smm_output || smm == smm_io) { if (if_exists == @':new_version' && if_does_not_exist == @':create') goto CREATE; fp = fopen(fname, OPEN_R); if (fp != NULL) { - if (!char_stream_p && use_header_p && (if_exists == @':overwrite' || if_exists == @':append')) { - /* Read binary header */ - int c = getc(fp); - if (c != EOF) { - binary_header = c & 0xFF; - if (binary_header & ~7) { - goto INVALID_HEADER; - } - if (binary_header != 0 && if_exists == @':append' && - ecl_fseeko(fp, -1, SEEK_END) == 0) { - /* Read the last byte */ - bit_buffer = getc(fp) & 0xFF; - bits_left = binary_header; - } - } - } fclose(fp); if (if_exists == @':error') { goto CANNOT_OPEN; @@ -583,22 +556,11 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, x->stream.closed = 0; x->stream.file = (void*)fp; x->stream.char_stream_p = char_stream_p; - /* Michael, touch this to reactivate support for odd bit sizes! */ - if (!use_header_p) { - /* binary header not used, round byte_size to a 8 bits */ - byte_size = (byte_size + 7) & ~7; - /* change header to something detectable */ - binary_header = 0xFF; - } + /* binary header not used, round byte_size to a 8 bits */ + byte_size = (byte_size + 7) & ~7; x->stream.byte_size = byte_size; x->stream.signed_bytes = signed_bytes; - x->stream.header = binary_header; x->stream.last_op = 0; - if (bits_left != 0) { - x->stream.bits_left = bits_left; - x->stream.bit_buffer = bit_buffer; - x->stream.buffer_state = -1; - } x->stream.object1 = fn; x->stream.int0 = x->stream.int1 = 0; si_set_buffering_mode(x, char_stream_p? @':line-buffered' : @':fully-buffered'); @@ -609,10 +571,9 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, if (!char_stream_p) { /* Set file pointer to the correct position */ if (appending) { - if (bits_left != 0) - ecl_fseeko(fp, -1, SEEK_END); + ecl_fseeko(fp, -1, SEEK_END); } else { - ecl_fseeko(fp, (use_header_p ? 1 : 0), SEEK_SET); + ecl_fseeko(fp, 0, SEEK_SET); } } } @@ -627,11 +588,6 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, ecl_enable_interrupts_env(the_env); FEerror("Invalid value op option ~A: ~A", 2, x, fn); return Cnil; - INVALID_HEADER: - ecl_enable_interrupts_env(the_env); - FEerror("~S has an invalid binary header ~S", 2, fn, - MAKE_FIXNUM(binary_header)); - return Cnil; INVALID_MODE: ecl_enable_interrupts_env(the_env); FEerror("Illegal stream mode ~S", 1, MAKE_FIXNUM(smm)); @@ -641,7 +597,6 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, /* Forward definitions */ static void ecl_write_byte8(int c, cl_object strm); static int ecl_read_byte8(cl_object strm); -static void flush_output_stream_binary(cl_object strm); @(defun close (strm &key (abort @'nil')) FILE *fp; @@ -672,14 +627,6 @@ static void flush_output_stream_binary(cl_object strm); wrong_file_handler(strm); if (ecl_output_stream_p(strm)) { ecl_force_output(strm); - if (!strm->stream.char_stream_p && strm->stream.header != 0xFF) { - /* write header */ - ecl_disable_interrupts(); - if (ecl_fseeko(fp, 0, SEEK_SET) != 0) - io_error(strm); - ecl_enable_interrupts(); - ecl_write_byte8(strm->stream.header, strm); - } } if (fclose(fp) != 0) FElibc_error("Cannot close stream ~S.", 1, strm); @@ -869,35 +816,6 @@ BEGIN: if (bs == 8) { cl_fixnum n = fixint(c); ecl_write_byte8(n & 0xFF, strm); - } else if (bs & 7) { - unsigned char b = strm->stream.bit_buffer; - int bs_ = bs; - cl_object c0 = c; - nb = strm->stream.bits_left; - if (strm->stream.buffer_state == 1) { - /* buffer is prepared for reading: re-read (8-nb) bits and throw the rest */ - int c0; - ecl_fseeko((FILE*)strm->stream.file, -1, SEEK_CUR); - c0 = ecl_read_byte8(strm); - if (c0 == EOF) - /* this should not happen !!! */ - io_error(strm); - ecl_fseeko((FILE*)strm->stream.file, -1, SEEK_CUR); - b = (unsigned char)(c0 & MAKE_BIT_MASK(8-nb)); - nb = (8-nb); - } - do { - b |= (unsigned char)(fixnnint(cl_logand(2, c0, MAKE_FIXNUM(MAKE_BIT_MASK(8-nb)))) << nb); - bs_ -= (8-nb); - c0 = cl_ash(c0, MAKE_FIXNUM(nb-8)); - if (bs_ >= 0) { - ecl_write_byte8(b, strm); - b = nb = 0; - } - } while (bs_ > 0); - strm->stream.bits_left = (bs_ < 0 ? (8+bs_) : 0); - strm->stream.bit_buffer = (bs_ < 0 ? (b & MAKE_BIT_MASK(8+bs_)) : 0); - strm->stream.buffer_state = (bs_ < 0 ? -1 : 0); } else do { cl_object b = cl_logand(2, c, MAKE_FIXNUM(0xFF)); ecl_write_byte8(fix(b), strm); @@ -995,78 +913,6 @@ si_set_buffering_mode(cl_object stream, cl_object buffer_mode_symbol) @(return stream) } -static void -flush_output_stream_binary(cl_object strm) -{ - if (strm->stream.buffer_state == -1) { - /* buffer is prepared for writing: flush it */ - unsigned char b = strm->stream.bit_buffer; - cl_index nb = strm->stream.bits_left; - bool do_merging = FALSE; - FILE *fp = (FILE*)strm->stream.file; - - /* do we need to merge with existing byte? */ - ecl_off_t current_offset, diff_offset; - ecl_disable_interrupts(); - current_offset = ecl_ftello(fp); - if (ecl_fseeko(fp, 0, SEEK_END) != 0) - io_error(strm); - switch ((diff_offset = ecl_ftello(fp)-current_offset)) { - case 0: break; - case 1: - /* (EOF-1): merge only if less bits left than header tells us */ - do_merging = (nb < strm->stream.header); - break; - default: - do_merging = (diff_offset > 1); - break; - } - if (ecl_fseeko(fp, current_offset, SEEK_SET) != 0) - io_error(strm); - ecl_enable_interrupts(); - - /* do merging, if required */ - if (do_merging){ - if (strm->stream.mode == smm_io) { - /* I/O stream: no need to reopen and I/O sync already triggered */ - int c = ecl_read_byte8(strm); - if (c != EOF) - b |= (unsigned char)(c & ~MAKE_BIT_MASK(nb)); - /* rewind stream */ - ecl_disable_interrupts(); - if (ecl_fseeko(fp, -1, SEEK_CUR) != 0) - io_error(strm); - ecl_enable_interrupts(); - } else { - /* write-only stream: need to reopen the file for reading * - * the byte to merge, then reopen it back for writing */ - cl_object fn = si_coerce_to_filename(strm->stream.object1); - ecl_disable_interrupts(); - if (freopen(fn->base_string.self, OPEN_R, fp) == NULL || - ecl_fseeko(fp, current_offset, SEEK_SET) != 0) - io_error(strm); - /* cannot use ecl_read_byte8 here, because strm hasn't the right mode */ - b |= (unsigned char)(getc(fp) & ~MAKE_BIT_MASK(nb)); - /* need special trick to re-open the file for writing, avoiding truncation */ - fclose(fp); - strm->stream.file = fdopen(open(fn->base_string.self, O_WRONLY), OPEN_W); - if (strm->stream.file == NULL || ecl_fseeko(fp, current_offset, SEEK_SET) != 0) - io_error(strm); - ecl_enable_interrupts(); - } - } else { - /* No merging occurs -> header must be overwritten */ - strm->stream.header = nb; - } - - /* flush byte w/o changing file pointer */ - ecl_write_byte8(b, strm); - ecl_disable_interrupts(); - ecl_fseeko(fp, -1, SEEK_CUR); - ecl_enable_interrupts(); - } -} - cl_object ecl_read_byte(cl_object strm) { @@ -1148,35 +994,6 @@ BEGIN: return MAKE_FIXNUM((signed char)c); } return MAKE_FIXNUM(i); - } else if (bs & 7) { - unsigned char b = strm->stream.bit_buffer; - nb = strm->stream.bits_left; - if (strm->stream.buffer_state == -1) { - /* buffer is prepared for writing: flush it */ - flush_output_stream_binary(strm); - b = ((unsigned char)ecl_read_byte8(strm)) >> nb; - nb = (8-nb); - } - if (nb >= bs) { - c = MAKE_FIXNUM(b & (unsigned char)MAKE_BIT_MASK(bs)); - strm->stream.bits_left = (nb-bs); - strm->stream.bit_buffer = (strm->stream.bits_left > 0 ? (b >> bs): 0); - } else { - cl_index i; - c = MAKE_FIXNUM(b); - while (nb < bs) { - int c0 = ecl_read_byte8(strm); - if (c0 == EOF) - return Cnil; - b = (unsigned char)(c0 & 0xFF); - for (i=8; i>0 && nb>=1) { - c = cl_logior(2, c, cl_ash(MAKE_FIXNUM(b&0x01), MAKE_FIXNUM(nb))); - } - } - strm->stream.bits_left = i; - strm->stream.bit_buffer = b; - } - strm->stream.buffer_state = (strm->stream.bits_left > 0 ? 1 : 0); } else { cl_index bs_ = bs; c = MAKE_FIXNUM(0); @@ -1848,9 +1665,6 @@ BEGIN: FILE *fp = (FILE*)strm->stream.file; if (fp == NULL) wrong_file_handler(strm); - if ((strm->stream.byte_size & 7) && strm->stream.buffer_state == -1) { - flush_output_stream_binary(strm); - } ecl_disable_interrupts(); while ((fflush(fp) == EOF) && restartable_io_error(strm)) (void)0; @@ -2294,24 +2108,10 @@ BEGIN: default: ecl_internal_error("illegal stream mode"); } - if (!strm->stream.char_stream_p) { - /* deduce header and convert to bits */ - output = ecl_times(strm->stream.header != 0xFF ? ecl_one_minus(output) : output, MAKE_FIXNUM(8)); - switch (strm->stream.buffer_state) { - case 0: break; - case -1: - /* bits left for writing, use them */ - output = ecl_plus(output, MAKE_FIXNUM(strm->stream.bits_left)); - break; - case 1: - /* bits left for reading, deduce them */ - output = ecl_minus(output, MAKE_FIXNUM(strm->stream.bits_left)); - break; - } - /* normalize to byte_size */ - output = ecl_floor2(output, MAKE_FIXNUM(strm->stream.byte_size)); + if (!strm->stream.char_stream_p && strm->stream.byte_size != 8) { + output = ecl_floor2(output, MAKE_FIXNUM(strm->stream.byte_size/8)); if (VALUES(1) != MAKE_FIXNUM(0)) { - ecl_internal_error("File position is not on byte boundary"); + FEerror("File position is not on byte boundary", 0); } } return output; @@ -2321,7 +2121,6 @@ cl_object ecl_file_position_set(cl_object strm, cl_object large_disp) { ecl_off_t disp; - int extra = 0; BEGIN: #ifdef ECL_CLOS_STREAMS if (ECL_INSTANCEP(strm)) @@ -2337,37 +2136,15 @@ BEGIN: ecl_force_output(strm); case smm_input:{ FILE *fp = (FILE*)strm->stream.file; - if (!strm->stream.char_stream_p) { - large_disp = ecl_floor2(ecl_times(large_disp, MAKE_FIXNUM(strm->stream.byte_size)), - MAKE_FIXNUM(8)); - extra = fix(VALUES(1)); - /* include the header in byte offset */ - if (strm->stream.header != 0xFF) - large_disp = ecl_one_plus(large_disp); - /* flush output stream: required, otherwise internal buffer is lost */ - flush_output_stream_binary(strm); - /* reset internal buffer: should be set again if extra != 0 */ - strm->stream.bit_buffer = strm->stream.bits_left = strm->stream.buffer_state = 0; + if (!strm->stream.char_stream_p && strm->stream.byte_size > 8) { + large_disp = ecl_times(large_disp, + MAKE_FIXNUM(strm->stream.byte_size/8)); } disp = ecl_integer_to_off_t(large_disp); if (fp == NULL) wrong_file_handler(strm); if (ecl_fseeko(fp, disp, 0) != 0) return Cnil; - if (extra != 0) { - if (ecl_input_stream_p(strm)) { - /* prepare the buffer for reading */ - int c = ecl_read_byte8(strm); - if (c == EOF) - return Cnil; - strm->stream.bit_buffer = (c & 0xFF) >> extra; - strm->stream.bits_left = (8-extra); - strm->stream.buffer_state = 1; - /* reset extra to avoid error */ - extra = 0; - } - /* FIXME: consider case of output-only stream */ - } break; } case smm_string_output: { @@ -2417,9 +2194,6 @@ BEGIN: default: ecl_internal_error("illegal stream mode"); } - if (extra) { - FEerror("Unsupported stream byte size", 0); - } return Ct; } @@ -2443,19 +2217,12 @@ BEGIN: ecl_force_output(strm); case smm_input: { FILE *fp = (FILE*)strm->stream.file; - cl_index bs; if (fp == NULL) wrong_file_handler(strm); output = ecl_file_len(fp); - if (!strm->stream.char_stream_p) { - bs = strm->stream.byte_size; - if (strm->stream.header != 0xFF) - output = ecl_floor2(ecl_minus(ecl_times(ecl_one_minus(output), MAKE_FIXNUM(8)), - MAKE_FIXNUM((8-strm->stream.header)%8)), - MAKE_FIXNUM(bs)); - else - output = ecl_floor2(ecl_times(output, MAKE_FIXNUM(8)), - MAKE_FIXNUM(bs)); + if (!strm->stream.char_stream_p && strm->stream.byte_size != 8) { + cl_index bs = strm->stream.byte_size; + output = ecl_floor2(output, MAKE_FIXNUM(bs/8)); if (VALUES(1) != MAKE_FIXNUM(0)) { FEerror("File length is not on byte boundary", 0); } @@ -2873,8 +2640,7 @@ normalize_stream_element_type(cl_object element_type) byte_size = normalize_stream_element_type(element_type); } strm = ecl_open_stream(filename, smm, if_exists, if_does_not_exist, - byte_size, char_stream_p, - (use_header_p != Cnil)); + byte_size, char_stream_p); @(return strm) @) diff --git a/src/c/load.d b/src/c/load.d index 62c45eda6..8d7dd05ca 100644 --- a/src/c/load.d +++ b/src/c/load.d @@ -423,7 +423,7 @@ si_load_source(cl_object source, cl_object verbose, cl_object print) /* INV: if "source" is not a valid stream, file.d will complain */ strm = source; } else { - strm = ecl_open_stream(source, smm_input, Cnil, Cnil, 8, 1, 1); + strm = ecl_open_stream(source, smm_input, Cnil, Cnil, 8, 1); if (Null(strm)) @(return Cnil) } diff --git a/src/h/external.h b/src/h/external.h index 9a711a9c5..683230246 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -595,7 +595,7 @@ extern ECL_API cl_object si_set_buffering_mode(cl_object strm, cl_object mode); extern ECL_API bool ecl_input_stream_p(cl_object strm); extern ECL_API bool ecl_output_stream_p(cl_object strm); -extern ECL_API cl_object ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, cl_object if_does_not_exist, cl_fixnum byte_size, bool char_stream_p, bool use_header_p); +extern ECL_API cl_object ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, cl_object if_does_not_exist, cl_fixnum byte_size, bool char_stream_p); extern ECL_API cl_object ecl_make_string_input_stream(cl_object strng, cl_index istart, cl_index iend); extern ECL_API cl_object ecl_make_string_output_stream(cl_index line_length); extern ECL_API cl_object ecl_read_byte(cl_object strm); diff --git a/src/h/object.h b/src/h/object.h index 9fa4ce0e7..ca203fe6a 100644 --- a/src/h/object.h +++ b/src/h/object.h @@ -483,10 +483,6 @@ struct ecl_stream { cl_fixnum int1; /* some int */ char *buffer; /* file buffer */ cl_index byte_size; /* size of byte in binary streams */ - unsigned char bit_buffer; - uint8_t bits_left; - int8_t buffer_state; /* 0: unknown, 1: reading, -1: writing */ - uint8_t header; /* number of significant bits in the last byte */ int8_t last_op; /* 0: unknown, 1: reading, -1: writing */ }; From b7f0067ae997865609f2cf40c983d817e3b3c52e Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sun, 19 Oct 2008 00:00:58 +0200 Subject: [PATCH 34/60] New implementation of lisp streams based on a method dispatch table. --- contrib/sockets/sockets.lisp | 2 +- src/CHANGELOG | 4 + src/c/file.d | 5478 ++++++++++++++++++---------------- src/c/format.d | 8 +- src/c/pathname.d | 12 +- src/c/print.d | 16 +- src/c/tcp.d | 8 +- src/c/unixsys.d | 8 +- src/h/external.h | 9 +- src/h/internal.h | 18 + src/h/object.h | 42 +- 11 files changed, 3049 insertions(+), 2556 deletions(-) diff --git a/contrib/sockets/sockets.lisp b/contrib/sockets/sockets.lisp index 19469aa23..f6ca4a936 100644 --- a/contrib/sockets/sockets.lisp +++ b/contrib/sockets/sockets.lisp @@ -1182,7 +1182,7 @@ also known as unix-domain sockets.")) buffering) (t :int :int :object) t - "si_set_buffering_mode(ecl_make_stream_from_fd(#0,#1,(enum ecl_smmode)#2), #3)" + "si_set_buffering_mode(ecl_make_stream_from_fd(#0,#1,(enum ecl_smmode)#2,8,1), #3)" :one-liner t)) (defmethod socket-make-stream ((socket socket) &rest args &key (buffering-mode NIL)) diff --git a/src/CHANGELOG b/src/CHANGELOG index c4173eb08..01c85957d 100644 --- a/src/CHANGELOG +++ b/src/CHANGELOG @@ -82,6 +82,10 @@ ECL 8.9.0: - Binary streams now can only read or write bytes whose size is a multiple of 8. + - ECL has now a new and more easily extensible implementation of streams, based + on C structures with a method dispatch table. Apart from code reuse and better + maintainability, this allows a more sensible design of read/write-sequence. + * Embedding: - ECL now implements a more transparent interface for setting and querying diff --git a/src/c/file.d b/src/c/file.d index 6bd90f9c0..16f9d612b 100644 --- a/src/c/file.d +++ b/src/c/file.d @@ -56,268 +56,2675 @@ #define ecl_ftello ftello #endif -#define MAKE_BIT_MASK(n) ((1<<(n))-1) +static cl_index ecl_read_byte8(cl_object stream, char *c, cl_index n); +static cl_index ecl_write_byte8(cl_object stream, char *c, cl_index n); -static int flisten(FILE *fp); +struct ecl_file_ops *duplicate_dispatch_table(const struct ecl_file_ops *ops); +const struct ecl_file_ops *stream_dispatch_table(cl_object strm); -/* - * When using the same stream for input and output operations, we have to - * use some file position operation before reading again. +static int flisten(FILE *); +static void io_stream_begin_write(cl_object strm); +static void io_stream_begin_read(cl_object strm); +static cl_object ecl_off_t_to_integer(ecl_off_t offset); +static ecl_off_t ecl_integer_to_off_t(cl_object offset); + +static cl_object alloc_stream(); + +static cl_object not_a_file_stream(cl_object fn); +static void not_an_input_stream(cl_object fn); +static void not_an_output_stream(cl_object fn); +static void not_a_character_stream(cl_object s); +static void not_a_binary_stream(cl_object s); +static int restartable_io_error(cl_object strm); +static void unread_error(cl_object strm); +static void unread_twice(cl_object strm); +static void io_error(cl_object strm); +static void wrong_file_handler(cl_object strm); + +/********************************************************************** + * NOT IMPLEMENTED or NOT APPLICABLE OPERATIONS */ -static void io_stream_begin_write(cl_object strm) +static cl_index +not_output_write_byte8(cl_object strm, char *c, cl_index n) { - if (strm->stream.last_op > 0) { - ecl_fseeko((FILE*)strm->stream.file, 0, SEEK_CUR); - } - strm->stream.last_op = -1; + not_an_output_stream(strm); + return 0; } -/* - * When using the same stream for input and output operations, we have to - * flush the stream before writing. - */ - -static void io_stream_begin_read(cl_object strm) +static cl_index +not_input_read_byte8(cl_object strm, char *c, cl_index n) { - if (strm->stream.last_op < 0) { - ecl_force_output(strm); - } - strm->stream.last_op = +1; + not_an_input_stream(strm); + return 0; +} + +static cl_index +not_binary_write_byte8(cl_object strm, char *c, cl_index n) +{ + not_a_binary_stream(strm); + return 0; +} + +static cl_index +not_binary_read_byte8(cl_object strm, char *c, cl_index n) +{ + not_a_binary_stream(strm); + return 0; +} + +static int +not_input_read_char(cl_object strm) +{ + not_an_input_stream(strm); + return -1; +} + +static int +not_output_write_char(cl_object strm, int c) +{ + not_an_output_stream(strm); + return c; +} + +static void +not_input_unread_char(cl_object strm, int c) +{ + not_an_input_stream(strm); +} + +static int +not_input_listen(cl_object strm) +{ + not_an_input_stream(strm); + return -1; +} + +static int +not_character_read_char(cl_object strm) +{ + not_a_character_stream(strm); + return -1; +} + +static int +not_character_write_char(cl_object strm, int c) +{ + not_a_character_stream(strm); + return c; +} + +static void +not_character_unread_char(cl_object strm, int c) +{ + not_a_character_stream(strm); +} + +static int +not_character_listen(cl_object strm) +{ + not_a_character_stream(strm); + return -1; +} + +static void +not_input_clear_input(cl_object strm) +{ + not_an_input_stream(strm); + return; +} + +static void +not_output_clear_output(cl_object strm) +{ + not_an_output_stream(strm); + return; +} + +static void +not_output_force_output(cl_object strm) +{ + not_an_output_stream(strm); + return; +} + +static void +not_output_finish_output(cl_object strm) +{ + not_an_output_stream(strm); + return; } static cl_object -ecl_off_t_to_integer(ecl_off_t offset) +not_implemented_get_position(cl_object strm) { - cl_object output; - if (sizeof(ecl_off_t) == sizeof(cl_fixnum)) { - output = ecl_make_integer(offset); - } else if (offset <= MOST_POSITIVE_FIXNUM) { - output = MAKE_FIXNUM((cl_fixnum)offset); - } else { - cl_object y = big_register0_get(); -#ifdef WITH_GMP - if (sizeof(y->big.big_limbs[0]) == sizeof(cl_index)) { - y->big.big_limbs[0] = (cl_index)offset; - offset >>= FIXNUM_BITS; - y->big.big_limbs[1] = offset; - y->big.big_size = offset? 2 : 1; - } else if (sizeof(y->big.big_limbs[0]) >= sizeof(ecl_off_t)) { - y->big.big_limbs[0] = offset; - y->big.big_size = 1; - } -#else - y->big.big_num = offset; -#endif - output = big_register_normalize(y); - } - return output; + FEerror("file-position not implemented for stream ~S", 1, strm); + return Cnil; } -static ecl_off_t -ecl_integer_to_off_t(cl_object offset) +static cl_object +not_implemented_set_position(cl_object strm, cl_object pos) { - ecl_off_t output = 0; - if (sizeof(ecl_off_t) == sizeof(cl_fixnum)) { - output = fixint(offset); - } else if (FIXNUMP(offset)) { - output = fixint(offset); - } else if (type_of(offset) == t_bignum) { -#ifdef WITH_GMP - if (sizeof(offset->big.big_limbs[0]) == sizeof(cl_index)) { - if (offset->big.big_size > 2) { - goto ERR; - } - if (offset->big.big_size == 2) { - output = offset->big.big_limbs[1]; - output <<= FIXNUM_BITS; - } - output += offset->big.big_limbs[0]; - } else if (sizeof(offset->big.big_limbs[0]) >= sizeof(ecl_off_t)) { - if (offset->big.big_size > 1) { - goto ERR; - } - output = offset->big.big_limbs[0]; - } -#else - output = offset->big.big_num; -#endif - } else { - ERR: FEerror("Not a valid file offset: ~S", 1, offset); - } - return output; + FEerror("file-position not implemented for stream ~S", 1, strm); + return Cnil; } -/*---------------------------------------------------------------------- - * ecl_input_stream_p(strm) answers - * if stream strm is an input stream or not. - * It does not check if it really is possible to read - * from the stream, - * but only checks the mode of the stream (sm_mode). - *---------------------------------------------------------------------- +/********************************************************************** + * CLOSED STREAM OPS */ -bool -ecl_input_stream_p(cl_object strm) + +static cl_index +closed_stream_read_byte8(cl_object strm, char *c, cl_index n) { -BEGIN: -#ifdef ECL_CLOS_STREAMS - if (ECL_INSTANCEP(strm)) - return !Null(funcall(2, @'gray::input-stream-p', strm)); -#endif - if (type_of(strm) != t_stream) - FEtype_error_stream(strm); - switch ((enum ecl_smmode)strm->stream.mode) { - case smm_io: - case smm_input: -#if defined(ECL_WSOCK) - case smm_input_wsock: - case smm_io_wsock: -#endif - case smm_concatenated: - case smm_two_way: - case smm_echo: - case smm_string_input: - return(TRUE); - - case smm_output: -#if defined(ECL_WSOCK) - case smm_output_wsock: -#endif - case smm_string_output: - case smm_broadcast: - return(FALSE); - - case smm_synonym: - strm = ecl_symbol_value(strm->stream.object0); - goto BEGIN; - - default: - ecl_internal_error("illegal stream mode"); - } + FEclosed_stream(strm); } -/*---------------------------------------------------------------------- - * ecl_output_stream_p(strm) answers - * if stream strm is an output stream. - * It does not check if it really is possible to write - * to the stream, - * but only checks the mode of the stream (sm_mode). - *---------------------------------------------------------------------- - */ -bool -ecl_output_stream_p(cl_object strm) +static cl_index +closed_stream_write_byte8(cl_object strm, char *c, cl_index n) { -BEGIN: -#ifdef ECL_CLOS_STREAMS - if (ECL_INSTANCEP(strm)) - return !Null(funcall(2, @'gray::output-stream-p', strm)); -#endif - if (type_of(strm) != t_stream) - FEtype_error_stream(strm); - switch ((enum ecl_smmode)strm->stream.mode) { - case smm_input: - case smm_probe: -#if defined(ECL_WSOCK) - case smm_input_wsock: -#endif - case smm_concatenated: - case smm_string_input: - return(FALSE); + FEclosed_stream(strm); +} - case smm_output: -#if defined(ECL_WSOCK) - case smm_output_wsock: - case smm_io_wsock: -#endif - case smm_io: - case smm_two_way: - case smm_echo: - case smm_broadcast: - case smm_string_output: - return(TRUE); +static int +closed_stream_read_char(cl_object strm) +{ + FEclosed_stream(strm); +} - case smm_synonym: - strm = ecl_symbol_value(strm->stream.object0); - goto BEGIN; +static int +closed_stream_write_char(cl_object strm, int c) +{ + FEclosed_stream(strm); + return c; +} - default: - ecl_internal_error("illegal stream mode"); +static void +closed_stream_unread_char(cl_object strm, int c) +{ + FEclosed_stream(strm); +} + +static int +closed_stream_listen(cl_object strm) +{ + FEclosed_stream(strm); +} + +static void +closed_stream_clear_input(cl_object strm) +{ + FEclosed_stream(strm); +} + +#define closed_stream_clear_output closed_stream_clear_input +#define closed_stream_force_output closed_stream_clear_input +#define closed_stream_finish_output closed_stream_clear_input + +static cl_object +closed_stream_length(cl_object strm) +{ + FEclosed_stream(strm); +} + +#define closed_stream_get_position closed_stream_length + +static cl_object +closed_stream_set_position(cl_object strm, cl_object position) +{ + FEclosed_stream(strm); +} + +/********************************************************************** + * GENERIC OPERATIONS + * + * Versions of the methods which are defined in terms of others + */ +/* + * Byte operations for devices that are character based. We assume that + * the character size matches that of the byte. + */ +static cl_index +generic_write_byte8(cl_object strm, char *c, cl_index n) +{ + const struct ecl_file_ops *ops = stream_dispatch_table(strm); + cl_index i; + for (i = 0; i < n; i++) { + ops->write_char(strm, c[i]); } + return n; +} + +static cl_index +generic_read_byte8(cl_object strm, char *c, cl_index n) +{ + const struct ecl_file_ops *ops = stream_dispatch_table(strm); + cl_index i; + for (i = 0; i < n; i++) { + c[i] = ops->read_char(strm); + } + return n; } /* - * In ECL, all streams have element type (UNSIGNED-BYTE 8), (SIGNED-BYTE 8) - * or BASE-CHAR. Nevertheless, READ-CHAR and WRITE-CHAR are allowed in them, - * and they perform more or less as if - * (READ-CHAR) = (CODE-CHAR (READ-BYTE)) - * (WRITE-CHAR c) = (WRITE-BYTE (CHAR-CODE c)) + * Character operations for devices which are byte based. We assume that + * the character size matches that of the byte. */ +static int +generic_read_char(cl_object strm) +{ + int c = strm->stream.unread; + if (c == EOF) { + const struct ecl_file_ops *ops = stream_dispatch_table(strm); + char aux; + if (ops->read_byte8(strm, &aux, 1) < 1) + c = EOF; + else + c = aux; + } else { + strm->stream.unread = EOF; + } + return c; +} + +static int +generic_peek_char(cl_object strm) +{ + int out = ecl_read_char(strm); + if (out != EOF) ecl_unread_char(out, strm); + return out; +} + +static int +generic_write_char(cl_object strm, int c) +{ + const struct ecl_file_ops *ops = stream_dispatch_table(strm); + char aux = c; + ops->write_byte8(strm, &aux, 1); + return c; +} + +static void +generic_unread_char(cl_object strm, int c) +{ + if (strm->stream.unread != EOF) { + unread_twice(strm); + } + strm->stream.unread = c; +} + +static void +generic_void(cl_object strm) +{ +} + +static int +generic_always_true(cl_object strm) +{ + return 1; +} + +static int +generic_always_false(cl_object strm) +{ + return 0; +} + +static cl_object +generic_always_nil(cl_object strm) +{ + return Cnil; +} + +static int +generic_column(cl_object strm) +{ + return 0; +} + +static cl_object +generic_set_position(cl_object strm, cl_object pos) +{ + return Cnil; +} + +static cl_object +generic_close(cl_object strm) +{ + struct ecl_file_ops *ops = strm->stream.ops; + if (ecl_input_stream_p(strm)) { + ops->read_byte8 = closed_stream_read_byte8; + ops->read_char = closed_stream_read_char; + ops->unread_char = closed_stream_unread_char; + ops->listen = closed_stream_listen; + ops->clear_input = closed_stream_clear_input; + } + if (ecl_output_stream_p(strm)) { + ops->write_byte8 = closed_stream_write_byte8; + ops->write_char = closed_stream_write_char; + ops->clear_output = closed_stream_clear_output; + ops->force_output = closed_stream_force_output; + ops->finish_output = closed_stream_finish_output; + } + ops->get_position = closed_stream_get_position; + ops->set_position = closed_stream_set_position; + ops->length = closed_stream_length; + ops->close = generic_close; + strm->stream.closed = 1; + return Ct; +} + +static cl_index +generic_write_vector(cl_object strm, cl_object data, cl_index start, cl_index end) +{ + if (start >= end) + return start; + if (data->vector.elttype == aet_bc || +#ifdef ECL_UNICODE + data->vector.elttype == aet_ch || +#endif + (data->vector.elttype == aet_object && CHARACTERP(ecl_elt(data, 0)))) { + for (; start < end; start++) { + ecl_write_char(ecl_char_code(ecl_elt(data, start)), strm); + } + } else { + for (; start < end; start++) { + ecl_write_byte(ecl_elt(data, start), strm); + } + } + return start; +} + +static cl_index +generic_read_vector(cl_object strm, cl_object data, cl_index start, cl_index end) +{ + cl_object expected_type; + if (start >= end) + return start; + expected_type = ecl_stream_element_type(strm); + if (expected_type == @'base-char' || expected_type == @'character') { + for (; start < end; start++) { + cl_fixnum c = ecl_read_char(strm); + if (c == EOF) break; + ecl_elt_set(data, start, CODE_CHAR(c)); + } + } else { + for (; start < end; start++) { + cl_object x = ecl_read_byte(strm); + if (Null(x)) break; + ecl_elt_set(data, start, x); + } + } + return start; +} + +/******************************************************************************** + * CLOS STREAMS + */ + +static cl_index +clos_stream_read_byte8(cl_object strm, char *c, cl_index n) +{ + cl_index i; + for (i = 0; i < n; i++) { + cl_object byte = funcall(3, @'gray::stream-read-byte', strm); + if (!FIXNUMP(byte)) + break; + c[i] = fix(byte); + } + return i; +} + +static cl_index +clos_stream_write_byte8(cl_object strm, char *c, cl_index n) +{ + cl_index i; + for (i = 0; i < n; i++) { + cl_object byte = funcall(3, @'gray::stream-write-byte', strm, + MAKE_FIXNUM(c[i])); + if (!FIXNUMP(byte)) + break; + } + return i; +} + +static int +clos_stream_read_char(cl_object strm) +{ + cl_object output = funcall(3, @'gray::stream-read-char', strm); + return CHAR_CODE(output); +} + +static int +clos_stream_write_char(cl_object strm, int c) +{ + funcall(3, @'gray::stream-write-char', strm, CODE_CHAR(c)); + return c; +} + +static void +clos_stream_unread_char(cl_object strm, int c) +{ + funcall(3, @'gray::stream-unread-char', strm, CODE_CHAR(c)); +} + +#define clos_stream_peek_char generic_peek_char + +static int +clos_stream_listen(cl_object strm) +{ + return !Null(funcall(2, @'gray::stream-listen', strm)); +} + +static void +clos_stream_clear_input(cl_object strm) +{ + funcall(2, @'gray::stream-clear-input', strm); + return; +} + +static void +clos_stream_clear_output(cl_object strm) +{ + funcall(2, @'gray::stream-clear-output', strm); + return; +} + +static void +clos_stream_force_output(cl_object strm) +{ + funcall(2, @'gray::stream-force-output', strm); + return; +} + +static void +clos_stream_finish_output(cl_object strm) +{ + funcall(2, @'gray::stream-finish-output', strm); + return; +} + +static int +clos_stream_input_p(cl_object strm) +{ + return !Null(funcall(2, @'gray::input-stream-p', strm)); +} + +static int +clos_stream_output_p(cl_object strm) +{ + return !Null(funcall(2, @'gray::output-stream-p', strm)); +} + +static int +clos_stream_interactive_p(cl_object strm) +{ + return !Null(funcall(2, @'gray::stream-interactive-p', strm)); + +} + +static cl_object +clos_stream_element_type(cl_object strm) +{ + return funcall(2, @'gray::stream-element-type', strm); +} + +#define clos_stream_length not_a_file_stream +#define clos_stream_get_position not_implemented_get_position +#define clos_stream_set_position not_implemented_set_position + +static int +clos_stream_column(cl_object strm) +{ + cl_object col = funcall(2, @'gray::stream-line-column', strm); + /* FIXME! The Gray streams specifies NIL is a valid + * value but means "unknown". Should we make it + * zero? */ + return Null(col)? 0 : fixnnint(col); +} + +static cl_object +clos_stream_close(cl_object strm) +{ + return funcall(2, @'gray::close', strm); +} + +const struct ecl_file_ops clos_stream_ops = { + clos_stream_write_byte8, + clos_stream_read_byte8, + + clos_stream_read_char, + clos_stream_write_char, + clos_stream_unread_char, + clos_stream_peek_char, + + generic_read_vector, + generic_write_vector, + + clos_stream_listen, + clos_stream_clear_input, + clos_stream_clear_output, + clos_stream_finish_output, + clos_stream_force_output, + + clos_stream_input_p, + clos_stream_output_p, + clos_stream_interactive_p, + clos_stream_element_type, + + clos_stream_length, + clos_stream_get_position, + clos_stream_set_position, + clos_stream_column, + clos_stream_close +}; + +/********************************************************************** + * STRING OUTPUT STREAMS + */ + +#define str_out_read_byte8 not_input_read_byte8 +#define str_out_write_byte8 not_binary_write_byte8 +#define str_out_read_char not_input_read_char +#define str_out_unread_char not_input_unread_char +#define str_out_peek_char generic_peek_char +#define str_out_listen not_input_listen + +static int +str_out_write_char(cl_object strm, int c) +{ + int column = STRING_OUTPUT_COLUMN(strm); + if (c == '\n') + STRING_OUTPUT_COLUMN(strm) = 0; + else if (c == '\t') + STRING_OUTPUT_COLUMN(strm) = (column&~07) + 8; + else + STRING_OUTPUT_COLUMN(strm) = column+1; + ecl_string_push_extend(STRING_OUTPUT_STRING(strm), c); + return c; +} + +#define str_out_clear_input not_input_clear_input +#define str_out_clear_output generic_void +#define str_out_force_output generic_void +#define str_out_finish_output generic_void +#define str_out_input_p generic_always_false +#define str_out_output_p generic_always_true + +static cl_object +str_out_element_type(cl_object strm) +{ + cl_object string = STRING_OUTPUT_STRING(strm); + if (type_of(string) == t_base_string) + return @'base-char'; + return @'character'; +} + +#define str_out_length not_a_file_stream + +static cl_object +str_out_get_position(cl_object strm) +{ + return ecl_make_unsigned_integer(STRING_OUTPUT_STRING(strm)->base_string.fillp); +} + +static cl_object +str_out_set_position(cl_object strm, cl_object pos) +{ + cl_object string = STRING_OUTPUT_STRING(strm); + cl_fixnum disp = fixnnint(pos); + if (disp < string->base_string.fillp) { + string->base_string.fillp = disp; + } else { + disp -= string->base_string.fillp; + while (disp-- > 0) + ecl_write_char(' ', strm); + } + return Ct; +} + +static int +str_out_column(cl_object strm) +{ + return STRING_OUTPUT_COLUMN(strm); +} + +#define str_out_close generic_close + +const struct ecl_file_ops str_out_ops = { + str_out_write_byte8, + str_out_read_byte8, + + str_out_read_char, + str_out_write_char, + str_out_unread_char, + str_out_peek_char, + + generic_read_vector, + generic_write_vector, + + str_out_listen, + str_out_clear_input, + str_out_clear_output, + str_out_finish_output, + str_out_force_output, + + str_out_input_p, + str_out_output_p, + generic_always_false, + str_out_element_type, + + str_out_length, + str_out_get_position, + str_out_set_position, + str_out_column, + str_out_close +}; + + cl_object -cl_stream_element_type(cl_object strm) +si_make_string_output_stream_from_string(cl_object s) +{ + cl_object strm = alloc_stream(); + + if (type_of(s) != t_base_string || !s->base_string.hasfillp) + FEerror("~S is not a base-string with a fill-pointer.", 1, s); + strm->stream.ops = duplicate_dispatch_table(&str_out_ops); + strm->stream.mode = (short)smm_string_output; + STRING_OUTPUT_STRING(strm) = s; + STRING_OUTPUT_COLUMN(strm) = 0; + strm->stream.char_stream_p = 1; + strm->stream.byte_size = 8; + strm->stream.signed_bytes = 0; + @(return strm) +} + +cl_object +ecl_make_string_output_stream(cl_index line_length) +{ + cl_object s = cl_alloc_adjustable_base_string(line_length); + return si_make_string_output_stream_from_string(s); +} + +@(defun make-string-output-stream (&key (element_type @'base-char')) +@ + if (Null(funcall(3, @'subtypep', element_type, @'character'))) { + FEerror("In MAKE-STRING-OUTPUT-STREAM, the argument :ELEMENT-TYPE (~A) must be a subtype of character", + 1, element_type); + } + @(return ecl_make_string_output_stream(128)) +@) + +cl_object +cl_get_output_stream_string(cl_object strm) +{ + cl_object strng; + if (type_of(strm) != t_stream || + (enum ecl_smmode)strm->stream.mode != smm_string_output) + FEerror("~S is not a string-output stream.", 1, strm); + strng = si_copy_to_simple_base_string(STRING_OUTPUT_STRING(strm)); + STRING_OUTPUT_STRING(strm)->base_string.fillp = 0; + @(return strng) +} + +/********************************************************************** + * STRING INPUT STREAMS + */ + +#define str_in_read_byte8 not_binary_read_byte8 +#define str_in_write_byte8 not_output_write_byte8 + +static int +str_in_read_char(cl_object strm) +{ + int c = strm->stream.unread; + if (c != EOF) { + strm->stream.unread = EOF; + } else { + cl_fixnum curr_pos = STRING_INPUT_POSITION(strm); + if (curr_pos >= STRING_INPUT_LIMIT(strm)) { + c = EOF; + } else { + c = STRING_INPUT_STRING(strm)->base_string.self[curr_pos]; + STRING_INPUT_POSITION(strm) = curr_pos+1; + } + } + return c; +} + +#define str_in_write_char not_output_write_char + +static void +str_in_unread_char(cl_object strm, int c) +{ + cl_fixnum curr_pos = STRING_INPUT_POSITION(strm); + if (c <= 0) { + unread_error(strm); + } + generic_unread_char(strm, c); +} + +static int +str_in_peek_char(cl_object strm) +{ + cl_index pos = STRING_INPUT_POSITION(strm); + if (pos >= STRING_INPUT_LIMIT(strm)) { + return EOF; + } else { + return STRING_INPUT_STRING(strm)->base_string.self[pos]; + } +} +#define str_in_peek_char generic_peek_char + +static int +str_in_listen(cl_object strm) +{ + if (strm->stream.unread != EOF) + return ECL_LISTEN_AVAILABLE; + if (STRING_INPUT_POSITION(strm) < STRING_INPUT_LIMIT(strm)) + return ECL_LISTEN_AVAILABLE; + else + return ECL_LISTEN_EOF; +} + +#define str_in_clear_input generic_void +#define str_in_clear_output not_output_clear_output +#define str_in_force_output not_output_force_output +#define str_in_finish_output not_output_finish_output +#define str_in_input_p generic_always_true +#define str_in_output_p generic_always_false + +static cl_object +str_in_element_type(cl_object strm) +{ + cl_object string = STRING_INPUT_STRING(strm); + if (type_of(string) == t_base_string) + return @'base-char'; + return @'character'; +} + +#define str_in_length not_a_file_stream + +static cl_object +str_in_get_position(cl_object strm) +{ + return ecl_make_unsigned_integer(STRING_INPUT_POSITION(strm)); +} + +static cl_object +str_in_set_position(cl_object strm, cl_object pos) +{ + cl_fixnum disp = fixnnint(pos); + if (disp >= STRING_INPUT_LIMIT(strm)) { + disp = STRING_INPUT_LIMIT(strm); + } + STRING_INPUT_POSITION(strm) = disp; + return Ct; +} + +#define str_in_column generic_column +#define str_in_close generic_close + +const struct ecl_file_ops str_in_ops = { + str_in_write_byte8, + str_in_read_byte8, + + str_in_read_char, + str_in_write_char, + str_in_unread_char, + str_in_peek_char, + + generic_read_vector, + generic_write_vector, + + str_in_listen, + str_in_clear_input, + str_in_clear_output, + str_in_finish_output, + str_in_force_output, + + str_in_input_p, + str_in_output_p, + generic_always_false, + str_in_element_type, + + str_in_length, + str_in_get_position, + str_in_set_position, + str_in_column, + str_in_close +}; + +cl_object +ecl_make_string_input_stream(cl_object strng, cl_index istart, cl_index iend) +{ + cl_object strm; + + strm = alloc_stream(); + strm->stream.ops = duplicate_dispatch_table(&str_in_ops); + strm->stream.mode = (short)smm_string_input; + STRING_INPUT_STRING(strm) = strng; + STRING_INPUT_POSITION(strm) = istart; + STRING_INPUT_LIMIT(strm) = iend; + strm->stream.char_stream_p = 1; + strm->stream.byte_size = 8; + strm->stream.signed_bytes = 0; + return strm; +} + +@(defun make_string_input_stream (strng &o istart iend) + cl_index s, e; +@ + strng = si_coerce_to_base_string(strng); +#ifdef ECL_UNICODE + if (type_of(strng) == t_string) { + FEerror("Reading from extended strings is not supported: ~A", + 1, strng); + } +#endif + if (Null(istart)) + s = 0; + else if (!FIXNUMP(istart) || FIXNUM_MINUSP(istart)) + goto E; + else + s = (cl_index)fix(istart); + if (Null(iend)) + e = strng->base_string.fillp; + else if (!FIXNUMP(iend) || FIXNUM_MINUSP(iend)) + goto E; + else + e = (cl_index)fix(iend); + if (e > strng->base_string.fillp || s > e) + goto E; + @(return (ecl_make_string_input_stream(strng, s, e))) + +E: + FEerror("~S and ~S are illegal as :START and :END~%\ +for the string ~S.", + 3, istart, iend, strng); +@) + +/********************************************************************** + * TWO WAY STREAM + */ + +static cl_index +two_way_read_byte8(cl_object strm, char *c, cl_index n) +{ + if (strm == cl_core.terminal_io) + ecl_force_output(TWO_WAY_STREAM_OUTPUT(cl_core.terminal_io)); + return ecl_read_byte8(TWO_WAY_STREAM_INPUT(strm), c, n); +} + +static cl_index +two_way_write_byte8(cl_object strm, char *c, cl_index n) +{ + return ecl_write_byte8(TWO_WAY_STREAM_OUTPUT(strm), c, n); +} + +static int +two_way_read_char(cl_object strm) +{ + return ecl_read_char(TWO_WAY_STREAM_INPUT(strm)); +} + +static int +two_way_write_char(cl_object strm, int c) +{ + return ecl_write_char(c, TWO_WAY_STREAM_OUTPUT(strm)); +} + +static void +two_way_unread_char(cl_object strm, int c) +{ + return ecl_unread_char(c, TWO_WAY_STREAM_INPUT(strm)); +} + +static int +two_way_peek_char(cl_object strm) +{ + return ecl_peek_char(TWO_WAY_STREAM_INPUT(strm)); +} + +static cl_index +two_way_read_vector(cl_object strm, cl_object data, cl_index start, cl_index n) +{ + strm = TWO_WAY_STREAM_INPUT(strm); + return stream_dispatch_table(strm)->read_vector(strm, data, start, n); +} + +static cl_index +two_way_write_vector(cl_object strm, cl_object data, cl_index start, cl_index n) +{ + strm = TWO_WAY_STREAM_OUTPUT(strm); + return stream_dispatch_table(strm)->write_vector(strm, data, start, n); +} + +static int +two_way_listen(cl_object strm) +{ + return ecl_listen_stream(TWO_WAY_STREAM_INPUT(strm)); +} + +static void +two_way_clear_input(cl_object strm) +{ + return ecl_clear_input(TWO_WAY_STREAM_INPUT(strm)); +} + +static void +two_way_clear_output(cl_object strm) +{ + return ecl_clear_output(TWO_WAY_STREAM_OUTPUT(strm)); +} + +static void +two_way_force_output(cl_object strm) +{ + return ecl_force_output(TWO_WAY_STREAM_OUTPUT(strm)); +} + +static void +two_way_finish_output(cl_object strm) +{ + return ecl_finish_output(TWO_WAY_STREAM_OUTPUT(strm)); +} + +#define two_way_input_p generic_always_true +#define two_way_output_p generic_always_true + +static int +two_way_interactive_p(cl_object strm) +{ + return ecl_interactive_stream_p(TWO_WAY_STREAM_INPUT(strm)); +} + +static cl_object +two_way_element_type(cl_object strm) +{ + return ecl_stream_element_type(TWO_WAY_STREAM_INPUT(strm)); +} + +#define two_way_length not_a_file_stream +#define two_way_get_position generic_always_nil +#define two_way_set_position generic_set_position + +static int +two_way_column(cl_object strm) +{ + return ecl_file_column(TWO_WAY_STREAM_OUTPUT(strm)); +} + +#define two_way_close generic_close + +const struct ecl_file_ops two_way_ops = { + two_way_write_byte8, + two_way_read_byte8, + + two_way_read_char, + two_way_write_char, + two_way_unread_char, + two_way_peek_char, + + two_way_read_vector, + two_way_write_vector, + + two_way_listen, + two_way_clear_input, + two_way_clear_output, + two_way_finish_output, + two_way_force_output, + + two_way_input_p, + two_way_output_p, + two_way_interactive_p, + two_way_element_type, + + two_way_length, + two_way_get_position, + two_way_set_position, + two_way_column, + two_way_close +}; + + +cl_object +cl_make_two_way_stream(cl_object istrm, cl_object ostrm) +{ + cl_object strm; + if (!ecl_input_stream_p(istrm)) + not_an_input_stream(istrm); + if (!ecl_output_stream_p(ostrm)) + not_an_output_stream(ostrm); + strm = alloc_stream(); + strm->stream.mode = (short)smm_two_way; + strm->stream.ops = duplicate_dispatch_table(&two_way_ops); + TWO_WAY_STREAM_INPUT(strm) = istrm; + TWO_WAY_STREAM_OUTPUT(strm) = ostrm; + @(return strm) +} + +cl_object +cl_two_way_stream_input_stream(cl_object strm) +{ + if (type_of(strm) != t_stream || strm->stream.mode != smm_two_way) + FEwrong_type_argument(@'two-way-stream', strm); + @(return TWO_WAY_STREAM_INPUT(strm)) +} + +cl_object +cl_two_way_stream_output_stream(cl_object strm) +{ + if (type_of(strm) != t_stream || strm->stream.mode != smm_two_way) + FEwrong_type_argument(@'two-way-stream', strm); + @(return TWO_WAY_STREAM_OUTPUT(strm)) +} + +/********************************************************************** + * BROADCAST STREAM + */ + +#define broadcast_read_byte8 not_input_read_byte8 + +static cl_index +broadcast_write_byte8(cl_object strm, char *c, cl_index n) +{ + cl_object l; + cl_index out = n; + for (l = BROADCAST_STREAM_LIST(strm); !ecl_endp(l); l = ECL_CONS_CDR(l)) { + out = ecl_write_byte8(ECL_CONS_CAR(l), c, n); + } + return out; +} + +#define broadcast_read_char not_input_read_char + +static int +broadcast_write_char(cl_object strm, int c) +{ + cl_object l; + for (l = BROADCAST_STREAM_LIST(strm); !ecl_endp(l); l = ECL_CONS_CDR(l)) { + ecl_write_char(c, ECL_CONS_CAR(l)); + } + return c; +} + +#define broadcast_unread_char not_input_unread_char +#define broadcast_peek_char not_input_read_char +#define broadcast_listen not_input_listen + +/* FIXME! This is legacy behaviour */ +#define broadcast_clear_input broadcast_force_output + +static void +broadcast_clear_output(cl_object strm) +{ + cl_object l; + for (l = BROADCAST_STREAM_LIST(strm); !ecl_endp(l); l = ECL_CONS_CDR(l)) { + ecl_clear_output(ECL_CONS_CAR(l)); + } +} + +static void +broadcast_force_output(cl_object strm) +{ + cl_object l; + for (l = BROADCAST_STREAM_LIST(strm); !ecl_endp(l); l = ECL_CONS_CDR(l)) { + ecl_force_output(ECL_CONS_CAR(l)); + } +} + +static void +broadcast_finish_output(cl_object strm) +{ + cl_object l; + for (l = BROADCAST_STREAM_LIST(strm); !ecl_endp(l); l = ECL_CONS_CDR(l)) { + ecl_finish_output(ECL_CONS_CAR(l)); + } +} + +#define broadcast_input_p generic_always_false +#define broadcast_output_p generic_always_true + +static cl_object +broadcast_element_type(cl_object strm) +{ + cl_object l = BROADCAST_STREAM_LIST(strm); + if (Null(l)) + return Ct; + return ecl_stream_element_type(ECL_CONS_CAR(l)); +} + +static cl_object +broadcast_length(cl_object strm) +{ + cl_object l = BROADCAST_STREAM_LIST(strm); + if (Null(l)) + return MAKE_FIXNUM(0); + return ecl_file_length(ECL_CONS_CAR(l)); +} + +static cl_object +broadcast_get_position(cl_object strm) +{ + cl_object l = BROADCAST_STREAM_LIST(strm); + if (Null(l)) + return MAKE_FIXNUM(0); + return ecl_file_position(ECL_CONS_CAR(l)); +} + +static cl_object +broadcast_set_position(cl_object strm, cl_object pos) +{ + cl_object l = BROADCAST_STREAM_LIST(strm); + if (Null(l)) + return Cnil; + return ecl_file_position_set(ECL_CONS_CAR(l), pos); +} + +static int +broadcast_column(cl_object strm) +{ + cl_object l = BROADCAST_STREAM_LIST(strm); + if (Null(l)) + return 0; + return ecl_file_column(ECL_CONS_CAR(l)); +} + +#define broadcast_close generic_close + +const struct ecl_file_ops broadcast_ops = { + broadcast_write_byte8, + broadcast_read_byte8, + + broadcast_read_char, + broadcast_write_char, + broadcast_unread_char, + broadcast_peek_char, + + generic_read_vector, + generic_write_vector, + + broadcast_listen, + broadcast_clear_input, + broadcast_clear_output, + broadcast_finish_output, + broadcast_force_output, + + broadcast_input_p, + broadcast_output_p, + generic_always_false, + broadcast_element_type, + + broadcast_length, + broadcast_get_position, + broadcast_set_position, + broadcast_column, + broadcast_close +}; + +@(defun make_broadcast_stream (&rest ap) + cl_object x, streams; + int i; +@ + streams = Cnil; + for (i = 0; i < narg; i++) { + x = cl_va_arg(ap); + if (!ecl_output_stream_p(x)) + not_an_output_stream(x); + streams = CONS(x, streams); + } + x = alloc_stream(); + x->stream.ops = duplicate_dispatch_table(&broadcast_ops); + x->stream.mode = (short)smm_broadcast; + BROADCAST_STREAM_LIST(x) = cl_nreverse(streams); + @(return x) +@) + +cl_object +cl_broadcast_stream_streams(cl_object strm) +{ + if (type_of(strm) != t_stream || strm->stream.mode != smm_broadcast) + FEwrong_type_argument(@'broadcast-stream', strm); + return cl_copy_list(BROADCAST_STREAM_LIST(strm)); +} + +/********************************************************************** + * ECHO STREAM + */ + +static cl_index +echo_read_byte8(cl_object strm, char *c, cl_index n) +{ + cl_index out = ecl_read_byte8(ECHO_STREAM_INPUT(strm), c, n); + return ecl_write_byte8(ECHO_STREAM_OUTPUT(strm), c, out); +} + +static cl_index +echo_write_byte8(cl_object strm, char *c, cl_index n) +{ + return ecl_write_byte8(ECHO_STREAM_OUTPUT(strm), c, n); +} + +static int +echo_read_char(cl_object strm) +{ + int c = strm->stream.unread; + if (c == EOF) { + c = ecl_read_char(ECHO_STREAM_INPUT(strm)); + if (c != EOF) + ecl_write_char(c, ECHO_STREAM_OUTPUT(strm)); + } else { + strm->stream.unread = EOF; + } + return c; +} + +static int +echo_write_char(cl_object strm, int c) +{ + return ecl_write_char(c, ECHO_STREAM_OUTPUT(strm)); +} + +#define echo_unread_char generic_unread_char + +static int +echo_peek_char(cl_object strm) +{ + int c = strm->stream.unread; + if (c == EOF) { + c = ecl_peek_char(ECHO_STREAM_INPUT(strm)); + } + return c; +} + +static int +echo_listen(cl_object strm) +{ + return ecl_listen_stream(ECHO_STREAM_INPUT(strm)); +} + +static void +echo_clear_input(cl_object strm) +{ + return ecl_clear_input(ECHO_STREAM_INPUT(strm)); +} + +static void +echo_clear_output(cl_object strm) +{ + return ecl_clear_output(ECHO_STREAM_OUTPUT(strm)); +} + +static void +echo_force_output(cl_object strm) +{ + return ecl_force_output(ECHO_STREAM_OUTPUT(strm)); +} + +static void +echo_finish_output(cl_object strm) +{ + return ecl_finish_output(ECHO_STREAM_OUTPUT(strm)); +} + +#define echo_input_p generic_always_true +#define echo_output_p generic_always_true + +static cl_object +echo_element_type(cl_object strm) +{ + return ecl_stream_element_type(ECHO_STREAM_INPUT(strm)); +} + +#define echo_length not_a_file_stream +#define echo_get_position generic_always_nil +#define echo_set_position generic_set_position + +static int +echo_column(cl_object strm) +{ + return ecl_file_column(ECHO_STREAM_OUTPUT(strm)); +} + +#define echo_close generic_close + +const struct ecl_file_ops echo_ops = { + echo_write_byte8, + echo_read_byte8, + + echo_read_char, + echo_write_char, + echo_unread_char, + echo_peek_char, + + generic_read_vector, + generic_write_vector, + + echo_listen, + echo_clear_input, + echo_clear_output, + echo_finish_output, + echo_force_output, + + echo_input_p, + echo_output_p, + generic_always_false, + echo_element_type, + + echo_length, + echo_get_position, + echo_set_position, + echo_column, + echo_close +}; + +cl_object +cl_make_echo_stream(cl_object strm1, cl_object strm2) +{ + cl_object strm; + if (!ecl_input_stream_p(strm1)) + not_an_input_stream(strm1); + if (!ecl_output_stream_p(strm2)) + not_an_output_stream(strm2); + strm = alloc_stream(); + strm->stream.mode = (short)smm_echo; + strm->stream.ops = duplicate_dispatch_table(&echo_ops); + ECHO_STREAM_INPUT(strm) = strm1; + ECHO_STREAM_OUTPUT(strm) = strm2; + @(return strm) +} + +cl_object +cl_echo_stream_input_stream(cl_object strm) +{ + if (type_of(strm) != t_stream || strm->stream.mode != smm_echo) + FEwrong_type_argument(@'echo-stream', strm); + @(return ECHO_STREAM_INPUT(strm)) +} + +cl_object +cl_echo_stream_output_stream(cl_object strm) +{ + if (type_of(strm) != t_stream || strm->stream.mode != smm_echo) + FEwrong_type_argument(@'echo-stream', strm); + @(return ECHO_STREAM_OUTPUT(strm)) +} + +/********************************************************************** + * CONCATENATED STREAM + */ + +static cl_index +concatenated_read_byte8(cl_object strm, char *c, cl_index n) +{ + cl_object l = CONCATENATED_STREAM_LIST(strm); + cl_index out = 0; + while (out < n && !ecl_endp(l)) { + cl_index left = n - out; + cl_index delta = ecl_read_byte8(ECL_CONS_CAR(l), c + out, n - out); + out += delta; + if (out == n) break; + CONCATENATED_STREAM_LIST(strm) = l = ECL_CONS_CDR(l); + } + return out; +} + +#define concatenated_write_byte8 not_output_write_byte8 + +static int +concatenated_read_char(cl_object strm) +{ + cl_object l = CONCATENATED_STREAM_LIST(strm); + int c = EOF; + while (!ecl_endp(l)) { + c = ecl_read_char(ECL_CONS_CAR(l)); + if (c != EOF) break; + CONCATENATED_STREAM_LIST(strm) = l = ECL_CONS_CDR(l); + } + return c; +} + +#define concatenated_write_char not_output_write_char + +static void +concatenated_unread_char(cl_object strm, int c) +{ + cl_object l = CONCATENATED_STREAM_LIST(strm); + if (Null(l)) + unread_error(strm); + return ecl_unread_char(c, ECL_CONS_CAR(l)); +} + +#define concatenated_peek_char generic_peek_char + +static int +concatenated_listen(cl_object strm) +{ + cl_object l = CONCATENATED_STREAM_LIST(strm); + while (!ecl_endp(l)) { + int f = ecl_listen_stream(ECL_CONS_CAR(l)); + l = ECL_CONS_CDR(l); + if (f == ECL_LISTEN_EOF) { + CONCATENATED_STREAM_LIST(strm) = l; + } else { + return f; + } + } + return ECL_LISTEN_EOF; +} + +#define concatenated_clear_input generic_void +#define concatenated_clear_output not_output_clear_output +#define concatenated_force_output not_output_force_output +#define concatenated_finish_output not_output_finish_output + +#define concatenated_input_p generic_always_true +#define concatenated_output_p generic_always_false +#define concatenated_element_type broadcast_element_type + +#define concatenated_length not_a_file_stream +#define concatenated_get_position generic_always_nil +#define concatenated_set_position generic_set_position +#define concatenated_column generic_column + +#define concatenated_close generic_close + +const struct ecl_file_ops concatenated_ops = { + concatenated_write_byte8, + concatenated_read_byte8, + + concatenated_read_char, + concatenated_write_char, + concatenated_unread_char, + concatenated_peek_char, + + generic_read_vector, + generic_write_vector, + + concatenated_listen, + concatenated_clear_input, + concatenated_clear_output, + concatenated_finish_output, + concatenated_force_output, + + concatenated_input_p, + concatenated_output_p, + generic_always_false, + concatenated_element_type, + + concatenated_length, + concatenated_get_position, + concatenated_set_position, + concatenated_column, + concatenated_close +}; + +@(defun make_concatenated_stream (&rest ap) + cl_object x, streams; + int i; +@ + streams = Cnil; + for (i = 0; i < narg; i++) { + x = cl_va_arg(ap); + if (!ecl_input_stream_p(x)) + not_an_input_stream(x); + streams = CONS(x, streams); + } + x = alloc_stream(); + x->stream.mode = (short)smm_concatenated; + x->stream.ops = duplicate_dispatch_table(&concatenated_ops); + CONCATENATED_STREAM_LIST(x) = cl_nreverse(streams); + @(return x) +@) + +cl_object +cl_concatenated_stream_streams(cl_object strm) +{ + if (type_of(strm) != t_stream || strm->stream.mode != smm_concatenated) + FEwrong_type_argument(@'concatenated-stream', strm); + return cl_copy_list(CONCATENATED_STREAM_LIST(strm)); +} + +/********************************************************************** + * SYNONYM STREAM + */ + +static cl_index +synonym_read_byte8(cl_object strm, char *c, cl_index n) +{ + return ecl_read_byte8(SYNONYM_STREAM_STREAM(strm), c, n); +} + +static cl_index +synonym_write_byte8(cl_object strm, char *c, cl_index n) +{ + return ecl_write_byte8(SYNONYM_STREAM_STREAM(strm), c, n); +} + +static int +synonym_read_char(cl_object strm) +{ + return ecl_read_char(SYNONYM_STREAM_STREAM(strm)); +} + +static int +synonym_write_char(cl_object strm, int c) +{ + return ecl_write_char(c, SYNONYM_STREAM_STREAM(strm)); +} + +static void +synonym_unread_char(cl_object strm, int c) +{ + return ecl_unread_char(c, SYNONYM_STREAM_STREAM(strm)); +} + +static int +synonym_peek_char(cl_object strm) +{ + return ecl_peek_char(SYNONYM_STREAM_STREAM(strm)); +} + +static cl_index +synonym_read_vector(cl_object strm, cl_object data, cl_index start, cl_index n) +{ + strm = SYNONYM_STREAM_STREAM(strm); + return stream_dispatch_table(strm)->read_vector(strm, data, start, n); +} + +static cl_index +synonym_write_vector(cl_object strm, cl_object data, cl_index start, cl_index n) +{ + strm = SYNONYM_STREAM_STREAM(strm); + return stream_dispatch_table(strm)->write_vector(strm, data, start, n); +} + +static int +synonym_listen(cl_object strm) +{ + return ecl_listen_stream(SYNONYM_STREAM_STREAM(strm)); +} + +static void +synonym_clear_input(cl_object strm) +{ + return ecl_clear_input(SYNONYM_STREAM_STREAM(strm)); +} + +static void +synonym_clear_output(cl_object strm) +{ + return ecl_clear_output(SYNONYM_STREAM_STREAM(strm)); +} + +static void +synonym_force_output(cl_object strm) +{ + return ecl_force_output(SYNONYM_STREAM_STREAM(strm)); +} + +static void +synonym_finish_output(cl_object strm) +{ + return ecl_finish_output(SYNONYM_STREAM_STREAM(strm)); +} + +static int +synonym_input_p(cl_object strm) +{ + return ecl_input_stream_p(SYNONYM_STREAM_STREAM(strm)); +} + +static int +synonym_output_p(cl_object strm) +{ + return ecl_output_stream_p(SYNONYM_STREAM_STREAM(strm)); +} + +static int +synonym_interactive_p(cl_object strm) +{ + return ecl_interactive_stream_p(SYNONYM_STREAM_STREAM(strm)); +} + +static cl_object +synonym_element_type(cl_object strm) +{ + return ecl_stream_element_type(SYNONYM_STREAM_STREAM(strm)); +} + +static cl_object +synonym_length(cl_object strm) +{ + return ecl_file_length(SYNONYM_STREAM_STREAM(strm)); +} + +static cl_object +synonym_get_position(cl_object strm) +{ + return ecl_file_position(SYNONYM_STREAM_STREAM(strm)); +} + +static cl_object +synonym_set_position(cl_object strm, cl_object pos) +{ + return ecl_file_position_set(SYNONYM_STREAM_STREAM(strm), pos); +} + +static int +synonym_column(cl_object strm) +{ + return ecl_file_column(SYNONYM_STREAM_STREAM(strm)); +} + +#define synonym_close generic_close + +const struct ecl_file_ops synonym_ops = { + synonym_write_byte8, + synonym_read_byte8, + + synonym_read_char, + synonym_write_char, + synonym_unread_char, + synonym_peek_char, + + synonym_read_vector, + synonym_write_vector, + + synonym_listen, + synonym_clear_input, + synonym_clear_output, + synonym_finish_output, + synonym_force_output, + + synonym_input_p, + synonym_output_p, + synonym_interactive_p, + synonym_element_type, + + synonym_length, + synonym_get_position, + synonym_set_position, + synonym_column, + synonym_close +}; + +cl_object +cl_make_synonym_stream(cl_object sym) { cl_object x; - cl_object output = @'base-char'; -BEGIN: -#ifdef ECL_CLOS_STREAMS - if (ECL_INSTANCEP(strm)) - return funcall(2, @'gray::stream-element-type', strm); + + sym = ecl_check_cl_type(@'make-synonym-stream',sym,t_symbol); + x = alloc_stream(); + x->stream.ops = duplicate_dispatch_table(&synonym_ops); + x->stream.mode = (short)smm_synonym; + SYNONYM_STREAM_SYMBOL(x) = sym; + @(return x) +} + +cl_object +cl_synonym_stream_symbol(cl_object strm) +{ + if (type_of(strm) != t_stream || strm->stream.mode != smm_synonym) + FEwrong_type_argument(@'synonym-stream', strm); + @(return SYNONYM_STREAM_SYMBOL(strm)) +} + +/********************************************************************** + * TWO WAY STREAM + */ + +static cl_index +io_stream_read_byte8(cl_object strm, char *c, cl_index n) +{ + FILE *f = IO_STREAM_FILE(strm); + cl_index out; + if (strm->stream.mode == smm_io) + io_stream_begin_write(strm); + ecl_disable_interrupts(); + do { + out = fread(c, sizeof(char), n, IO_STREAM_FILE(strm)); + } while (out < n && ferror(f) && restartable_io_error(strm)); + ecl_enable_interrupts(); + return out; +} + +static cl_index +io_stream_write_byte8(cl_object strm, char *c, cl_index n) +{ + FILE *f = IO_STREAM_FILE(strm); + cl_index out; + if (strm->stream.mode == smm_io) + io_stream_begin_write(strm); + ecl_disable_interrupts(); + do { + out = fwrite(c, sizeof(char), n, IO_STREAM_FILE(strm)); + } while (out < n && restartable_io_error(strm)); + ecl_enable_interrupts(); + return out; +} + +static int +io_stream_read_char(cl_object strm) +{ + int c = strm->stream.unread; + if (c != EOF) { + strm->stream.unread = EOF; + } else { + FILE *f = IO_STREAM_FILE(strm); + char aux; + ecl_disable_interrupts(); + do { + c = getc(f); + } while ((c == EOF) && ferror(f) && restartable_io_error(strm)); + ecl_enable_interrupts(); + } + return c; +} + +static int +io_stream_write_char(cl_object strm, int c) +{ + FILE *f = IO_STREAM_FILE(strm); + char aux = c; + int outcome; + strm->stream.unread = EOF; + if (c == '\n') + IO_STREAM_COLUMN(strm) = 0; + else if (c == '\t') + IO_STREAM_COLUMN(strm) = (IO_STREAM_COLUMN(strm)&~07) + 8; + else + IO_STREAM_COLUMN(strm)++; + ecl_disable_interrupts(); + do { + outcome = putc(c, f); + } while (outcome == EOF && restartable_io_error(strm)); + ecl_enable_interrupts(); + return c; +} + +static void +io_stream_unread_char(cl_object strm, int c) +{ + if (strm->stream.unread != EOF) { + unread_twice(strm); + } + strm->stream.unread = c; +} + +#define io_stream_peek_char generic_peek_char + +static int +io_stream_listen(cl_object strm) +{ + FILE *f = IO_STREAM_FILE(strm); + return flisten(f); +} + +static void +io_stream_clear_input(cl_object strm) +{ + FILE *f = IO_STREAM_FILE(strm); +#if defined(mingw32) || defined(_MSC_VER) + if (isatty(fileno(fp))) { + /* Flushes Win32 console */ + if (!FlushConsoleInputBuffer((HANDLE)_get_osfhandle(fileno(fp)))) + FEwin32_error("FlushConsoleInputBuffer() failed", 0); + /* Do not stop here: the FILE structure needs also to be flushed */ + } #endif - if (type_of(strm) != t_stream) - FEtype_error_stream(strm); - if (strm->stream.closed) - FEclosed_stream(strm); - switch ((enum ecl_smmode)strm->stream.mode) { + while (flisten(f) == ECL_LISTEN_AVAILABLE) { + ecl_disable_interrupts(); + getc(f); + ecl_enable_interrupts(); + } +} + +#define io_stream_clear_output generic_void + +static void +io_stream_force_output(cl_object strm) +{ + FILE *f = IO_STREAM_FILE(strm); + ecl_disable_interrupts(); + while ((fflush(f) == EOF) && restartable_io_error(strm)) + (void)0; + ecl_enable_interrupts(); +} + +#define io_stream_finish_output generic_void +#define io_stream_input_p generic_always_true +#define io_stream_output_p generic_always_true + +static int +io_stream_interactive_p(cl_object strm) +{ + FILE *f = IO_STREAM_FILE(strm); + return isatty(fileno(f)); +} + +static cl_object +io_stream_element_type(cl_object strm) +{ + cl_object output; + if (strm->stream.char_stream_p) { + output = @'base-char'; + } else { + cl_fixnum bs = strm->stream.byte_size; + output = strm->stream.signed_bytes? + @'signed-byte' : @'unsigned-byte'; + if (bs != 8) + output = cl_list(2, output, MAKE_FIXNUM(bs)); + } + return output; +} + +static cl_object +io_stream_length(cl_object strm) +{ + FILE *f = IO_STREAM_FILE(strm); + cl_object output = ecl_file_len(f); + if (strm->stream.byte_size != 8) { + cl_index bs = strm->stream.byte_size; + output = ecl_floor2(output, MAKE_FIXNUM(bs/8)); + if (VALUES(1) != MAKE_FIXNUM(0)) { + FEerror("File length is not on byte boundary", 0); + } + } + return output; +} + +static cl_object +io_stream_get_position(cl_object strm) +{ + FILE *f = IO_STREAM_FILE(strm); + cl_object output; + ecl_off_t offset; + + ecl_disable_interrupts(); + offset = ecl_ftello(f); + ecl_enable_interrupts(); + if (offset < 0) + io_error(strm); + if (sizeof(ecl_off_t) == sizeof(long)) { + output = ecl_make_integer(offset); + } else { + output = ecl_off_t_to_integer(offset); + } + if (strm->stream.byte_size != 8) { + output = ecl_floor2(output, MAKE_FIXNUM(strm->stream.byte_size / 8)); + } + return output; +} + +static cl_object +io_stream_set_position(cl_object strm, cl_object large_disp) +{ + FILE *f = IO_STREAM_FILE(strm); + ecl_off_t disp; + cl_object output; + if (strm->stream.byte_size != 8) { + large_disp = ecl_times(large_disp, + MAKE_FIXNUM(strm->stream.byte_size / 8)); + } + disp = ecl_integer_to_off_t(large_disp); + ecl_disable_interrupts(); + if (ecl_fseeko(f, disp, 0) != 0) + output = Cnil; + else + output = Ct; + ecl_enable_interrupts(); + return output; +} + +static int +io_stream_column(cl_object strm) +{ + return IO_STREAM_COLUMN(strm); +} + +static cl_object +io_stream_close(cl_object strm) +{ + FILE *f = IO_STREAM_FILE(strm); + int failed; + if (f == stdout) + FEerror("Cannot close the standard output", 0); + if (f == stdin) + FEerror("Cannot close the standard input", 0); + if (f == NULL) + wrong_file_handler(strm); + if (ecl_output_stream_p(strm)) { + ecl_force_output(strm); + } + ecl_disable_interrupts(); + failed = fclose(f); + ecl_enable_interrupts(); + if (failed) + FElibc_error("Cannot close stream ~S.", 1, strm); +#if !defined(GBC_BOEHM) + ecl_dealloc(strm->stream.buffer); + strm->stream.file = NULL; +#endif + return generic_close(strm); +} + +/* + * Specialized sequence operations + */ + +static cl_index +io_stream_read_vector(cl_object strm, cl_object data, cl_index start, cl_index end) +{ + cl_elttype t = data->vector.elttype; + if (start >= end) + return start; + if (t == aet_b8 || t == aet_i8 || t == aet_bc) { + if (strm->stream.byte_size == 8) { + void *aux = data->vector.self.ch + start; + return io_stream_read_byte8(strm, aux, end-start); + } + } + if (t == aet_fix || t == aet_index) { + if (strm->stream.byte_size == sizeof(cl_fixnum)*8) { + void *aux = data->vector.self.fix + start; + cl_index bytes = (end - start) * sizeof(cl_fixnum); + bytes = io_stream_read_byte8(strm, aux, bytes); + return start + bytes / sizeof(cl_fixnum); + } + } + return generic_read_vector(strm, data, start, end); +} + +static cl_index +io_stream_write_vector(cl_object strm, cl_object data, cl_index start, cl_index end) +{ + cl_elttype t = data->vector.elttype; + if (start >= end) + return start; + if (t == aet_b8 || t == aet_i8 || t == aet_bc) { + if (strm->stream.byte_size == 8) { + void *aux = data->vector.self.fix + start; + return io_stream_write_byte8(strm, aux, end-start); + } + } + if (t == aet_fix || t == aet_index) { + if (strm->stream.byte_size == sizeof(cl_fixnum)*8) { + void *aux = data->vector.self.fix + start; + cl_index bytes = (end - start) * sizeof(cl_fixnum); + bytes = io_stream_write_byte8(strm, aux, bytes); + return start + bytes / sizeof(cl_fixnum); + } + } + return generic_write_vector(strm, data, start, end); +} + +const struct ecl_file_ops io_stream_ops = { + io_stream_write_byte8, + io_stream_read_byte8, + + io_stream_read_char, + io_stream_write_char, + io_stream_unread_char, + io_stream_peek_char, + + io_stream_read_vector, + io_stream_write_vector, + + io_stream_listen, + io_stream_clear_input, + io_stream_clear_output, + io_stream_finish_output, + io_stream_force_output, + + io_stream_input_p, + io_stream_output_p, + io_stream_interactive_p, + io_stream_element_type, + + io_stream_length, + io_stream_get_position, + io_stream_set_position, + io_stream_column, + io_stream_close +}; + +const struct ecl_file_ops output_stream_ops = { + io_stream_write_byte8, + not_input_read_byte8, + + not_input_read_char, + io_stream_write_char, + not_input_unread_char, + not_input_read_char, + + generic_read_vector, + io_stream_write_vector, + + not_input_listen, + generic_void, + io_stream_clear_output, + io_stream_finish_output, + io_stream_force_output, + + generic_always_false, + io_stream_output_p, + generic_always_false, + io_stream_element_type, + + io_stream_length, + io_stream_get_position, + io_stream_set_position, + io_stream_column, + io_stream_close +}; + +const struct ecl_file_ops input_stream_ops = { + not_output_write_byte8, + io_stream_read_byte8, + + io_stream_read_char, + not_output_write_char, + io_stream_unread_char, + io_stream_peek_char, + + io_stream_read_vector, + generic_write_vector, + + io_stream_listen, + io_stream_clear_input, + generic_void, + generic_void, + generic_void, + + io_stream_input_p, + generic_always_false, + io_stream_interactive_p, + io_stream_element_type, + + io_stream_length, + io_stream_get_position, + io_stream_set_position, + generic_column, + io_stream_close +}; + +cl_object +si_set_buffering_mode(cl_object stream, cl_object buffer_mode_symbol) +{ + enum ecl_smmode mode = stream->stream.mode; + int buffer_mode; + + if (type_of(stream) != t_stream) { + FEerror("Cannot set buffer of ~A", 1, stream); + } + if (buffer_mode_symbol == Cnil) { + buffer_mode = _IONBF; + } else if (buffer_mode_symbol == Ct || buffer_mode_symbol == @':fully-buffered') { + buffer_mode = _IOFBF; + } else if (buffer_mode_symbol == @':line-buffered') { + buffer_mode = _IOLBF; + } else { + FEerror("Not a valid buffering mode: ~A", 1, buffer_mode_symbol); + } + if (mode == smm_output || mode == smm_io || mode == smm_input) { + FILE *fp = (FILE*)stream->stream.file; + char *new_buffer = 0; + setvbuf(fp, 0, _IONBF, 0); + if (buffer_mode != _IONBF) { + cl_index buffer_size = BUFSIZ; + char *new_buffer = ecl_alloc_atomic(buffer_size); + stream->stream.buffer = new_buffer; + setvbuf(fp, new_buffer, buffer_mode, buffer_size); + } + } + @(return stream) +} + +cl_object +ecl_make_stream_from_FILE(cl_object fname, void *f, enum ecl_smmode smm, + cl_fixnum byte_size, int char_stream_p) +{ + cl_object stream; + stream = alloc_stream(); + stream->stream.mode = (short)smm; + stream->stream.closed = 0; +#if defined (ECL_WSOCK) + if (smm == smm_input_wsock || smm == smm_io_wsock) + character_p = 1; +#endif + switch (smm) { + case smm_io: + stream->stream.ops = duplicate_dispatch_table(&io_stream_ops); + break; + case smm_probe: case smm_input: + stream->stream.ops = duplicate_dispatch_table(&input_stream_ops); + break; case smm_output: + stream->stream.ops = duplicate_dispatch_table(&output_stream_ops); + break; + default: + FEerror("Not a valid mode ~D for ecl_make_stream_from_FILE", 1, MAKE_FIXNUM(smm)); + } + if (char_stream_p) { + if (byte_size != 8) { + FEerror("Cannot create a character stream when byte size is not 8.", 0); + } + IO_STREAM_ELT_TYPE(stream) = @'base-char'; + } else { + IO_STREAM_ELT_TYPE(stream) = Cnil; + } + stream->stream.char_stream_p = char_stream_p; + if (byte_size > 0) { + stream->stream.signed_bytes = 0; + } else { + byte_size = -byte_size; + stream->stream.signed_bytes = 1; + } + stream->stream.byte_size = (byte_size+7)&(~(cl_fixnum)7); + IO_STREAM_FILENAME(stream) = fname; /* not really used */ + IO_STREAM_COLUMN(stream) = 0; + stream->stream.file = f; + stream->stream.last_op = 0; + si_set_finalizer(stream, Ct); + return stream; +} + +cl_object +ecl_make_stream_from_fd(cl_object fname, int fd, enum ecl_smmode smm, + cl_fixnum byte_size, int char_stream_p) +{ + char *mode; /* file open mode */ + FILE *fp; /* file pointer */ + switch(smm) { + case smm_input: + mode = "r"; + break; + case smm_output: + mode = "w"; + break; + case smm_io: + mode = "w+"; + break; #if defined(ECL_WSOCK) case smm_input_wsock: case smm_output_wsock: case smm_io_wsock: + break; #endif + default: + FEerror("make_stream: wrong mode", 0); + } + ecl_disable_interrupts(); +#if defined(ECL_WSOCK) + if (smm == smm_input_wsock || smm == smm_output_wsock || smm == smm_io_wsock) + fp = (FILE*)fd; + else + fp = fdopen(fd, mode); +#else + fp = fdopen(fd, mode); +#endif + ecl_enable_interrupts(); + return ecl_make_stream_from_FILE(fname, fp, smm, byte_size, char_stream_p); +} + +int +ecl_stream_to_handle(cl_object s, bool output) +{ + FILE *f; + BEGIN: + if (type_of(s) != t_stream) + return -1; + switch ((enum ecl_smmode)s->stream.mode) { + case smm_input: + if (output) return -1; + f = (FILE*)s->stream.file; + break; + case smm_output: + if (!output) return -1; + f = (FILE*)s->stream.file; + break; case smm_io: - if (strm->stream.char_stream_p) - output = @'base-char'; - else { - cl_fixnum bs = strm->stream.byte_size; - output = strm->stream.signed_bytes? - @'signed-byte' : @'unsigned-byte'; - if (bs != 8) - output = cl_list(2, output, MAKE_FIXNUM(bs)); - } + f = (FILE*)s->stream.file; break; case smm_synonym: - strm = ecl_symbol_value(strm->stream.object0); + s = SYNONYM_STREAM_STREAM(s); goto BEGIN; - - case smm_broadcast: - x = strm->stream.object0; - if (ecl_endp(x)) { - output = @'t'; - break; - } - strm = CAR(x); - goto BEGIN; - - case smm_concatenated: - x = strm->stream.object0; - if (ecl_endp(x)) - break; - strm = CAR(x); - goto BEGIN; - case smm_two_way: - case smm_echo: - strm = strm->stream.object0; + s = output? TWO_WAY_STREAM_OUTPUT(s) : TWO_WAY_STREAM_INPUT(s); goto BEGIN; - - case smm_string_input: - case smm_string_output: - break; - default: ecl_internal_error("illegal stream mode"); } + return fileno(f); +} + +/********************************************************************** + * MEDIUM LEVEL INTERFACE + */ + +struct ecl_file_ops * +duplicate_dispatch_table(const struct ecl_file_ops *ops) +{ + struct ecl_file_ops *new_ops = ecl_alloc_atomic(sizeof(*ops)); + *new_ops = *ops; + return new_ops; +} + +const struct ecl_file_ops * +stream_dispatch_table(cl_object strm) +{ +#ifdef ECL_CLOS_STREAMS + if (ECL_INSTANCEP(strm)) { + return &clos_stream_ops; + } +#endif + if (type_of(strm) != t_stream) + FEtype_error_stream(strm); + return (const struct ecl_file_ops *)strm->stream.ops; +} + +static cl_index +ecl_read_byte8(cl_object strm, char *c, cl_index n) +{ + return stream_dispatch_table(strm)->read_byte8(strm, c, n); +} + +static cl_index +ecl_write_byte8(cl_object strm, char *c, cl_index n) +{ + return stream_dispatch_table(strm)->write_byte8(strm, c, n); +} + +int +ecl_read_char(cl_object strm) +{ + return stream_dispatch_table(strm)->read_char(strm); +} + +int +ecl_read_char_noeof(cl_object strm) +{ + int c = ecl_read_char(strm); + if (c == EOF) + FEend_of_file(strm); + return c; +} + +cl_object +ecl_read_byte(cl_object strm) +{ + cl_index (*read_byte8)(cl_object, char *, cl_index); + cl_index bs; +#ifdef ECL_CLOS_STREAMS + if (ECL_INSTANCEP(strm)) { + return funcall(2, @'gray::stream-read-byte', strm); + } +#endif + read_byte8 = stream_dispatch_table(strm)->read_byte8; + bs = strm->stream.byte_size; + if (bs == 8) { + unsigned char c; + if (read_byte8(strm, (char*)&c, 1) < 1) + return Cnil; + if (strm->stream.signed_bytes) { + return MAKE_FIXNUM((signed char)c); + } else { + return MAKE_FIXNUM((unsigned char)c); + } + } else { + unsigned char c; + cl_index nb; + cl_object output = MAKE_FIXNUM(0); + for (nb = 0; bs >= 8; bs -= 8, nb += 8) { + cl_object aux; + if (read_byte8(strm, (char*)&c, 1) < 1) + return Cnil; + if (bs <= 8 && strm->stream.signed_bytes) + aux = MAKE_FIXNUM((signed char)c); + else + aux = MAKE_FIXNUM((unsigned char)c); + output = cl_logior(2, output, cl_ash(aux, MAKE_FIXNUM(nb))); + } + } +} + +void +ecl_write_byte(cl_object c, cl_object strm) +{ + cl_index (*write_byte8)(cl_object strm, char *c, cl_index n); + cl_index bs; + /* + * The first part is only for composite or complex streams. + */ +BEGIN: +#ifdef ECL_CLOS_STREAMS + if (ECL_INSTANCEP(strm)) { + funcall(3, @'gray::stream-write-byte', strm, c); + return; + } +#endif + write_byte8 = stream_dispatch_table(strm)->write_byte8; + bs = strm->stream.byte_size; + if (bs == 8) { + cl_fixnum i = (strm->stream.signed_bytes)? fixint(c) : fixnnint(c); + char c = (char)i; + write_byte8(strm, &c, 1); + } else do { + cl_object b = cl_logand(2, c, MAKE_FIXNUM(0xFF)); + char aux = (char)fix(b); + if (write_byte8(strm, &aux, 1) < 1) + break; + c = cl_ash(c, MAKE_FIXNUM(-8)); + bs -= 8; + } while (bs); +} + +int +ecl_write_char(int c, cl_object strm) +{ + return stream_dispatch_table(strm)->write_char(strm, c); +} + +void +ecl_unread_char(int c, cl_object strm) +{ + return stream_dispatch_table(strm)->unread_char(strm, c); +} + +int +ecl_listen_stream(cl_object strm) +{ + return stream_dispatch_table(strm)->listen(strm); +} + +void +ecl_clear_input(cl_object strm) +{ + return stream_dispatch_table(strm)->clear_input(strm); +} + +void +ecl_clear_output(cl_object strm) +{ + return stream_dispatch_table(strm)->clear_output(strm); +} + +void +ecl_force_output(cl_object strm) +{ + return stream_dispatch_table(strm)->force_output(strm); +} + +void +ecl_finish_output(cl_object strm) +{ + return stream_dispatch_table(strm)->finish_output(strm); +} + +int +ecl_file_column(cl_object strm) +{ + return stream_dispatch_table(strm)->column(strm); +} + +cl_object +ecl_file_length(cl_object strm) +{ + return stream_dispatch_table(strm)->length(strm); +} + +cl_object +ecl_file_position(cl_object strm) +{ + return stream_dispatch_table(strm)->get_position(strm); +} + +cl_object +ecl_file_position_set(cl_object strm, cl_object pos) +{ + return stream_dispatch_table(strm)->set_position(strm, pos); +} + +bool +ecl_input_stream_p(cl_object strm) +{ + return stream_dispatch_table(strm)->input_p(strm); +} + +bool +ecl_output_stream_p(cl_object strm) +{ + return stream_dispatch_table(strm)->output_p(strm); +} + +cl_object +ecl_stream_element_type(cl_object strm) +{ + return stream_dispatch_table(strm)->element_type(strm); +} + +int +ecl_interactive_stream_p(cl_object strm) +{ + return stream_dispatch_table(strm)->interactive_p(strm); +} + +/* + * ecl_read_char(s) tries to read a character from the stream S. It outputs + * either the code of the character read, or EOF. Whe compiled with + * CLOS-STREAMS and S is an instance object, STREAM-READ-CHAR is invoked + * to retrieve the character. Then STREAM-READ-CHAR should either + * output the character, or NIL, indicating EOF. + * + * INV: ecl_read_char(strm) checks the type of STRM. + */ +int +ecl_peek_char(cl_object strm) +{ + return stream_dispatch_table(strm)->peek_char(strm); +} + +/*******************************tl*************************************** + * SEQUENCES I/O + */ + +void +writestr_stream(const char *s, cl_object strm) +{ + while (*s != '\0') + ecl_write_char(*s++, strm); +} + +cl_object +cl_file_string_length(cl_object stream, cl_object string) +{ + cl_fixnum l; + /* This is a stupid requirement from the spec. Why returning 1??? + * Why not simply leaving the value unspecified, as with other + * streams one cannot write to??? + */ + if (type_of(stream) == t_stream && + stream->stream.mode == smm_broadcast) { + stream = BROADCAST_STREAM_LIST(stream); + if (ecl_endp(stream)) + @(return MAKE_FIXNUM(1)) + } + switch (type_of(string)) { + case t_base_string: + l = string->base_string.fillp; + break; + case t_character: + l = 1; + break; + default: + FEwrong_type_argument(@'string', string); + } + @(return MAKE_FIXNUM(l)) +} + +cl_object +si_do_write_sequence(cl_object seq, cl_object stream, cl_object s, cl_object e) +{ + cl_fixnum start,limit,end; + cl_type t; + + /* Since we have called ecl_length(), we know that SEQ is a valid + sequence. Therefore, we only need to check the type of the + object, and seq == Cnil i.f.f. t = t_symbol */ + limit = ecl_length(seq); + start = ecl_fixnum_in_range(@'write-sequence',"start",s,0,limit); + if (e == Cnil) { + end = limit; + } else { + end = ecl_fixnum_in_range(@'write-sequence',"end",e,0,limit); + } + if (end <= start) { + goto OUTPUT; + } + t = type_of(seq); + if (t == t_list) { + bool ischar = cl_stream_element_type(stream) == @'base-char'; + cl_object s = ecl_nthcdr(start, seq); + loop_for_in(s) { + if (start < end) { + cl_object elt = CAR(s); + if (ischar) + ecl_write_char(ecl_char_code(elt), stream); + else + ecl_write_byte(elt, stream); + start++; + } else { + goto OUTPUT; + } + } end_loop_for_in; + } else { + stream_dispatch_table(stream)-> + write_vector(stream, seq, start, end); + } + OUTPUT: + @(return seq); +} + +cl_object +si_do_read_sequence(cl_object seq, cl_object stream, cl_object s, cl_object e) +{ + cl_fixnum start,limit,end; + cl_type t; + + /* Since we have called ecl_length(), we know that SEQ is a valid + sequence. Therefore, we only need to check the type of the + object, and seq == Cnil i.f.f. t = t_symbol */ + limit = ecl_length(seq); + start = ecl_fixnum_in_range(@'read-sequence',"start",s,0,limit); + if (e == Cnil) { + end = limit; + } else { + end = ecl_fixnum_in_range(@'read-sequence',"end",e,0,limit); + } + if (end <= start) { + goto OUTPUT; + } + t = type_of(seq); + if (t == t_list) { + bool ischar = cl_stream_element_type(stream) == @'base-char'; + seq = ecl_nthcdr(start, seq); + loop_for_in(seq) { + if (start >= end) { + goto OUTPUT; + } else { + cl_object c; + if (ischar) { + int i = ecl_read_char(stream); + if (i < 0) goto OUTPUT; + c = CODE_CHAR(i); + } else { + c = ecl_read_byte(stream); + if (c == Cnil) goto OUTPUT; + } + ECL_RPLACA(seq, c); + start++; + } + } end_loop_for_in; + } else { + start = stream_dispatch_table(stream)-> + read_vector(stream, seq, start, end); + } + OUTPUT: + @(return MAKE_FIXNUM(start)) +} + +/********************************************************************** + * LISP LEVEL INTERFACE + */ + +cl_object +si_file_column(cl_object strm) +{ + @(return MAKE_FIXNUM(ecl_file_column(strm))) +} + +cl_object +cl_file_length(cl_object strm) +{ + @(return ecl_file_length(strm)) +} + +@(defun file-position (file_stream &o position) + cl_object output; +@ + if (Null(position)) { + output = ecl_file_position(file_stream); + } else { + if (position == @':start') { + position = MAKE_FIXNUM(0); + } else if (position == @':end') { + position = cl_file_length(file_stream); + if (position == Cnil) { + output = Cnil; + goto OUTPUT; + } + } + output = ecl_file_position_set(file_stream, position); + } + OUTPUT: @(return output) +@) + +cl_object +cl_input_stream_p(cl_object strm) +{ + @(return (ecl_input_stream_p(strm) ? Ct : Cnil)) +} + +cl_object +cl_output_stream_p(cl_object strm) +{ + @(return (ecl_output_stream_p(strm) ? Ct : Cnil)) +} + +cl_object +cl_interactive_stream_p(cl_object strm) +{ + @(return (stream_dispatch_table(strm)->interactive_p(strm)? Ct : Cnil)) +} + +cl_object +cl_open_stream_p(cl_object strm) +{ + /* ANSI and Cltl2 specify that open-stream-p should work + on closed streams, and that a stream is only closed + when #'close has been applied on it */ + if (type_of(strm) != t_stream) + FEwrong_type_argument(@'stream', strm); + @(return (strm->stream.closed ? Cnil : Ct)) +} + +cl_object +cl_stream_element_type(cl_object strm) +{ + @(return ecl_stream_element_type(strm)) } cl_object @@ -337,104 +2744,65 @@ cl_stream_external_format(cl_object strm) @(return output) } -/*---------------------------------------------------------------------- - * Error messages - *---------------------------------------------------------------------- - */ - -static void not_an_input_stream(cl_object fn) /*__attribute__((noreturn))*/; -static void not_an_output_stream(cl_object fn) /*__attribute__((noreturn))*/; -static void wrong_file_handler(cl_object strm) /*__attribute__((noreturn))*/; - -static void -not_an_input_stream(cl_object strm) +cl_object +cl_streamp(cl_object strm) { - cl_error(9, @'simple-type-error', @':format-control', - make_constant_base_string("~A is not an input stream"), - @':format-arguments', cl_list(1, strm), - @':expected-type', cl_list(2, @'satisfies', @'input-stream-p'), - @':datum', strm); -} - -static void -not_an_output_stream(cl_object strm) -{ - cl_error(9, @'simple-type-error', @':format-control', - make_constant_base_string("~A is not an output stream"), - @':format-arguments', cl_list(1, strm), - @':expected-type', cl_list(2, @'satisfies', @'output-stream-p'), - @':datum', strm); -} - -static void -not_a_character_stream(cl_object s) -{ - cl_error(9, @'simple-type-error', @':format-control', - make_constant_base_string("~A is not a character stream"), - @':format-arguments', cl_list(1, s), - @':expected-type', @'character', - @':datum', cl_stream_element_type(s)); -} - -static int -restartable_io_error(cl_object strm) -{ - cl_env_ptr the_env = &cl_env; - volatile int old_errno = errno; - /* ecl_disable_interrupts(); ** done by caller */ - clearerr((FILE*)strm->stream.file); - ecl_enable_interrupts(); - if (errno == EINTR) { - return 1; - } else { - FElibc_error("Read or write operation to stream ~S signaled an error.", - 1, strm); - return 0; +#ifdef ECL_CLOS_STREAMS + if (ECL_INSTANCEP(strm)) { + return funcall(2, @'gray::streamp', strm); } -} - -static void -io_error(cl_object strm) -{ - cl_env_ptr the_env = &cl_env; - FILE *f = strm->stream.file; - /* ecl_disable_interrupts(); ** done by caller */ - clearerr(f); - ecl_enable_interrupts(); - FElibc_error("Read or write operation to stream ~S signaled an error.", - 1, strm); -} - -static void -wrong_file_handler(cl_object strm) -{ - FEerror("Internal error: stream ~S has no valid C file handler.", 1, strm); -} - -#if defined(ECL_WSOCK) -static void -wsock_error( const char *err_msg, cl_object strm ) -{ - char *msg; - cl_object msg_obj; - /* ecl_disable_interrupts(); ** done by caller */ - { - FormatMessage( FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER, - 0, WSAGetLastError(), 0, ( void* )&msg, 0, NULL ); - msg_obj = make_base_string_copy( msg ); - LocalFree( msg ); - } - ecl_enable_interrupts(); - FEerror( err_msg, 2, strm, msg_obj ); -} #endif + @(return ((type_of(strm) == t_stream) ? Ct : Cnil)) +} -/*---------------------------------------------------------------------- - * ecl_open_stream(fn, smm, if_exists, if_does_not_exist) - * opens file fn with mode smm. - * Fn is a pathname designator. - *---------------------------------------------------------------------- +/********************************************************************** + * OTHER TOOLS */ + +cl_object +si_copy_stream(cl_object in, cl_object out) +{ + int c; + for (c = ecl_read_char(in); c != EOF; c = ecl_read_char(in)) { + ecl_write_char(c, out); + } + ecl_force_output(out); + @(return Ct) +} + + +/********************************************************************** + * FILE OPENING AND CLOSING + */ + +static cl_fixnum +normalize_stream_element_type(cl_object element_type) +{ + cl_fixnum sign = 0; + cl_index size; + if (funcall(3, @'subtypep', element_type, @'unsigned-byte') != Cnil) { + sign = +1; + } else if (funcall(3, @'subtypep', element_type, @'signed-byte') != Cnil) { + sign = -1; + } else { + FEerror("Not a valid stream element type: ~A", 1, element_type); + } + if (CONSP(element_type)) { + if (CAR(element_type) == @'unsigned-byte') + return fixnnint(cl_cadr(element_type)); + if (CAR(element_type) == @'signed-byte') + return -fixnnint(cl_cadr(element_type)); + } + for (size = 1; 1; size++) { + cl_object type; + type = cl_list(2, sign>0? @'unsigned-byte' : @'signed-byte', + MAKE_FIXNUM(size)); + if (funcall(3, @'subtypep', element_type, type) != Cnil) { + return size * sign; + } + } +} + cl_object ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, cl_object if_does_not_exist, cl_fixnum byte_size, @@ -445,14 +2813,8 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, FILE *fp; cl_object filename = si_coerce_to_filename(fn); char *fname = filename->base_string.self; - bool signed_bytes, appending = FALSE; + bool appending = FALSE; - if (byte_size < 0) { - signed_bytes = 1; - byte_size = -byte_size; - } else { - signed_bytes = 0; - } if (char_stream_p && byte_size != 8) { FEerror("Tried to make a character stream of byte size /= 8.",0); } @@ -551,18 +2913,7 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, } else { goto INVALID_MODE; } - x = ecl_alloc_object(t_stream); - x->stream.mode = (short)smm; - x->stream.closed = 0; - x->stream.file = (void*)fp; - x->stream.char_stream_p = char_stream_p; - /* binary header not used, round byte_size to a 8 bits */ - byte_size = (byte_size + 7) & ~7; - x->stream.byte_size = byte_size; - x->stream.signed_bytes = signed_bytes; - x->stream.last_op = 0; - x->stream.object1 = fn; - x->stream.int0 = x->stream.int1 = 0; + x = ecl_make_stream_from_FILE(fn, fp, smm, byte_size, char_stream_p); si_set_buffering_mode(x, char_stream_p? @':line-buffered' : @':fully-buffered'); if (smm == smm_probe) { cl_close(1, x); @@ -594,1258 +2945,88 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, return Cnil; } -/* Forward definitions */ -static void ecl_write_byte8(int c, cl_object strm); -static int ecl_read_byte8(cl_object strm); -@(defun close (strm &key (abort @'nil')) - FILE *fp; +@(defun open (filename + &key (direction @':input') + (element_type @'base-char') + (if_exists Cnil iesp) + (if_does_not_exist Cnil idnesp) + (external_format @':default') + (use_header_p Cnil) + &aux strm) + enum ecl_smmode smm; + bool char_stream_p; + cl_fixnum byte_size; @ -#ifdef ECL_CLOS_STREAMS - if (ECL_INSTANCEP(strm)) { - return funcall(2, @'gray::close', strm); - } -#endif - if (type_of(strm) != t_stream) - FEtype_error_stream(strm); - /* It is permissible to close a closed file */ - if (strm->stream.closed) - @(return Ct); - fp = (FILE*)strm->stream.file; - switch ((enum ecl_smmode)strm->stream.mode) { - case smm_output: - if (fp == stdout) - FEerror("Cannot close the standard output.", 0); - goto DO_CLOSE; - case smm_input: - if (fp == stdin) - FEerror("Cannot close the standard input.", 0); - case smm_io: - case smm_probe: - DO_CLOSE: - if (fp == NULL) - wrong_file_handler(strm); - if (ecl_output_stream_p(strm)) { - ecl_force_output(strm); + if (external_format != @':default') + FEerror("~S is not a valid stream external format.", 1, + external_format); + /* INV: ecl_open_stream() checks types */ + if (direction == @':input') { + smm = smm_input; + if (!idnesp) + if_does_not_exist = @':error'; + } else if (direction == @':output') { + smm = smm_output; + if (!iesp) + if_exists = @':new_version'; + if (!idnesp) { + if (if_exists == @':overwrite' || + if_exists == @':append') + if_does_not_exist = @':error'; + else + if_does_not_exist = @':create'; } - if (fclose(fp) != 0) - FElibc_error("Cannot close stream ~S.", 1, strm); -#if !defined(GBC_BOEHM) - ecl_dealloc(strm->stream.buffer); - strm->stream.file = NULL; -#endif - break; -#if defined(ECL_WSOCK) - case smm_input_wsock: - case smm_output_wsock: - case smm_io_wsock: - ecl_disable_interrupts(); - if (closesocket( ( int )strm->stream.file ) != 0) - wsock_error( "Cannot close Windows Socket ~S~%~A.", strm ); - ecl_enable_interrupts(); -#if !defined(GBC_BOEHM) - ecl_dealloc(strm->stream.buffer); - strm->stream.file = NULL; -#endif - break; -#endif - - case smm_two_way: - strm->stream.object0 = OBJNULL; - case smm_synonym: - case smm_broadcast: - case smm_concatenated: - case smm_echo: - case smm_string_input: - case smm_string_output: - /* The elements of a composite stream are not closed. For - composite streams we zero object1. For files we do not, - as it might contain an useful pathname */ - strm->stream.object1 = OBJNULL; - break; - - default: - ecl_internal_error("illegal stream mode"); + } else if (direction == @':io') { + smm = smm_io; + if (!iesp) + if_exists = @':new_version'; + if (!idnesp) { + if (if_exists == @':overwrite' || + if_exists == @':append') + if_does_not_exist = @':error'; + else + if_does_not_exist = @':create'; + } + } else if (direction == @':probe') { + smm = smm_probe; + if (!idnesp) + if_does_not_exist = Cnil; + } else { + FEerror("~S is an illegal DIRECTION for OPEN.", + 1, direction); + } + if (element_type == @':default') { + char_stream_p = 1; + byte_size = 8; + } else if (element_type == @'signed-byte') { + char_stream_p = 0; + byte_size = -8; + } else if (element_type == @'unsigned-byte') { + char_stream_p = 0; + byte_size = 8; + } else if (funcall(3, @'subtypep', element_type, @'character') != Cnil) { + char_stream_p = 1; + byte_size = 8; + } else { + char_stream_p = 0; + byte_size = normalize_stream_element_type(element_type); } - strm->stream.closed = 1; - strm->stream.file = NULL; - @(return Ct); + strm = ecl_open_stream(filename, smm, if_exists, if_does_not_exist, + byte_size, char_stream_p); + @(return strm) @) -cl_object -ecl_make_string_input_stream(cl_object strng, cl_index istart, cl_index iend) -{ - cl_object strm; - strm = ecl_alloc_object(t_stream); - strm->stream.mode = (short)smm_string_input; - strm->stream.closed = 0; - strm->stream.file = NULL; - strm->stream.object0 = strng; - strm->stream.object1 = OBJNULL; - strm->stream.int0 = istart; - strm->stream.int1 = iend; - strm->stream.char_stream_p = 1; - strm->stream.byte_size = 8; - strm->stream.signed_bytes = 0; - return(strm); -} +@(defun close (strm &key (abort @'nil')) +@ + @(return stream_dispatch_table(strm)->close(strm)); +@) -cl_object -ecl_make_string_output_stream(cl_index line_length) -{ - cl_object s = cl_alloc_adjustable_base_string(line_length); - return si_make_string_output_stream_from_string(s); -} - - /********************************************************************** - * BYTE INPUT/OUTPUT - * - * CLOS streams should handle byte input/output separately. For the - * rest of streams, we decompose each byte into octets and write them - * from the least significant to the most significant one. + * BACKEND */ -static void -ecl_write_byte8(int c, cl_object strm) -{ - /* - * INV: We only get streams of the following four modes. - */ - switch ((enum ecl_smmode)strm->stream.mode) { - case smm_output: - case smm_io: { - FILE *fp = (FILE *)strm->stream.file; - int code; - if (fp == NULL) - wrong_file_handler(strm); - ecl_disable_interrupts(); - do { - code = putc(c, fp); - } while (code== EOF && restartable_io_error(strm)); - ecl_enable_interrupts(); - break; - } -#if defined(ECL_WSOCK) - case smm_io_wsock: - case smm_output_wsock: { - int fp = (int)strm->stream.file; - if (fp == INVALID_SOCKET) { - wrong_file_handler(strm); - } else { - char ch = (char)c; - ecl_disable_interrupts(); - if (send(fp, &ch, 1, 0) == SOCKET_ERROR) { - wsock_error("Cannot write char to Windows" - "Socket ~S.~%~A", strm); - } - ecl_enable_interrupts(); - } - break; - } -#endif - case smm_string_output: - strm->stream.int0++; - ecl_string_push_extend(strm->stream.object0, c); - break; - default: - ecl_internal_error("illegal stream mode"); - } -} - -void -ecl_write_byte(cl_object c, cl_object strm) -{ - cl_index bs, nb; - cl_object aux; - /* - * The first part is only for composite or complex streams. - */ -BEGIN: -#ifdef ECL_CLOS_STREAMS - if (ECL_INSTANCEP(strm)) { - funcall(3, @'gray::stream-write-byte', strm, c); - return; - } -#endif - if (type_of(strm) != t_stream) - FEtype_error_stream(strm); - if (strm->stream.closed) - FEclosed_stream(strm); - switch ((enum ecl_smmode)strm->stream.mode) { - case smm_io: - io_stream_begin_write(strm); - case smm_output: -#if defined(ECL_WSOCK) - case smm_io_wsock: - case smm_output_wsock: -#endif - case smm_string_output: - break; - case smm_synonym: - strm = ecl_symbol_value(strm->stream.object0); - goto BEGIN; - case smm_broadcast: { - cl_object x; - for (x = strm->stream.object0; !ecl_endp(x); x = CDR(x)) - ecl_write_byte(c, CAR(x)); - return; - } - case smm_two_way: - strm->stream.int0++; - strm = strm->stream.object1; - goto BEGIN; - case smm_echo: - strm = strm->stream.object1; - goto BEGIN; - case smm_input: -#if defined(ECL_WSOCK) - case smm_input_wsock: -#endif - case smm_concatenated: - case smm_string_input: - not_an_output_stream(strm); - default: - ecl_internal_error("illegal stream mode"); - } - /* - * Here is the real output of the byte. - */ - bs = strm->stream.byte_size; - if (bs == 8) { - cl_fixnum n = fixint(c); - ecl_write_byte8(n & 0xFF, strm); - } else do { - cl_object b = cl_logand(2, c, MAKE_FIXNUM(0xFF)); - ecl_write_byte8(fix(b), strm); - c = cl_ash(c, MAKE_FIXNUM(-8)); - bs -= 8; - } while (bs); -} - -static int -ecl_read_byte8(cl_object strm) -{ - /* - * INV: We only get streams of the following four modes. - */ - int c; - switch ((enum ecl_smmode)strm->stream.mode) { - case smm_input: - case smm_io: { - FILE *fp = (FILE*)strm->stream.file; - if (fp == NULL) - wrong_file_handler(strm); - ecl_disable_interrupts(); - do { - c = getc(fp); - } while (c == EOF && ferror(fp) && restartable_io_error(strm)); - ecl_enable_interrupts(); - break; - } -#if defined(ECL_WSOCK) - case smm_io_wsock: - case smm_input_wsock: { - int fp = (int)strm->stream.file; - if (fp == INVALID_SOCKET) { - wrong_file_handler(strm); - } else { - /* check for unread chars first */ - if (CONSP(strm->stream.object0)) { - c = (unsigned char)CHAR_CODE(CAR(strm->stream.object0)); - strm->stream.object0 = CDR(strm->stream.object0); - } else { - char ch; - ecl_disable_interrupts(); - if (recv(fp, &ch, 1, 0) == SOCKET_ERROR) - wsock_error("Cannot read char from " - "Windows socket ~S.~%~A", - strm); - ecl_enable_interrupts(); - c = (unsigned char)ch; - } - } - break; - } -#endif - case smm_string_input: - if (strm->stream.int0 >= strm->stream.int1) - c = EOF; - else - c = strm->stream.object0->base_string.self[strm->stream.int0++]; - break; - default: - ecl_internal_error("illegal stream mode"); - } - return c; -} - -cl_object -si_set_buffering_mode(cl_object stream, cl_object buffer_mode_symbol) -{ - enum ecl_smmode mode = stream->stream.mode; - int buffer_mode; - - if (type_of(stream) != t_stream) { - FEerror("Cannot set buffer of ~A", 1, stream); - } - if (buffer_mode_symbol == Cnil) { - buffer_mode = _IONBF; - } else if (buffer_mode_symbol == Ct || buffer_mode_symbol == @':fully-buffered') { - buffer_mode = _IOFBF; - } else if (buffer_mode_symbol == @':line-buffered') { - buffer_mode = _IOLBF; - } else { - FEerror("Not a valid buffering mode: ~A", 1, buffer_mode_symbol); - } - if (mode == smm_output || mode == smm_io || mode == smm_input) { - FILE *fp = (FILE*)stream->stream.file; - char *new_buffer = 0; - setvbuf(fp, 0, _IONBF, 0); - if (buffer_mode != _IONBF) { - char *new_buffer; - cl_index buffer_size = BUFSIZ; - new_buffer = stream->stream.buffer = ecl_alloc_atomic(buffer_size); - setvbuf(fp, new_buffer, buffer_mode, buffer_size); - } - } - @(return stream) -} - -cl_object -ecl_read_byte(cl_object strm) -{ - cl_object c; - cl_index bs, nb; - /* - * In this first part, we identify the composite streams and - * also CLOS streams. - */ -BEGIN: -#ifdef ECL_CLOS_STREAMS - if (ECL_INSTANCEP(strm)) { - return funcall(2, @'gray::stream-read-byte', strm); - } -#endif - if (type_of(strm) != t_stream) - FEtype_error_stream(strm); - if (strm->stream.closed) - FEclosed_stream(strm); - switch ((enum ecl_smmode)strm->stream.mode) { - case smm_io: - io_stream_begin_read(strm); - case smm_input: - case smm_string_input: -#if defined(ECL_WSOCK) - case smm_io_wsock: - case smm_input_wsock: -#endif - break; - case smm_synonym: - strm = ecl_symbol_value(strm->stream.object0); - goto BEGIN; - case smm_concatenated: { - cl_object strmi = strm->stream.object0; - c = Cnil; - while (!ecl_endp(strmi)) { - c = ecl_read_byte(CAR(strmi)); - if (c != Cnil) - break; - strm->stream.object0 = strmi = CDR(strmi); - } - return c; - } - case smm_two_way: - if (strm == cl_core.terminal_io) - ecl_force_output(cl_core.terminal_io->stream.object1); - strm->stream.int1 = 0; - strm = strm->stream.object0; - goto BEGIN; - case smm_echo: - c = ecl_read_byte(strm->stream.object0); - if (c != Cnil) { - if (strm->stream.int0 == 0) - ecl_write_byte(c, strm->stream.object1); - else /* don't echo twice if it was unread */ - --(strm->stream.int0); - } - return c; - case smm_output: -#if defined(ECL_WSOCK) - case smm_output_wsock: -#endif - case smm_broadcast: - case smm_string_output: - not_an_input_stream(strm); - default: - ecl_internal_error("illegal stream mode"); - } - /* - * Here we treat the case of streams for which ecl_read_byte8 works. - */ - bs = strm->stream.byte_size; - if (bs == 8) { - cl_fixnum i = ecl_read_byte8(strm); - if (i == EOF) - return Cnil; - if (strm->stream.signed_bytes) { - unsigned char c = i; - return MAKE_FIXNUM((signed char)c); - } - return MAKE_FIXNUM(i); - } else { - cl_index bs_ = bs; - c = MAKE_FIXNUM(0); - for (nb = 0; bs_ >= 8; bs_ -= 8, nb += 8) { - cl_fixnum i = ecl_read_byte8(strm); - if (i == EOF) - return Cnil; - c = cl_logior(2, c, cl_ash(MAKE_FIXNUM(i), MAKE_FIXNUM(nb))); - } - } - if (strm->stream.signed_bytes && cl_logbitp(MAKE_FIXNUM(bs-1), c) != Cnil) { - c = cl_logandc1(cl_ash(MAKE_FIXNUM(1), MAKE_FIXNUM(bs-1)), c); - c = ecl_minus(c, cl_ash(MAKE_FIXNUM(1), MAKE_FIXNUM(bs-1))); - } - return c; -} - - -/********************************************************************** - * CHARACTER INPUT/OUTPUT - */ - -/* - * ecl_read_char(s) tries to read a character from the stream S. It outputs - * either the code of the character read, or EOF. Whe compiled with - * CLOS-STREAMS and S is an instance object, STREAM-READ-CHAR is invoked - * to retrieve the character. Then STREAM-READ-CHAR should either - * output the character, or NIL, indicating EOF. - * - * INV: ecl_read_char(strm) checks the type of STRM. - */ -int -ecl_read_char(cl_object strm) -{ - int c; - FILE *fp; - -BEGIN: -#ifdef ECL_CLOS_STREAMS - if (ECL_INSTANCEP(strm)) { - cl_object c = funcall(2, @'gray::stream-read-char', strm); - return CHARACTERP(c)? CHAR_CODE(c) : EOF; - } -#endif - if (type_of(strm) != t_stream) - FEtype_error_stream(strm); - if (strm->stream.closed) - FEclosed_stream(strm); - switch ((enum ecl_smmode)strm->stream.mode) { - case smm_io: - io_stream_begin_read(strm); - case smm_input: { - cl_env_ptr the_env = &cl_env; - FILE *fp = (FILE*)strm->stream.file; - if (!strm->stream.char_stream_p) - not_a_character_stream(strm); - if (fp == NULL) - wrong_file_handler(strm); - ecl_disable_interrupts(); - do { - c = getc(fp); - } while ((c == EOF) && ferror(fp) && restartable_io_error(strm)); - ecl_enable_interrupts(); - break; - } -#if defined(ECL_WSOCK) - case smm_io_wsock: - case smm_input_wsock: { - int fp = (int)strm->stream.file; - if (!strm->stream.char_stream_p) - not_a_character_stream(strm); - if (fp == INVALID_SOCKET) { - wrong_file_handler(strm); - } else { - if (CONSP(strm->stream.object0)) { - c = (unsigned char)CHAR_CODE(CAR(strm->stream.object0)); - strm->stream.object0 = CDR(strm->stream.object0); - } else { - char ch; - ecl_disable_interrupts(); - if (recv(fp, &ch, 1, 0) == SOCKET_ERROR) - wsock_error("Cannot read char from " - "Windows socket ~S.~%~A", - strm); - c = (unsigned char)ch; - ecl_enable_interrupts(); - } - } - break; - } -#endif - - case smm_synonym: - strm = ecl_symbol_value(strm->stream.object0); - goto BEGIN; - - case smm_concatenated: { - cl_object strmi = strm->stream.object0; - c = EOF; - while (!ecl_endp(strmi)) { - c = ecl_read_char(CAR(strmi)); - if (c != EOF) - break; - strm->stream.object0 = strmi = CDR(strmi); - } - break; - } - case smm_two_way: - if (strm == cl_core.terminal_io) - ecl_force_output(cl_core.terminal_io->stream.object1); - strm->stream.int1 = 0; - strm = strm->stream.object0; - goto BEGIN; - - case smm_echo: - c = ecl_read_char(strm->stream.object0); - if (c != EOF) { - if (strm->stream.int0 == 0) - ecl_write_char(c, strm->stream.object1); - else /* don't echo twice if it was unread */ - --(strm->stream.int0); - } - break; - - case smm_string_input: - if (strm->stream.int0 >= strm->stream.int1) - c = EOF; - else - c = strm->stream.object0->base_string.self[strm->stream.int0++]; - break; - - case smm_output: -#if defined(ECL_WSOCK) - case smm_output_wsock: -#endif - case smm_broadcast: - case smm_string_output: - not_an_input_stream(strm); - - default: - ecl_internal_error("illegal stream mode"); - } - return c; -} - -/* - * ecl_read_char(s) tries to read a character from the stream S. It outputs - * either the code of the character read, or EOF. Whe compiled with - * CLOS-STREAMS and S is an instance object, STREAM-READ-CHAR is invoked - * to retrieve the character. Then STREAM-READ-CHAR should either - * output the character, or NIL, indicating EOF. - * - * INV: ecl_read_char(strm) checks the type of STRM. - */ -int -ecl_peek_char(cl_object strm) -{ - int c; - FILE *fp; - -BEGIN: -#ifdef ECL_CLOS_STREAMS - if (ECL_INSTANCEP(strm)) { - cl_object c = funcall(2, @'gray::stream-peek-char', strm); - return CHARACTERP(c)? CHAR_CODE(c) : EOF; - } -#endif - if (type_of(strm) != t_stream) - FEtype_error_stream(strm); - if (strm->stream.closed) - FEclosed_stream(strm); - fp = (FILE*)strm->stream.file; - switch ((enum ecl_smmode)strm->stream.mode) { - case smm_io: - io_stream_begin_read(strm); - case smm_input: - if (!strm->stream.char_stream_p) - not_a_character_stream(strm); - if (fp == NULL) - wrong_file_handler(strm); - ecl_disable_interrupts(); - do { - c = getc(fp); - } while (c == EOF && ferror(fp) && restartable_io_error(strm)); - ungetc(c, fp); - ecl_enable_interrupts(); - break; - -#if defined(ECL_WSOCK) - case smm_io_wsock: - case smm_input_wsock: { - int fp = strm->stream.file; - if (!strm->stream.char_stream_p) - not_a_character_stream(strm); - if (fp == INVALID_SOCKET) { - wrong_file_handler(strm); - } else { - if (CONSP(strm->stream.object0)) { - c = (unsigned char)CHAR_CODE(CAR(strm->stream.object0)); - } else { - char ch; - ecl_disable_interrupts(); - if (recv(fp, &ch, 1, MSG_PEEK) == SOCKET_ERROR) - wsock_error("Cannot peek char from " - "Windows socket ~S.~%~A", - strm); - c = (unsigned char)ch; - ecl_enable_interrupts(); - } - } - break; - } -#endif - - case smm_synonym: - strm = ecl_symbol_value(strm->stream.object0); - goto BEGIN; - - case smm_concatenated: { - cl_object strmi = strm->stream.object0; - c = EOF; - while (!ecl_endp(strmi)) { - c = ecl_peek_char(CAR(strmi)); - if (c != EOF) - break; - strm->stream.object0 = strmi = CDR(strmi); - } - break; - } - case smm_two_way: - if (strm == cl_core.terminal_io) - ecl_force_output(cl_core.terminal_io->stream.object1); - strm->stream.int1 = 0; - strm = strm->stream.object0; - goto BEGIN; - - case smm_echo: - c = ecl_peek_char(strm->stream.object0); - break; - - case smm_string_input: - if (strm->stream.int0 >= strm->stream.int1) - c = EOF; - else - c = strm->stream.object0->base_string.self[strm->stream.int0]; - break; - - case smm_output: -#if defined(ECL_WSOCK) - case smm_output_wsock: -#endif - case smm_broadcast: - case smm_string_output: - not_an_input_stream(strm); - - default: - ecl_internal_error("illegal stream mode"); - } - return c; -} - -int -ecl_read_char_noeof(cl_object strm) -{ - int c = ecl_read_char(strm); - if (c == EOF) - FEend_of_file(strm); - return c; -} - -void -ecl_unread_char(int c, cl_object strm) -{ - FILE *fp; - -BEGIN: -#ifdef ECL_CLOS_STREAMS - if (ECL_INSTANCEP(strm)) { - funcall(3, @'gray::stream-unread-char', strm, CODE_CHAR(c)); - return; - } -#endif - if (type_of(strm) != t_stream) - FEtype_error_stream(strm); - if (strm->stream.closed) - FEclosed_stream(strm); - fp = (FILE*)strm->stream.file; - switch ((enum ecl_smmode)strm->stream.mode) { - case smm_io: - if (strm->stream.last_op < 0) { - goto UNREAD_ERROR; - } - strm->stream.last_op = +1; - case smm_input: - if (!strm->stream.char_stream_p) - not_a_character_stream(strm); - if (fp == NULL) - wrong_file_handler(strm); - ecl_disable_interrupts(); - ungetc(c, fp); - if (c == EOF) - io_error(strm); - ecl_enable_interrupts(); -/* --strm->stream.int0; useless in smm_io, Beppe */ - break; - -#if defined(ECL_WSOCK) - case smm_io_wsock: - case smm_input_wsock: - strm->stream.object0 = CONS(CODE_CHAR((unsigned char)c), strm->stream.object0); - break; -#endif - - case smm_synonym: - strm = ecl_symbol_value(strm->stream.object0); - goto BEGIN; - - case smm_concatenated: - if (ecl_endp(strm->stream.object0)) - goto UNREAD_ERROR; - strm = CAR(strm->stream.object0); - goto BEGIN; - - case smm_two_way: - strm = strm->stream.object0; - goto BEGIN; - - case smm_echo: - ecl_unread_char(c, strm->stream.object0); - (strm->stream.int0)++; - break; - - case smm_string_input: - if (strm->stream.int0 <= 0 || (int)strm->stream.object0->base_string.self[strm->stream.int0-1] != c) - goto UNREAD_ERROR; - --strm->stream.int0; - break; - - case smm_output: -#if defined(ECL_WSOCK) - case smm_output_wsock: -#endif - case smm_broadcast: - case smm_string_output: - not_an_input_stream(strm); - - default: - ecl_internal_error("illegal stream mode"); - } - return; - -UNREAD_ERROR: - FEerror("Cannot unread the stream ~S.", 1, strm); -} - -int -ecl_write_char(int c, cl_object strm) -{ - cl_object x; - FILE *fp; - -BEGIN: -#ifdef ECL_CLOS_STREAMS - if (ECL_INSTANCEP(strm)) { - funcall(3, @'gray::stream-write-char', strm, CODE_CHAR(c)); - return c; - } -#endif - if (type_of(strm) != t_stream) - FEtype_error_stream(strm); - if (strm->stream.closed) - FEclosed_stream(strm); - fp = (FILE*)strm->stream.file; - switch ((enum ecl_smmode)strm->stream.mode) { - case smm_io: - io_stream_begin_write(strm); - case smm_output: { - int outcome; - if (!strm->stream.char_stream_p) - not_a_character_stream(strm); - if (c == '\n') - strm->stream.int1 = 0; - else if (c == '\t') - strm->stream.int1 = (strm->stream.int1&~07) + 8; - else - strm->stream.int1++; - if (fp == NULL) - wrong_file_handler(strm); - ecl_disable_interrupts(); - do { - outcome = putc(c, fp); - } while (outcome == EOF && restartable_io_error(strm)); - ecl_enable_interrupts(); - break; - } -#if defined(ECL_WSOCK) - case smm_io_wsock: - case smm_output_wsock: - if (!strm->stream.char_stream_p) - not_a_character_stream(strm); - if (c == '\n') - strm->stream.int1 = 0; - else if (c == '\t') - strm->stream.int1 = (strm->stream.int1&~07) + 8; - else - strm->stream.int1++; - if ((int)fp == INVALID_SOCKET) { - wrong_file_handler(strm); - } else { - char ch = (char)c; - ecl_disable_interrupts(); - if (send((int)fp, &ch, 1, 0) == SOCKET_ERROR) - wsock_error("Cannot write char to Windows " - "Socket ~S.~%~A", strm); - ecl_enable_interrupts(); - } - break; -#endif - - case smm_synonym: - strm = ecl_symbol_value(strm->stream.object0); - goto BEGIN; - - case smm_broadcast: - for (x = strm->stream.object0; !ecl_endp(x); x = CDR(x)) - ecl_write_char(c, CAR(x)); - break; - - case smm_two_way: - strm->stream.int0++; - if (c == '\n') - strm->stream.int1 = 0; - else if (c == '\t') - strm->stream.int1 = (strm->stream.int1&~07) + 8; - else - strm->stream.int1++; - strm = strm->stream.object1; - goto BEGIN; - - case smm_echo: - strm = strm->stream.object1; - goto BEGIN; - - case smm_string_output: - strm->stream.int0++; - if (c == '\n') - strm->stream.int1 = 0; - else if (c == '\t') - strm->stream.int1 = (strm->stream.int1&~07) + 8; - else - strm->stream.int1++; - ecl_string_push_extend(strm->stream.object0, c); - break; - - case smm_input: -#if defined(ECL_WSOCK) - case smm_input_wsock: -#endif - case smm_concatenated: - case smm_string_input: - not_an_output_stream(strm); - - default: - ecl_internal_error("illegal stream mode"); - } - return(c); -} - -void -writestr_stream(const char *s, cl_object strm) -{ - while (*s != '\0') - ecl_write_char(*s++, strm); -} - -cl_object -si_do_write_sequence(cl_object seq, cl_object stream, cl_object s, cl_object e) -{ - cl_fixnum start,limit,end; - cl_type t; - - /* Since we have called ecl_length(), we know that SEQ is a valid - sequence. Therefore, we only need to check the type of the - object, and seq == Cnil i.f.f. t = t_symbol */ - limit = ecl_length(seq); - start = ecl_fixnum_in_range(@'write-sequence',"start",s,0,limit); - if (e == Cnil) { - end = limit; - } else { - end = ecl_fixnum_in_range(@'write-sequence',"end",e,0,limit); - } - if (end <= start) { - goto OUTPUT; - } - t = type_of(seq); - if (t == t_list) { - bool ischar = cl_stream_element_type(stream) == @'base-char'; - cl_object s = ecl_nthcdr(start, seq); - loop_for_in(s) { - if (start < end) { - cl_object elt = CAR(s); - cl_write_byte(ischar? cl_char_code(elt) : elt, - stream); - start++; - } else { - goto OUTPUT; - } - } end_loop_for_in; - goto OUTPUT; - } - if (t != t_base_string && - !(t == t_vector && - (seq->vector.elttype == aet_b8 || seq->vector.elttype == aet_i8))) - { - bool ischar = cl_stream_element_type(stream) == @'base-char'; - while (start < end) { - cl_object elt = ecl_aref(seq, start++); - if (ischar) { - ecl_write_char(ecl_char_code(elt), stream); - } else { - ecl_write_byte(elt, stream); - } - } - goto OUTPUT; - } - AGAIN: - if ((t = type_of(stream)) == t_stream && - (stream->stream.mode == smm_io || - stream->stream.mode == smm_output)) - { - size_t towrite = end - start, written; - if (stream->stream.mode == smm_io) { - io_stream_begin_write(stream); - } - ecl_disable_interrupts(); - do { - written = fwrite(seq->vector.self.ch + start, sizeof(char), - towrite, (FILE*)stream->stream.file); - } while ((written < towrite) && restartable_io_error(stream)); - ecl_enable_interrupts(); - } else if (t == t_stream && stream->stream.mode == smm_two_way) { - stream = stream->stream.object1; - goto AGAIN; - } else { - char *p; - for (p= seq->vector.self.ch; start < end; start++) { - ecl_write_char(p[start], stream); - } - } - OUTPUT: - @(return seq); -} - -cl_object -si_do_read_sequence(cl_object seq, cl_object stream, cl_object s, cl_object e) -{ - cl_fixnum start,limit,end; - cl_type t; - - /* Since we have called ecl_length(), we know that SEQ is a valid - sequence. Therefore, we only need to check the type of the - object, and seq == Cnil i.f.f. t = t_symbol */ - limit = ecl_length(seq); - start = ecl_fixnum_in_range(@'read-sequence',"start",s,0,limit); - if (e == Cnil) { - end = limit; - } else { - end = ecl_fixnum_in_range(@'read-sequence',"end",e,0,limit); - } - if (end <= start) { - goto OUTPUT; - } - t = type_of(seq); - if (t == t_list) { - bool ischar = cl_stream_element_type(stream) == @'base-char'; - seq = ecl_nthcdr(start, seq); - loop_for_in(seq) { - if (start >= end) { - goto OUTPUT; - } else { - cl_object c; - if (ischar) { - int i = ecl_read_char(stream); - if (i < 0) goto OUTPUT; - c = CODE_CHAR(i); - } else { - c = ecl_read_byte(stream); - if (c == Cnil) goto OUTPUT; - } - ECL_RPLACA(seq, c); - start++; - } - } end_loop_for_in; - goto OUTPUT; - } - if (t != t_base_string && - !(t == t_vector && - (seq->vector.elttype == aet_b8 || seq->vector.elttype == aet_i8))) - { - bool ischar = cl_stream_element_type(stream) == @'base-char'; - while (start < end) { - cl_object c; - if (ischar) { - int i = ecl_read_char(stream); - if (i < 0) goto OUTPUT; - c = CODE_CHAR(i); - } else { - c = ecl_read_byte(stream); - if (c == Cnil) goto OUTPUT; - } - ecl_aset(seq, start++, c); - } - goto OUTPUT; - } - AGAIN: - if ((t = type_of(stream)) == t_stream && - (stream->stream.mode == smm_io || - stream->stream.mode == smm_input)) - { - FILE *fp = (FILE*)stream->stream.file; - size_t toread, n; - if (stream->stream.mode == smm_io) { - io_stream_begin_write(stream); - } - toread = end - start; - ecl_disable_interrupts(); - do { - n = fread(seq->vector.self.ch + start, sizeof(char), - toread, fp); - } while (n < toread && ferror(fp) && restartable_io_error(stream)); - ecl_enable_interrupts(); - start += n; - } else if (t == t_stream && stream->stream.mode == smm_two_way) { - stream = stream->stream.object0; - goto AGAIN; - } else { - char *p; - for (p = seq->vector.self.ch; start < end; start++) { - int c = ecl_read_char(stream); - if (c == EOF) - break; - p[start] = c; - } - } - OUTPUT: - @(return MAKE_FIXNUM(start)) -} - -void -ecl_force_output(cl_object strm) -{ - cl_object x; - -BEGIN: -#ifdef ECL_CLOS_STREAMS - if (ECL_INSTANCEP(strm)) { - funcall(2, @'gray::stream-force-output', strm); - return; - } -#endif - if (type_of(strm) != t_stream) - FEtype_error_stream(strm); - if (strm->stream.closed) - FEclosed_stream(strm); - switch ((enum ecl_smmode)strm->stream.mode) { - case smm_io: - strm->stream.last_op = 0; - case smm_output: { - FILE *fp = (FILE*)strm->stream.file; - if (fp == NULL) - wrong_file_handler(strm); - ecl_disable_interrupts(); - while ((fflush(fp) == EOF) && restartable_io_error(strm)) - (void)0; - ecl_enable_interrupts(); - break; - } -#if defined(ECL_WSOCK) - case smm_io_wsock: - case smm_output_wsock: - /* do not do anything (yet) */ - break; -#endif - - case smm_synonym: - strm = ecl_symbol_value(strm->stream.object0); - goto BEGIN; - - case smm_broadcast: - for (x = strm->stream.object0; !ecl_endp(x); x = CDR(x)) - ecl_force_output(CAR(x)); - break; - - case smm_two_way: - case smm_echo: - strm = strm->stream.object1; - goto BEGIN; - - case smm_string_output: - break; - case smm_input: -#if defined(ECL_WSOCK) - case smm_input_wsock: -#endif - case smm_concatenated: - case smm_string_input: - FEerror("Cannot flush the stream ~S.", 1, strm); - - default: - ecl_internal_error("illegal stream mode"); - } -} - -void -ecl_clear_input(cl_object strm) -{ - cl_object x; - FILE *fp; - -BEGIN: -#ifdef ECL_CLOS_STREAMS - if (ECL_INSTANCEP(strm)) { - funcall(2, @'gray::stream-clear-input', strm); - return; - } -#endif - if (type_of(strm) != t_stream) - FEtype_error_stream(strm); - if (strm->stream.closed) - FEclosed_stream(strm); - fp = (FILE*)strm->stream.file; - switch ((enum ecl_smmode)strm->stream.mode) { - case smm_input: - if (fp == NULL) - wrong_file_handler(strm); -#if defined(mingw32) || defined(_MSC_VER) - if (isatty(fileno(fp))) { - /* Flushes Win32 console */ - if (!FlushConsoleInputBuffer((HANDLE)_get_osfhandle(fileno(fp)))) - FEwin32_error("FlushConsoleInputBuffer() failed", 0); - /* Do not stop here: the FILE structure needs also to be flushed */ - } -#endif - while (flisten(fp) == ECL_LISTEN_AVAILABLE) { - getc(fp); - } - break; - -#if defined(ECL_WSOCK) - case smm_io_wsock: - case smm_input_wsock: - /* flush at least the unread chars */ - strm->stream.object0 = Cnil; - /* do not do anything (yet) */ - printf("Trying to clear input on windows socket stream!\n"); - break; -#endif - - case smm_synonym: - strm = ecl_symbol_value(strm->stream.object0); - goto BEGIN; - - case smm_broadcast: - for (x = strm->stream.object0; !ecl_endp(x); x = CDR(x)) - ecl_force_output(CAR(x)); - break; - - case smm_two_way: - case smm_echo: - strm = strm->stream.object0; - goto BEGIN; - - case smm_string_output: - case smm_io: - case smm_output: -#if defined(ECL_WSOCK) - case smm_output_wsock: -#endif - case smm_concatenated: - case smm_string_input: - break; - - default: - ecl_internal_error("illegal stream mode"); - } -} - -void -ecl_clear_output(cl_object strm) -{ - cl_object x; - FILE *fp; - -BEGIN: -#ifdef ECL_CLOS_STREAMS - if (ECL_INSTANCEP(strm)) { - funcall(2, @'gray::stream-clear-output',strm); - return; - } -#endif - if (type_of(strm) != t_stream) - FEtype_error_stream(strm); - if (strm->stream.closed) - FEclosed_stream(strm); - fp = (FILE*)strm->stream.file; - switch ((enum ecl_smmode)strm->stream.mode) { - case smm_output: -#if 0 - if (fp == NULL) - wrong_file_handler(strm); - if (ecl_fseeko(fp, 0L, 2) != 0) - io_error(strm); -#endif - break; - -#if defined(ECL_WSOCK) - case smm_io_wsock: - case smm_output_wsock: - /* do not do anything (yet) */ - printf("Trying to clear output windows socket stream\n!"); - break; -#endif - - case smm_synonym: - strm = ecl_symbol_value(strm->stream.object0); - goto BEGIN; - - case smm_broadcast: - for (x = strm->stream.object0; !ecl_endp(x); x = CDR(x)) - ecl_force_output(CAR(x)); - break; - - case smm_two_way: - case smm_echo: - strm = strm->stream.object1; - goto BEGIN; - - case smm_string_output: - case smm_io: - case smm_input: -#if defined(ECL_WSOCK) - case smm_input_wsock: -#endif - case smm_concatenated: - case smm_string_input: - break; - - default: - ecl_internal_error("illegal stream mode"); - } -} - static int flisten(FILE *fp) { @@ -1945,927 +3126,230 @@ flisten(FILE *fp) return !ECL_LISTEN_AVAILABLE; } -int -ecl_listen_stream(cl_object strm) +/* + * When using the same stream for input and output operations, we have to + * use some file position operation before reading again. + */ + +static void io_stream_begin_write(cl_object strm) { - FILE *fp; - -BEGIN: -#ifdef ECL_CLOS_STREAMS - if (ECL_INSTANCEP(strm)) { - cl_object flag = funcall(2, @'gray::stream-listen', strm); - return !(flag == Cnil); - } -#endif - if (type_of(strm) != t_stream) - FEtype_error_stream(strm); - if (strm->stream.closed) - FEclosed_stream(strm); - switch ((enum ecl_smmode)strm->stream.mode) { - case smm_io: - io_stream_begin_read(strm); - case smm_input: - fp = (FILE*)strm->stream.file; - if (fp == NULL) - wrong_file_handler(strm); - return flisten(fp); - -#if defined(ECL_WSOCK) - case smm_io_wsock: - case smm_input_wsock: - fp = (FILE*)strm->stream.file; - if ((int)fp == INVALID_SOCKET) { - wrong_file_handler(strm); - } else { - if (CONSP(strm->stream.object0)) { - return ECL_LISTEN_AVAILABLE; - } else { - struct timeval tv = { 0, 0 }; - fd_set fds; - int result; - FD_ZERO(&fds); - FD_SET((int)fp, &fds); - ecl_disable_interrupts(); - result = select(0, &fds, NULL, NULL, &tv); - if (result == SOCKET_ERROR) - wsock_error("Cannot listen on Windows " - "socket ~S.~%~A", strm); - ecl_enable_interrupts(); - return (result > 0 ? - ECL_LISTEN_AVAILABLE : - ECL_LISTEN_NO_CHAR); - } - } -#endif - - case smm_synonym: - strm = ecl_symbol_value(strm->stream.object0); - goto BEGIN; - - case smm_concatenated: { - cl_object l = strm->stream.object0; - while (!ecl_endp(l)) { - int f = ecl_listen_stream(CAR(l)); - l = CDR(l); - if (f == ECL_LISTEN_EOF) { - strm->stream.object0 = l; - } else { - return f; - } - } - return ECL_LISTEN_EOF; - } - case smm_two_way: - case smm_echo: - strm = strm->stream.object0; - goto BEGIN; - - case smm_string_input: - if (strm->stream.int0 < strm->stream.int1) - return ECL_LISTEN_AVAILABLE; - else - return ECL_LISTEN_EOF; - - case smm_output: -#if defined(ECL_WSOCK) - case smm_output_wsock: -#endif - case smm_broadcast: - case smm_string_output: - not_an_input_stream(strm); - - default: - ecl_internal_error("illegal stream mode"); + if (strm->stream.last_op > 0) { + ecl_fseeko((FILE*)strm->stream.file, 0, SEEK_CUR); } + strm->stream.last_op = -1; } -cl_object -ecl_file_position(cl_object strm) +/* + * When using the same stream for input and output operations, we have to + * flush the stream before writing. + */ + +static void io_stream_begin_read(cl_object strm) +{ + if (strm->stream.last_op < 0) { + ecl_force_output(strm); + } + strm->stream.last_op = +1; +} + +static cl_object +ecl_off_t_to_integer(ecl_off_t offset) { cl_object output; -BEGIN: -#ifdef ECL_CLOS_STREAMS - if (ECL_INSTANCEP(strm)) - FEerror("file-position not implemented for CLOS streams", 0); -#endif - if (type_of(strm) != t_stream) - FEtype_error_stream(strm); - if (strm->stream.closed) - FEclosed_stream(strm); - switch ((enum ecl_smmode)strm->stream.mode) { - case smm_io: - strm->stream.last_op = 0; - case smm_output: - ecl_force_output(strm); - case smm_input: { - /* FIXME! This does not handle large file sizes */ - ecl_off_t offset; - FILE *fp = (FILE*)strm->stream.file; - if (fp == NULL) - wrong_file_handler(strm); - ecl_disable_interrupts(); - offset = ecl_ftello(fp); - if (offset < 0) - io_error(strm); - ecl_enable_interrupts(); - if (sizeof(ecl_off_t) == sizeof(long)) { - output = ecl_make_integer(offset); - } else { - output = ecl_off_t_to_integer(offset); + if (sizeof(ecl_off_t) == sizeof(cl_fixnum)) { + output = ecl_make_integer(offset); + } else if (offset <= MOST_POSITIVE_FIXNUM) { + output = MAKE_FIXNUM((cl_fixnum)offset); + } else { + cl_object y = big_register0_get(); +#ifdef WITH_GMP + if (sizeof(y->big.big_limbs[0]) == sizeof(cl_index)) { + y->big.big_limbs[0] = (cl_index)offset; + offset >>= FIXNUM_BITS; + y->big.big_limbs[1] = offset; + y->big.big_size = offset? 2 : 1; + } else if (sizeof(y->big.big_limbs[0]) >= sizeof(ecl_off_t)) { + y->big.big_limbs[0] = offset; + y->big.big_size = 1; } - break; - } - case smm_string_output: - /* INV: The size of a string never exceeds a fixnum. */ - output = MAKE_FIXNUM(strm->stream.object0->base_string.fillp); - break; - case smm_string_input: - /* INV: The size of a string never exceeds a fixnum. */ - output = MAKE_FIXNUM(strm->stream.int0); - break; - - case smm_synonym: - strm = ecl_symbol_value(strm->stream.object0); - goto BEGIN; - - case smm_broadcast: - strm = strm->stream.object0; - if (ecl_endp(strm)) - return MAKE_FIXNUM(0); - strm = CAR(strm); - goto BEGIN; - -#if defined(ECL_WSOCK) - case smm_input_wsock: - case smm_output_wsock: - case smm_io_wsock: +#else + y->big.big_num = offset; #endif - case smm_concatenated: - case smm_two_way: - case smm_echo: - return Cnil; - - default: - ecl_internal_error("illegal stream mode"); - } - if (!strm->stream.char_stream_p && strm->stream.byte_size != 8) { - output = ecl_floor2(output, MAKE_FIXNUM(strm->stream.byte_size/8)); - if (VALUES(1) != MAKE_FIXNUM(0)) { - FEerror("File position is not on byte boundary", 0); - } + output = big_register_normalize(y); } return output; } -cl_object -ecl_file_position_set(cl_object strm, cl_object large_disp) +static ecl_off_t +ecl_integer_to_off_t(cl_object offset) { - ecl_off_t disp; -BEGIN: -#ifdef ECL_CLOS_STREAMS - if (ECL_INSTANCEP(strm)) - FEerror("file-position not implemented for CLOS streams", 0); -#endif - if (type_of(strm) != t_stream) - FEtype_error_stream(strm); - if (strm->stream.closed) - FEclosed_stream(strm); - switch ((enum ecl_smmode)strm->stream.mode) { - case smm_io: - case smm_output: - ecl_force_output(strm); - case smm_input:{ - FILE *fp = (FILE*)strm->stream.file; - if (!strm->stream.char_stream_p && strm->stream.byte_size > 8) { - large_disp = ecl_times(large_disp, - MAKE_FIXNUM(strm->stream.byte_size/8)); - } - disp = ecl_integer_to_off_t(large_disp); - if (fp == NULL) - wrong_file_handler(strm); - if (ecl_fseeko(fp, disp, 0) != 0) - return Cnil; - break; - } - case smm_string_output: { - /* INV: byte_size == 8 */ - disp = fixnnint(large_disp); - if (disp < strm->stream.object0->base_string.fillp) { - strm->stream.object0->base_string.fillp = disp; - strm->stream.int0 = disp; - } else { - disp -= strm->stream.object0->base_string.fillp; - while (disp-- > 0) - ecl_write_char(' ', strm); - } - return Ct; - } - case smm_string_input: { - /* INV: byte_size == 8 */ - disp = fixnnint(large_disp); - if (disp >= strm->stream.int1) { - strm->stream.int0 = strm->stream.int1; - } else { - strm->stream.int0 = disp; - } - return Ct; - } - case smm_synonym: - strm = ecl_symbol_value(strm->stream.object0); - goto BEGIN; - - case smm_broadcast: - strm = strm->stream.object0; - if (ecl_endp(strm)) - return Cnil; - strm = CAR(strm); - goto BEGIN; - -#if defined(ECL_WSOCK) - case smm_input_wsock: - case smm_output_wsock: - case smm_io_wsock: -#endif - case smm_concatenated: - case smm_two_way: - case smm_echo: - return Cnil; - - default: - ecl_internal_error("illegal stream mode"); - } - return Ct; -} - -cl_object -cl_file_length(cl_object strm) -{ - cl_object output; -BEGIN: -#ifdef ECL_CLOS_STREAMS - if (ECL_INSTANCEP(strm)) - FEwrong_type_argument(c_string_to_object("(OR BROADCAST-STREAM SYNONYM-STREAM FILE-STREAM)"), - strm); -#endif - if (type_of(strm) != t_stream) - FEtype_error_stream(strm); - if (strm->stream.closed) - FEclosed_stream(strm); - switch ((enum ecl_smmode)strm->stream.mode) { - case smm_io: - case smm_output: - ecl_force_output(strm); - case smm_input: { - FILE *fp = (FILE*)strm->stream.file; - if (fp == NULL) - wrong_file_handler(strm); - output = ecl_file_len(fp); - if (!strm->stream.char_stream_p && strm->stream.byte_size != 8) { - cl_index bs = strm->stream.byte_size; - output = ecl_floor2(output, MAKE_FIXNUM(bs/8)); - if (VALUES(1) != MAKE_FIXNUM(0)) { - FEerror("File length is not on byte boundary", 0); + ecl_off_t output = 0; + if (sizeof(ecl_off_t) == sizeof(cl_fixnum)) { + output = fixint(offset); + } else if (FIXNUMP(offset)) { + output = fixint(offset); + } else if (type_of(offset) == t_bignum) { +#ifdef WITH_GMP + if (sizeof(offset->big.big_limbs[0]) == sizeof(cl_index)) { + if (offset->big.big_size > 2) { + goto ERR; } - } - break; - } - case smm_synonym: - strm = ecl_symbol_value(strm->stream.object0); - goto BEGIN; - - case smm_broadcast: - strm = strm->stream.object0; - if (ecl_endp(strm)) { - output = MAKE_FIXNUM(0); - break; - } - strm = CAR(strm); - goto BEGIN; - -#if defined(ECL_WSOCK) - case smm_input_wsock: - case smm_output_wsock: - case smm_io_wsock: -#endif - case smm_concatenated: - case smm_two_way: - case smm_echo: - case smm_string_input: - case smm_string_output: - FEwrong_type_argument(@'file-stream', strm); - - default: - ecl_internal_error("illegal stream mode"); - } - @(return output) -} - -cl_object si_file_column(cl_object strm) -{ - @(return MAKE_FIXNUM(ecl_file_column(strm))) -} - -int -ecl_file_column(cl_object strm) -{ - -BEGIN: -#ifdef ECL_CLOS_STREAMS - if (ECL_INSTANCEP(strm)) { - cl_object col = funcall(2, @'gray::stream-line-column', strm); - /* FIXME! The Gray streams specifies NIL is a valid - * value but means "unknown". Should we make it - * zero? */ - if (col == Cnil) - return 0; - else - return fixnnint(col); - } -#endif - if (type_of(strm) != t_stream) - FEtype_error_stream(strm); - if (strm->stream.closed) - FEclosed_stream(strm); - switch ((enum ecl_smmode)strm->stream.mode) { - case smm_output: -#if defined(ECL_WSOCK) - case smm_output_wsock: - case smm_io_wsock: -#endif - case smm_io: - case smm_two_way: - case smm_string_output: - return(strm->stream.int1); - - case smm_synonym: - strm = ecl_symbol_value(strm->stream.object0); - goto BEGIN; - - case smm_echo: - strm = strm->stream.object1; - goto BEGIN; - - case smm_input: -#if defined(ECL_WSOCK) - case smm_input_wsock: -#endif - case smm_string_input: - return 0; - - case smm_concatenated: - case smm_broadcast: - strm = strm->stream.object0; - if (ecl_endp(strm)) - return 0; - strm = CAR(strm); - goto BEGIN; - default: - ecl_internal_error("illegal stream mode"); - } -} - -cl_object -cl_make_synonym_stream(cl_object sym) -{ - cl_object x; - - sym = ecl_check_cl_type(@'make-synonym-stream',sym,t_symbol); - x = ecl_alloc_object(t_stream); - x->stream.mode = (short)smm_synonym; - x->stream.closed = 0; - x->stream.file = NULL; - x->stream.object0 = sym; - x->stream.object1 = OBJNULL; - x->stream.int0 = x->stream.int1 = 0; - @(return x) -} - -cl_object -cl_synonym_stream_symbol(cl_object strm) -{ - if (type_of(strm) != t_stream || strm->stream.mode != smm_synonym) - FEwrong_type_argument(@'synonym-stream', strm); - @(return strm->stream.object0) -} - -@(defun make_broadcast_stream (&rest ap) - cl_object x, streams; - int i; -@ - streams = Cnil; - for (i = 0; i < narg; i++) { - x = cl_va_arg(ap); - if (!ecl_output_stream_p(x)) - not_an_output_stream(x); - streams = CONS(x, streams); - } - x = ecl_alloc_object(t_stream); - x->stream.mode = (short)smm_broadcast; - x->stream.closed = 0; - x->stream.file = NULL; - x->stream.object0 = cl_nreverse(streams); - x->stream.object1 = OBJNULL; - x->stream.int0 = x->stream.int1 = 0; - @(return x) -@) - -cl_object -cl_broadcast_stream_streams(cl_object strm) -{ - if (type_of(strm) != t_stream || strm->stream.mode != smm_broadcast) - FEwrong_type_argument(@'broadcast-stream', strm); - return cl_copy_list(strm->stream.object0); -} - -@(defun make_concatenated_stream (&rest ap) - cl_object x, streams; - int i; -@ - streams = Cnil; - for (i = 0; i < narg; i++) { - x = cl_va_arg(ap); - if (!ecl_input_stream_p(x)) - not_an_input_stream(x); - streams = CONS(x, streams); - } - x = ecl_alloc_object(t_stream); - x->stream.mode = (short)smm_concatenated; - x->stream.closed = 0; - x->stream.file = NULL; - x->stream.object0 = cl_nreverse(streams); - x->stream.object1 = OBJNULL; - x->stream.int0 = x->stream.int1 = 0; - @(return x) -@) - -cl_object -cl_concatenated_stream_streams(cl_object strm) -{ - if (type_of(strm) != t_stream || strm->stream.mode != smm_concatenated) - FEwrong_type_argument(@'concatenated-stream', strm); - return cl_copy_list(strm->stream.object0); -} - -cl_object -cl_make_two_way_stream(cl_object istrm, cl_object ostrm) -{ - cl_object strm; - if (!ecl_input_stream_p(istrm)) - not_an_input_stream(istrm); - if (!ecl_output_stream_p(ostrm)) - not_an_output_stream(ostrm); - strm = ecl_alloc_object(t_stream); - strm->stream.mode = (short)smm_two_way; - strm->stream.closed = 0; - strm->stream.file = NULL; - strm->stream.object0 = istrm; - strm->stream.object1 = ostrm; - strm->stream.int0 = strm->stream.int1 = 0; - @(return strm) -} - -cl_object -cl_two_way_stream_input_stream(cl_object strm) -{ - if (type_of(strm) != t_stream || strm->stream.mode != smm_two_way) - FEwrong_type_argument(@'two-way-stream', strm); - @(return strm->stream.object0) -} - -cl_object -cl_two_way_stream_output_stream(cl_object strm) -{ - if (type_of(strm) != t_stream || strm->stream.mode != smm_two_way) - FEwrong_type_argument(@'two-way-stream', strm); - @(return strm->stream.object1) -} - -cl_object -cl_make_echo_stream(cl_object strm1, cl_object strm2) -{ - cl_object output; - if (!ecl_input_stream_p(strm1)) - not_an_input_stream(strm1); - if (!ecl_output_stream_p(strm2)) - not_an_output_stream(strm2); - output = cl_make_two_way_stream(strm1, strm2); - output->stream.mode = smm_echo; - @(return output) -} - -cl_object -cl_echo_stream_input_stream(cl_object strm) -{ - if (type_of(strm) != t_stream || strm->stream.mode != smm_echo) - FEwrong_type_argument(@'echo-stream', strm); - @(return strm->stream.object0) -} - -cl_object -cl_echo_stream_output_stream(cl_object strm) -{ - if (type_of(strm) != t_stream || strm->stream.mode != smm_echo) - FEwrong_type_argument(@'echo-stream', strm); - @(return strm->stream.object1) -} - -@(defun make_string_input_stream (strng &o istart iend) - cl_index s, e; -@ - strng = si_coerce_to_base_string(strng); -#ifdef ECL_UNICODE - if (type_of(strng) == t_string) { - FEerror("Reading from extended strings is not supported: ~A", - 1, strng); - } -#endif - if (Null(istart)) - s = 0; - else if (!FIXNUMP(istart) || FIXNUM_MINUSP(istart)) - goto E; - else - s = (cl_index)fix(istart); - if (Null(iend)) - e = strng->base_string.fillp; - else if (!FIXNUMP(iend) || FIXNUM_MINUSP(iend)) - goto E; - else - e = (cl_index)fix(iend); - if (e > strng->base_string.fillp || s > e) - goto E; - @(return (ecl_make_string_input_stream(strng, s, e))) - -E: - FEerror("~S and ~S are illegal as :START and :END~%\ -for the string ~S.", - 3, istart, iend, strng); -@) - -@(defun make-string-output-stream (&key (element_type @'base-char')) -@ - if (Null(funcall(3, @'subtypep', element_type, @'character'))) { - FEerror("In MAKE-STRING-OUTPUT-STREAM, the argument :ELEMENT-TYPE (~A) must be a subtype of character", - 1, element_type); - } - @(return ecl_make_string_output_stream(128)) -@) - -cl_object -cl_get_output_stream_string(cl_object strm) -{ - cl_object strng; - if (type_of(strm) != t_stream || - (enum ecl_smmode)strm->stream.mode != smm_string_output) - FEerror("~S is not a string-output stream.", 1, strm); - strng = si_copy_to_simple_base_string(strm->stream.object0); - strm->stream.object0->base_string.fillp = 0; - @(return strng) -} - -cl_object -cl_streamp(cl_object strm) -{ -#ifdef ECL_CLOS_STREAMS - if (ECL_INSTANCEP(strm)) { - return funcall(2, @'gray::streamp', strm); - } -#endif - @(return ((type_of(strm) == t_stream) ? Ct : Cnil)) -} - -cl_object -cl_input_stream_p(cl_object strm) -{ - @(return (ecl_input_stream_p(strm) ? Ct : Cnil)) -} - -cl_object -cl_output_stream_p(cl_object strm) -{ - @(return (ecl_output_stream_p(strm) ? Ct : Cnil)) -} - -static cl_fixnum -normalize_stream_element_type(cl_object element_type) -{ - cl_fixnum sign = 0; - cl_index size; - if (funcall(3, @'subtypep', element_type, @'unsigned-byte') != Cnil) { - sign = +1; - } else if (funcall(3, @'subtypep', element_type, @'signed-byte') != Cnil) { - sign = -1; - } else { - FEerror("Not a valid stream element type: ~A", 1, element_type); - } - if (CONSP(element_type)) { - if (CAR(element_type) == @'unsigned-byte') - return fixnnint(cl_cadr(element_type)); - if (CAR(element_type) == @'signed-byte') - return -fixnnint(cl_cadr(element_type)); - } - for (size = 1; 1; size++) { - cl_object type; - type = cl_list(2, sign>0? @'unsigned-byte' : @'signed-byte', - MAKE_FIXNUM(size)); - if (funcall(3, @'subtypep', element_type, type) != Cnil) { - return size * sign; - } - } -} - -@(defun open (filename - &key (direction @':input') - (element_type @'base-char') - (if_exists Cnil iesp) - (if_does_not_exist Cnil idnesp) - (external_format @':default') - (use_header_p Cnil) - &aux strm) - enum ecl_smmode smm; - bool char_stream_p; - cl_fixnum byte_size; -@ - if (external_format != @':default') - FEerror("~S is not a valid stream external format.", 1, - external_format); - /* INV: ecl_open_stream() checks types */ - if (direction == @':input') { - smm = smm_input; - if (!idnesp) - if_does_not_exist = @':error'; - } else if (direction == @':output') { - smm = smm_output; - if (!iesp) - if_exists = @':new_version'; - if (!idnesp) { - if (if_exists == @':overwrite' || - if_exists == @':append') - if_does_not_exist = @':error'; - else - if_does_not_exist = @':create'; - } - } else if (direction == @':io') { - smm = smm_io; - if (!iesp) - if_exists = @':new_version'; - if (!idnesp) { - if (if_exists == @':overwrite' || - if_exists == @':append') - if_does_not_exist = @':error'; - else - if_does_not_exist = @':create'; - } - } else if (direction == @':probe') { - smm = smm_probe; - if (!idnesp) - if_does_not_exist = Cnil; - } else { - FEerror("~S is an illegal DIRECTION for OPEN.", - 1, direction); - } - if (element_type == @':default') { - char_stream_p = 1; - byte_size = 8; - } else if (element_type == @'signed-byte') { - char_stream_p = 0; - byte_size = -8; - } else if (element_type == @'unsigned-byte') { - char_stream_p = 0; - byte_size = 8; - } else if (funcall(3, @'subtypep', element_type, @'character') != Cnil) { - char_stream_p = 1; - byte_size = 8; - } else { - char_stream_p = 0; - byte_size = normalize_stream_element_type(element_type); - } - strm = ecl_open_stream(filename, smm, if_exists, if_does_not_exist, - byte_size, char_stream_p); - @(return strm) -@) - -@(defun file-position (file_stream &o position) - cl_object output; -@ - if (Null(position)) { - output = ecl_file_position(file_stream); - } else { - if (position == @':start') { - position = MAKE_FIXNUM(0); - } else if (position == @':end') { - position = cl_file_length(file_stream); - if (position == Cnil) { - output = Cnil; - goto OUTPUT; + if (offset->big.big_size == 2) { + output = offset->big.big_limbs[1]; + output <<= FIXNUM_BITS; } + output += offset->big.big_limbs[0]; + } else if (sizeof(offset->big.big_limbs[0]) >= sizeof(ecl_off_t)) { + if (offset->big.big_size > 1) { + goto ERR; + } + output = offset->big.big_limbs[0]; } - output = ecl_file_position_set(file_stream, position); - } - OUTPUT: - @(return output) -@) - -cl_object -cl_file_string_length(cl_object stream, cl_object string) -{ - cl_fixnum l; - /* This is a stupid requirement from the spec. Why returning 1??? - * Why not simply leaving the value unspecified, as with other - * streams one cannot write to??? - */ - if (type_of(stream) == t_stream && - stream->stream.mode == smm_broadcast) { - stream = stream->stream.object0; - if (ecl_endp(stream)) - @(return MAKE_FIXNUM(1)) - } - switch (type_of(string)) { - case t_base_string: - l = string->base_string.fillp; - break; - case t_character: - l = 1; - break; - default: - FEwrong_type_argument(@'string', string); - } - @(return MAKE_FIXNUM(l)) -} - - -cl_object -cl_open_stream_p(cl_object strm) -{ - /* ANSI and Cltl2 specify that open-stream-p should work - on closed streams, and that a stream is only closed - when #'close has been applied on it */ - if (type_of(strm) != t_stream) - FEwrong_type_argument(@'stream', strm); - @(return (strm->stream.closed ? Cnil : Ct)) -} - -cl_object -si_make_string_output_stream_from_string(cl_object s) -{ - cl_object strm; - - if (type_of(s) != t_base_string || !s->base_string.hasfillp) - FEerror("~S is not a base-string with a fill-pointer.", 1, s); - strm = ecl_alloc_object(t_stream); - strm->stream.mode = (short)smm_string_output; - strm->stream.closed = 0; - strm->stream.file = NULL; - strm->stream.object0 = s; - strm->stream.object1 = OBJNULL; - strm->stream.int0 = s->base_string.fillp; - strm->stream.int1 = 0; - strm->stream.char_stream_p = 1; - strm->stream.byte_size = 8; - strm->stream.signed_bytes = 0; - @(return strm) -} - -cl_object -si_copy_stream(cl_object in, cl_object out) -{ - int c; - for (c = ecl_read_char(in); c != EOF; c = ecl_read_char(in)) { - ecl_write_char(c, out); - } - ecl_force_output(out); - @(return Ct) -} - -cl_object -cl_interactive_stream_p(cl_object strm) -{ - cl_object output = Cnil; - cl_type t; - BEGIN: - t = type_of(strm); -#ifdef ECL_CLOS_STREAMS - if (t == t_instance) - return funcall(2, @'gray::stream-interactive-p', strm); -#endif - if (t != t_stream) - FEtype_error_stream(strm); - if (strm->stream.closed) - FEclosed_stream(strm); - switch(strm->stream.mode) { - case smm_synonym: - strm = ecl_symbol_value(strm->stream.object0); - goto BEGIN; - case smm_two_way: - strm = strm->stream.object0; - goto BEGIN; - case smm_input: - case smm_io: -#ifdef HAVE_ISATTY - /* Here we should check for the type of file descriptor, - * and whether it is connected to a tty. */ - output = isatty(fileno((FILE*)strm->stream.file))? Ct : Cnil; -#endif - break; - default:; - } - @(return output) -} - -cl_object -ecl_make_stream_from_FILE(cl_object fname, void *fp, enum ecl_smmode smm) -{ - cl_object stream; - stream = ecl_alloc_object(t_stream); - stream->stream.mode = (short)smm; - stream->stream.closed = 0; - stream->stream.file = fp; -#if defined (ECL_WSOCK) - if ( smm == smm_input_wsock || smm == smm_io_wsock ) - stream->stream.object0 = Cnil; - else - stream->stream.object0 = @'base-char'; #else - stream->stream.object0 = @'base-char'; + output = offset->big.big_num; #endif - stream->stream.object1 = fname; /* not really used */ - stream->stream.int0 = stream->stream.int1 = 0; - stream->stream.char_stream_p = 1; - stream->stream.byte_size = 8; - stream->stream.signed_bytes = 0; - stream->stream.last_op = 0; - si_set_finalizer(stream, Ct); - return(stream); + } else { + ERR: FEerror("Not a valid file offset: ~S", 1, offset); + } + return output; } -cl_object -ecl_make_stream_from_fd(cl_object fname, int fd, enum ecl_smmode smm) +static cl_object +alloc_stream() { - char *mode; /* file open mode */ - FILE *fp; /* file pointer */ + cl_object x = ecl_alloc_object(t_stream); + x->stream.closed = 0; + x->stream.file = NULL; + x->stream.object0 = + x->stream.object1 = OBJNULL; + x->stream.int0 = x->stream.int1 = 0; + x->stream.unread = EOF; + x->stream.char_stream_p = 1; + x->stream.byte_size = 8; + x->stream.signed_bytes = 0; + x->stream.buffer = NULL; + return x; +} - switch(smm) { - case smm_input: - mode = "r"; - break; - case smm_output: - mode = "w"; - break; - case smm_io: - mode = "w+"; - break; -#if defined(ECL_WSOCK) - case smm_input_wsock: - case smm_output_wsock: - case smm_io_wsock: - break; -#endif - default: - FEerror("make_stream: wrong mode", 0); - } - ecl_disable_interrupts(); -#if defined(ECL_WSOCK) - if (smm == smm_input_wsock || smm == smm_output_wsock || smm == smm_io_wsock) - fp = (FILE*)fd; - else - fp = fdopen(fd, mode); -#else - fp = fdopen(fd, mode); -#endif +/********************************************************************** + * ERROR MESSAGES + */ + +static cl_object +not_a_file_stream(cl_object strm) +{ + cl_error(9, @'simple-type-error', @':format-control', + make_constant_base_string("~A is not an file stream"), + @':format-arguments', cl_list(1, strm), + @':expected-type', @'file-stream', + @':datum', strm); +} + +static void +not_an_input_stream(cl_object strm) +{ + cl_error(9, @'simple-type-error', @':format-control', + make_constant_base_string("~A is not an input stream"), + @':format-arguments', cl_list(1, strm), + @':expected-type', cl_list(2, @'satisfies', @'input-stream-p'), + @':datum', strm); +} + +static void +not_an_output_stream(cl_object strm) +{ + cl_error(9, @'simple-type-error', @':format-control', + make_constant_base_string("~A is not an output stream"), + @':format-arguments', cl_list(1, strm), + @':expected-type', cl_list(2, @'satisfies', @'output-stream-p'), + @':datum', strm); +} + +static void +not_a_character_stream(cl_object s) +{ + cl_error(9, @'simple-type-error', @':format-control', + make_constant_base_string("~A is not a character stream"), + @':format-arguments', cl_list(1, s), + @':expected-type', @'character', + @':datum', cl_stream_element_type(s)); +} + +static void +not_a_binary_stream(cl_object s) +{ + cl_error(9, @'simple-type-error', @':format-control', + make_constant_base_string("~A is not a binary stream"), + @':format-arguments', cl_list(1, s), + @':expected-type', @'integer', + @':datum', cl_stream_element_type(s)); +} + +static void +unread_error(cl_object s) +{ + CEerror(Ct, "Error when using UNREAD-CHAR on stream ~D", 1, s); +} + +static void +unread_twice(cl_object s) +{ + CEerror(Ct, "Used UNREAD-CHAR twice on stream ~D", 1, s); +} + +static int +restartable_io_error(cl_object strm) +{ + cl_env_ptr the_env = &cl_env; + volatile int old_errno = errno; + /* ecl_disable_interrupts(); ** done by caller */ + clearerr((FILE*)strm->stream.file); ecl_enable_interrupts(); - return ecl_make_stream_from_FILE(fname, fp, smm); + if (errno == EINTR) { + return 1; + } else { + FElibc_error("Read or write operation to stream ~S signaled an error.", + 1, strm); + return 0; + } } -int -ecl_stream_to_handle(cl_object s, bool output) +static void +io_error(cl_object strm) { - FILE *f; - BEGIN: - if (type_of(s) != t_stream) - return -1; - switch ((enum ecl_smmode)s->stream.mode) { - case smm_input: - if (output) return -1; - f = (FILE*)s->stream.file; - break; - case smm_output: - if (!output) return -1; - f = (FILE*)s->stream.file; - break; - case smm_io: - f = (FILE*)s->stream.file; - break; - case smm_synonym: - s = ecl_symbol_value(s->stream.object0); - goto BEGIN; - case smm_two_way: - s = output? s->stream.object1 : s->stream.object0; - goto BEGIN; - default: - ecl_internal_error("illegal stream mode"); - } - return fileno(f); + cl_env_ptr the_env = &cl_env; + FILE *f = IO_STREAM_FILE(strm); + /* ecl_disable_interrupts(); ** done by caller */ + clearerr(f); + ecl_enable_interrupts(); + FElibc_error("Read or write operation to stream ~S signaled an error.", + 1, strm); } +static void +wrong_file_handler(cl_object strm) +{ + FEerror("Internal error: stream ~S has no valid C file handler.", 1, strm); +} + +#if defined(ECL_WSOCK) +static void +wsock_error( const char *err_msg, cl_object strm ) +{ + char *msg; + cl_object msg_obj; + /* ecl_disable_interrupts(); ** done by caller */ + { + FormatMessage( FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER, + 0, WSAGetLastError(), 0, ( void* )&msg, 0, NULL ); + msg_obj = make_base_string_copy( msg ); + LocalFree( msg ); + } + ecl_enable_interrupts(); + FEerror( err_msg, 2, strm, msg_obj ); +} +#endif + void init_file(void) { @@ -2873,79 +3357,37 @@ init_file(void) cl_object standard_input; cl_object standard_output; cl_object error_output; - cl_object standard; + cl_object aux; cl_object null_stream; cl_object x; - null_stream = ecl_alloc_object(t_stream); - null_stream->stream.mode = (short)smm_io; - null_stream->stream.closed = 1; - null_stream->stream.file = NULL; - null_stream->stream.object0 = @'base-char'; - null_stream->stream.object1 = make_constant_base_string("/dev/null"); - null_stream->stream.int0 = 0; - null_stream->stream.int1 = 0; - null_stream->stream.char_stream_p = 1; - null_stream->stream.byte_size = 8; - null_stream->stream.signed_bytes = 0; + null_stream = ecl_make_stream_from_FILE(make_constant_base_string("/dev/null"), + NULL, smm_io, 8, 1); + generic_close(null_stream); null_stream = cl_make_two_way_stream(null_stream, cl_make_broadcast_stream(0)); cl_core.null_stream = null_stream; - standard_input = ecl_alloc_object(t_stream); - standard_input->stream.mode = (short)smm_input; - standard_input->stream.closed = 0; - standard_input->stream.file = stdin; - standard_input->stream.object0 = @'base-char'; - standard_input->stream.object1 = make_constant_base_string("stdin"); - standard_input->stream.int0 = 0; - standard_input->stream.int1 = 0; - standard_input->stream.char_stream_p = 1; - standard_input->stream.byte_size = 8; - standard_input->stream.signed_bytes = 0; + standard_input = ecl_make_stream_from_FILE(make_constant_base_string("stdin"), + stdin, smm_input, 8, 1); - standard_output = ecl_alloc_object(t_stream); - standard_output->stream.mode = (short)smm_output; - standard_output->stream.closed = 0; - standard_output->stream.file = stdout; - standard_output->stream.object0 = @'base-char'; - standard_output->stream.object1= make_constant_base_string("stdout"); - standard_output->stream.int0 = 0; - standard_output->stream.int1 = 0; - standard_output->stream.char_stream_p = 1; - standard_output->stream.byte_size = 8; - standard_output->stream.signed_bytes = 0; + standard_output = ecl_make_stream_from_FILE(make_constant_base_string("stdout"), + stdout, smm_output, 8, 1); - error_output = ecl_alloc_object(t_stream); - error_output->stream.mode = (short)smm_output; - error_output->stream.closed = 0; - error_output->stream.file = stderr; - error_output->stream.object0 = @'base-char'; - error_output->stream.object1= make_constant_base_string("stderr"); - error_output->stream.int0 = 0; - error_output->stream.int1 = 0; - error_output->stream.char_stream_p = 1; - error_output->stream.byte_size = 8; - error_output->stream.signed_bytes = 0; + error_output = ecl_make_stream_from_FILE(make_constant_base_string("stderr"), + stderr, smm_output, 8, 1); - cl_core.terminal_io = standard - = cl_make_two_way_stream(standard_input, standard_output); + cl_core.terminal_io = aux + = cl_make_two_way_stream(standard_input, standard_output); - ECL_SET(@'*terminal-io*', standard); + ECL_SET(@'*terminal-io*', aux); - x = ecl_alloc_object(t_stream); - x->stream.mode = (short)smm_synonym; - x->stream.closed = 0; - x->stream.file = NULL; - x->stream.object0 = @'*terminal-io*'; - x->stream.object1 = OBJNULL; - x->stream.int0 = x->stream.int1 = 0; - standard = x; + aux = cl_make_synonym_stream(@'*terminal-io*'); - ECL_SET(@'*standard-input*', standard); - ECL_SET(@'*standard-output*', standard); + ECL_SET(@'*standard-input*', aux); + ECL_SET(@'*standard-output*', aux); ECL_SET(@'*error-output*', error_output); - ECL_SET(@'*query-io*', standard); - ECL_SET(@'*debug-io*', standard); - ECL_SET(@'*trace-output*', standard); + ECL_SET(@'*query-io*', aux); + ECL_SET(@'*debug-io*', aux); + ECL_SET(@'*trace-output*', aux); } diff --git a/src/c/format.d b/src/c/format.d index 3c80acde8..c94696a77 100644 --- a/src/c/format.d +++ b/src/c/format.d @@ -1444,7 +1444,7 @@ fmt_case(format_stack fmt, bool colon, bool atsign) else format(fmt, fmt->ctl_str + i, j - i); fmt_copy1(fmt, &fmt_old); - x = x->stream.object0; + x = STRING_OUTPUT_STRING(x); if (!colon && !atsign) for (i = 0; i < x->string.fillp; i++) { if (isupper(j = x->string.self[i])) @@ -1729,7 +1729,7 @@ fmt_justification(format_stack fmt, volatile bool colon, bool atsign) } fmt->stream = this_field; format(fmt, fmt->ctl_str + i, j - i); - fields = CONS(this_field->stream.object0, fields); + fields = CONS(STRING_OUTPUT_STRING(this_field), fields); fmt_copy1(fmt, &fmt_old); if (fmt->ctl_str[--j0] == '>') { @@ -1867,7 +1867,7 @@ doformat(cl_narg narg, cl_object strm, cl_object string, cl_va_list args, bool i fmt.indents = 0; fmt.string = string; fmt.aux_stream = get_aux_stream(); - fmt.aux_string = fmt.aux_stream->stream.object0; + fmt.aux_string = STRING_OUTPUT_STRING(fmt.aux_stream); if ((colon = ecl_setjmp(*fmt.jmp_buf))) { if (--colon) fmt_error(&fmt, "illegal ~:^"); @@ -2122,7 +2122,7 @@ DIRECTIVE: @':offset', MAKE_FIXNUM(0)); } strm = ecl_make_string_output_stream(0); - strm->stream.object0 = output; + STRING_OUTPUT_STRING(strm) = output; if (null_strm == 0) output = Cnil; } diff --git a/src/c/pathname.d b/src/c/pathname.d index 7edb0ed2a..cee9c3b19 100644 --- a/src/c/pathname.d +++ b/src/c/pathname.d @@ -23,6 +23,7 @@ #include #include +#include #include #include #include @@ -643,25 +644,18 @@ L: #endif case t_base_string: x = cl_parse_namestring(1, x); - case t_pathname: break; - case t_stream: switch ((enum ecl_smmode)x->stream.mode) { case smm_input: case smm_output: case smm_probe: case smm_io: - x = x->stream.object1; - /* - The file was stored in stream.object1. - See open. - */ + x = IO_STREAM_FILENAME(x); goto L; - case smm_synonym: - x = ecl_symbol_value(x->stream.object0); + x = SYNONYM_STREAM_STREAM(x); goto L; default: ;/* Fall through to error message */ diff --git a/src/c/print.d b/src/c/print.d index 8ecce4913..d886cc77c 100644 --- a/src/c/print.d +++ b/src/c/print.d @@ -1346,44 +1346,44 @@ si_write_ugly_object(cl_object x, cl_object stream) switch ((enum ecl_smmode)x->stream.mode) { case smm_input: write_str("input stream ", stream); - si_write_ugly_object(x->stream.object1, stream); + si_write_ugly_object(IO_STREAM_FILENAME(x), stream); break; case smm_output: write_str("output stream ", stream); - si_write_ugly_object(x->stream.object1, stream); + si_write_ugly_object(IO_STREAM_FILENAME(x), stream); break; #ifdef _MSC_VER case smm_input_wsock: write_str("input win32 socket stream ", stream); - si_write_ugly_object(x->stream.object1, stream); + si_write_ugly_object(IO_STREAM_FILENAME(x), stream); break; case smm_output_wsock: write_str("output win32 socket stream ", stream); - si_write_ugly_object(x->stream.object1, stream); + si_write_ugly_object(IO_STREAM_FILENAME(x), stream); break; case smm_io_wsock: write_str("i/o win32 socket stream ", stream); - si_write_ugly_object(x->stream.object1, stream); + si_write_ugly_object(IO_STREAM_FILENAME(x), stream); break; #endif case smm_io: write_str("io stream ", stream); - si_write_ugly_object(x->stream.object1, stream); + si_write_ugly_object(IO_STREAM_FILENAME(x), stream); break; case smm_probe: write_str("probe stream ", stream); - si_write_ugly_object(x->stream.object1, stream); + si_write_ugly_object(IO_STREAM_FILENAME(x), stream); break; case smm_synonym: write_str("synonym stream to ", stream); - si_write_ugly_object(x->stream.object0, stream); + si_write_ugly_object(SYNONYM_STREAM_SYMBOL(x), stream); break; case smm_broadcast: diff --git a/src/c/tcp.d b/src/c/tcp.d index 60cea2fd4..25cc4a6cc 100644 --- a/src/c/tcp.d +++ b/src/c/tcp.d @@ -283,9 +283,9 @@ si_open_client_stream(cl_object host, cl_object port) @(return Cnil) #if defined(_MSC_VER) || defined(mingw32) - stream = ecl_make_stream_from_fd(host, fd, smm_io_wsock); + stream = ecl_make_stream_from_fd(host, fd, smm_io_wsock, 8, 0); #else - stream = ecl_make_stream_from_fd(host, fd, smm_io); + stream = ecl_make_stream_from_fd(host, fd, smm_io, 8, 0); #endif @(return stream) @@ -303,7 +303,7 @@ si_open_server_stream(cl_object port) fd = create_server_port(p); ecl_enable_interrupts(); - @(return ((fd == 0)? Cnil : ecl_make_stream_from_fd(Cnil, fd, smm_io))) + @(return ((fd == 0)? Cnil : ecl_make_stream_from_fd(Cnil, fd, smm_io, 8, 0))) } /************************************************************ @@ -341,7 +341,7 @@ si_open_unix_socket_stream(cl_object path) @(return Cnil) } - @(return ecl_make_stream_from_fd(path, fd, smm_io)) + @(return ecl_make_stream_from_fd(path, fd, smm_io, 8, 0)) #endif } diff --git a/src/c/unixsys.d b/src/c/unixsys.d index 7e61c6cdf..e971b966a 100644 --- a/src/c/unixsys.d +++ b/src/c/unixsys.d @@ -69,9 +69,9 @@ si_make_pipe() output = Cnil; } else { cl_object fake_in_name = make_simple_base_string("PIPE-READ-ENDPOINT"); - cl_object in = ecl_make_stream_from_fd(fake_in_name, fds[0], smm_input); + cl_object in = ecl_make_stream_from_fd(fake_in_name, fds[0], smm_input, 8, 0); cl_object fake_out_name = make_simple_base_string("PIPE-WRITE-ENDPOINT"); - cl_object out = ecl_make_stream_from_fd(fake_out_name, fds[1], smm_output); + cl_object out = ecl_make_stream_from_fd(fake_out_name, fds[1], smm_output, 8, 0); output = cl_make_two_way_stream(in, out); } @(return output) @@ -360,14 +360,14 @@ si_make_pipe() } if (parent_write > 0) { stream_write = ecl_make_stream_from_fd(command, parent_write, - smm_output); + smm_output, 8, 0); } else { parent_write = 0; stream_write = cl_core.null_stream; } if (parent_read > 0) { stream_read = ecl_make_stream_from_fd(command, parent_read, - smm_input); + smm_input, 8, 0); } else { parent_read = 0; stream_read = cl_core.null_stream; diff --git a/src/h/external.h b/src/h/external.h index 683230246..8ceebb694 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -595,6 +595,8 @@ extern ECL_API cl_object si_set_buffering_mode(cl_object strm, cl_object mode); extern ECL_API bool ecl_input_stream_p(cl_object strm); extern ECL_API bool ecl_output_stream_p(cl_object strm); +extern ECL_API cl_object ecl_stream_element_type(cl_object strm); +extern ECL_API bool ecl_interactive_stream_p(cl_object strm); extern ECL_API cl_object ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, cl_object if_does_not_exist, cl_fixnum byte_size, bool char_stream_p); extern ECL_API cl_object ecl_make_string_input_stream(cl_object strng, cl_index istart, cl_index iend); extern ECL_API cl_object ecl_make_string_output_stream(cl_index line_length); @@ -606,16 +608,17 @@ extern ECL_API void ecl_unread_char(int c, cl_object strm); extern ECL_API int ecl_peek_char(cl_object strm); extern ECL_API int ecl_write_char(int c, cl_object strm); extern ECL_API void writestr_stream(const char *s, cl_object strm); -#define ecl_finish_output(x) ecl_force_output(x) extern ECL_API void ecl_force_output(cl_object strm); +extern ECL_API void ecl_finish_output(cl_object strm); extern ECL_API void ecl_clear_input(cl_object strm); extern ECL_API void ecl_clear_output(cl_object strm); extern ECL_API bool ecl_listen_stream(cl_object strm); extern ECL_API cl_object ecl_file_position(cl_object strm); extern ECL_API cl_object ecl_file_position_set(cl_object strm, cl_object disp); +extern ECL_API cl_object ecl_file_length(cl_object strm); extern ECL_API int ecl_file_column(cl_object strm); -extern ECL_API cl_object ecl_make_stream_from_fd(cl_object host, int fd, enum ecl_smmode smm); -extern ECL_API cl_object ecl_make_stream_from_FILE(cl_object host, void *fd, enum ecl_smmode smm); +extern ECL_API cl_object ecl_make_stream_from_fd(cl_object fname, int fd, enum ecl_smmode smm, cl_fixnum byte_size, int char_stream_p); +extern ECL_API cl_object ecl_make_stream_from_FILE(cl_object fname, void *fd, enum ecl_smmode smm, cl_fixnum byte_size, int char_stream_p); extern ECL_API int ecl_stream_to_handle(cl_object s, bool output); /* finalize.c */ diff --git a/src/h/internal.h b/src/h/internal.h index 7719379f8..61a8cb7bf 100644 --- a/src/h/internal.h +++ b/src/h/internal.h @@ -122,6 +122,24 @@ extern void* ecl_dynamic_callback_make(cl_object data, enum ecl_ffi_calling_conv #define OPEN_A "ab" #define OPEN_RA "a+b" +#define STRING_OUTPUT_STRING(strm) (strm)->stream.object0 +#define STRING_OUTPUT_COLUMN(strm) (strm)->stream.int1 +#define STRING_INPUT_STRING(strm) (strm)->stream.object0 +#define STRING_INPUT_POSITION(strm) (strm)->stream.int0 +#define STRING_INPUT_LIMIT(strm) (strm)->stream.int1 +#define TWO_WAY_STREAM_INPUT(strm) (strm)->stream.object0 +#define TWO_WAY_STREAM_OUTPUT(strm) (strm)->stream.object1 +#define SYNONYM_STREAM_SYMBOL(strm) (strm)->stream.object0 +#define SYNONYM_STREAM_STREAM(strm) ecl_symbol_value((strm)->stream.object0) +#define BROADCAST_STREAM_LIST(strm) (strm)->stream.object0 +#define ECHO_STREAM_INPUT(strm) (strm)->stream.object0 +#define ECHO_STREAM_OUTPUT(strm) (strm)->stream.object1 +#define CONCATENATED_STREAM_LIST(strm) (strm)->stream.object0 +#define IO_STREAM_FILE(strm) (FILE*)((strm)->stream.file) +#define IO_STREAM_COLUMN(strm) (strm)->stream.int1 +#define IO_STREAM_ELT_TYPE(strm) (strm)->stream.object0 +#define IO_STREAM_FILENAME(strm) (strm)->stream.object1 + /* format.d */ #ifndef ECL_CMU_FORMAT diff --git a/src/h/object.h b/src/h/object.h index ca203fe6a..178a6af04 100644 --- a/src/h/object.h +++ b/src/h/object.h @@ -472,18 +472,50 @@ enum ecl_smmode { /* stream mode */ #endif }; +struct ecl_file_ops { + cl_index (*write_byte8)(cl_object strm, char *c, cl_index n); + cl_index (*read_byte8)(cl_object strm, char *c, cl_index n); + + int (*read_char)(cl_object strm); + int (*write_char)(cl_object strm, int c); + void (*unread_char)(cl_object strm, int c); + int (*peek_char)(cl_object strm); + + cl_index (*read_vector)(cl_object strm, cl_object data, cl_index start, cl_index end); + cl_index (*write_vector)(cl_object strm, cl_object data, cl_index start, cl_index end); + + int (*listen)(cl_object strm); + void (*clear_input)(cl_object strm); + void (*clear_output)(cl_object strm); + void (*finish_output)(cl_object strm); + void (*force_output)(cl_object strm); + + int (*input_p)(cl_object strm); + int (*output_p)(cl_object strm); + int (*interactive_p)(cl_object strm); + cl_object (*element_type)(cl_object strm); + + cl_object (*length)(cl_object strm); + cl_object (*get_position)(cl_object strm); + cl_object (*set_position)(cl_object strm, cl_object pos); + int (*column)(cl_object strm); + + cl_object (*close)(cl_object strm); +}; + struct ecl_stream { - HEADER4(mode,closed,char_stream_p,signed_bytes); + HEADER4(mode,char_stream_p,closed,signed_bytes); /* stream mode of enum smmode */ - /* stream element type */ - void *file; /* file pointer */ + struct ecl_file_ops *ops; /* dispatch table */ + void *file; /* file pointer */ cl_object object0; /* some object */ cl_object object1; /* some object */ + cl_fixnum unread; /* one-char buffer for unread-char */ cl_fixnum int0; /* some int */ cl_fixnum int1; /* some int */ - char *buffer; /* file buffer */ cl_index byte_size; /* size of byte in binary streams */ - int8_t last_op; /* 0: unknown, 1: reading, -1: writing */ + cl_fixnum last_op; /* 0: unknown, 1: reading, -1: writing */ + char *buffer; /* buffer for FILE */ }; struct ecl_random { From 2b868dfe4962485011c9f91d81f52cb4319d53a2 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sun, 19 Oct 2008 00:11:05 +0200 Subject: [PATCH 35/60] string-input-streams have their own unread mechanism. --- src/c/file.d | 21 +++++++-------------- 1 file changed, 7 insertions(+), 14 deletions(-) diff --git a/src/c/file.d b/src/c/file.d index 16f9d612b..47f5bbf3c 100644 --- a/src/c/file.d +++ b/src/c/file.d @@ -776,17 +776,13 @@ cl_get_output_stream_string(cl_object strm) static int str_in_read_char(cl_object strm) { - int c = strm->stream.unread; - if (c != EOF) { - strm->stream.unread = EOF; + cl_fixnum curr_pos = STRING_INPUT_POSITION(strm); + int c; + if (curr_pos >= STRING_INPUT_LIMIT(strm)) { + c = EOF; } else { - cl_fixnum curr_pos = STRING_INPUT_POSITION(strm); - if (curr_pos >= STRING_INPUT_LIMIT(strm)) { - c = EOF; - } else { - c = STRING_INPUT_STRING(strm)->base_string.self[curr_pos]; - STRING_INPUT_POSITION(strm) = curr_pos+1; - } + c = STRING_INPUT_STRING(strm)->base_string.self[curr_pos]; + STRING_INPUT_POSITION(strm) = curr_pos+1; } return c; } @@ -800,7 +796,7 @@ str_in_unread_char(cl_object strm, int c) if (c <= 0) { unread_error(strm); } - generic_unread_char(strm, c); + STRING_INPUT_POSITION(strm) = curr_pos - 1; } static int @@ -813,13 +809,10 @@ str_in_peek_char(cl_object strm) return STRING_INPUT_STRING(strm)->base_string.self[pos]; } } -#define str_in_peek_char generic_peek_char static int str_in_listen(cl_object strm) { - if (strm->stream.unread != EOF) - return ECL_LISTEN_AVAILABLE; if (STRING_INPUT_POSITION(strm) < STRING_INPUT_LIMIT(strm)) return ECL_LISTEN_AVAILABLE; else From 8525cff42207a521038529a024b74997a1b3f0d9 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sun, 19 Oct 2008 19:53:12 +0200 Subject: [PATCH 36/60] Avoid using synonyms for the values of standard input/output and error/trace output. --- src/CHANGELOG | 4 ++++ src/c/file.d | 12 +++++------- 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/src/CHANGELOG b/src/CHANGELOG index 01c85957d..5621dd450 100644 --- a/src/CHANGELOG +++ b/src/CHANGELOG @@ -86,6 +86,10 @@ ECL 8.9.0: on C structures with a method dispatch table. Apart from code reuse and better maintainability, this allows a more sensible design of read/write-sequence. + - *STANDARD-INPUT*, *{STANDARD,ERROR,TRACE}-OUTPUT* are no longer synonyms to + *TERMINAL-IO* but directly the input or output streams associated to stdin, + stdout and stderr. + * Embedding: - ECL now implements a more transparent interface for setting and querying diff --git a/src/c/file.d b/src/c/file.d index 47f5bbf3c..433a306c2 100644 --- a/src/c/file.d +++ b/src/c/file.d @@ -3369,18 +3369,16 @@ init_file(void) error_output = ecl_make_stream_from_FILE(make_constant_base_string("stderr"), stderr, smm_output, 8, 1); + ECL_SET(@'*standard-input*', standard_input); + ECL_SET(@'*standard-output*', standard_output); + ECL_SET(@'*trace-output*', standard_output); + ECL_SET(@'*error-output*', error_output); + cl_core.terminal_io = aux = cl_make_two_way_stream(standard_input, standard_output); ECL_SET(@'*terminal-io*', aux); - aux = cl_make_synonym_stream(@'*terminal-io*'); - - ECL_SET(@'*standard-input*', aux); - ECL_SET(@'*standard-output*', aux); - ECL_SET(@'*error-output*', error_output); - ECL_SET(@'*query-io*', aux); ECL_SET(@'*debug-io*', aux); - ECL_SET(@'*trace-output*', aux); } From e5c608b379a605e0248be77ff400d0f0467c522f Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Mon, 20 Oct 2008 00:27:21 +0200 Subject: [PATCH 37/60] Implement streams based on POSIX file descriptors. --- src/CHANGELOG | 3 + src/c/cinit.d | 21 +- src/c/file.d | 810 ++++++++++++++++++++++++++++++------------ src/c/load.d | 2 +- src/c/symbols_list.h | 2 +- src/c/symbols_list2.h | 2 +- src/c/unixfsys.d | 10 +- src/h/external.h | 9 +- src/h/internal.h | 4 + src/h/object.h | 7 +- 10 files changed, 622 insertions(+), 248 deletions(-) diff --git a/src/CHANGELOG b/src/CHANGELOG index 5621dd450..8f45b6f32 100644 --- a/src/CHANGELOG +++ b/src/CHANGELOG @@ -90,6 +90,9 @@ ECL 8.9.0: *TERMINAL-IO* but directly the input or output streams associated to stdin, stdout and stderr. + - Internally, ECL allows to work with POSIX file descriptors directly, without + using C streams. + * Embedding: - ECL now implements a more transparent interface for setting and querying diff --git a/src/c/cinit.d b/src/c/cinit.d index e0f9d07ad..3ccd44438 100644 --- a/src/c/cinit.d +++ b/src/c/cinit.d @@ -78,22 +78,25 @@ si_find_relative_package(cl_narg narg, cl_object package, ...) static cl_object si_simple_toplevel () { + cl_object output = cl_core.standard_output; cl_object sentence; int i; /* Simple minded top level loop */ - printf(";*** Lisp core booted ****\nECL (Embeddable Common Lisp) %d pages\n", MAXPAGE); - fflush(stdout); + writestr_stream(";*** Lisp core booted ****\n" + "ECL (Embeddable Common Lisp)\n", + output); + ecl_force_output(output); for (i = 1; i "); - sentence = @read(3, Cnil, Cnil, OBJNULL); - if (sentence == OBJNULL) - @(return); - ecl_prin1(si_eval_with_env(1, sentence), Cnil); + writestr_stream("\n> ", output); + sentence = @read(3, Cnil, Cnil, OBJNULL); + if (sentence == OBJNULL) + @(return); + ecl_prin1(si_eval_with_env(1, sentence), output); } } diff --git a/src/c/file.d b/src/c/file.d index 433a306c2..82fa890fd 100644 --- a/src/c/file.d +++ b/src/c/file.d @@ -56,13 +56,14 @@ #define ecl_ftello ftello #endif -static cl_index ecl_read_byte8(cl_object stream, char *c, cl_index n); -static cl_index ecl_write_byte8(cl_object stream, char *c, cl_index n); +static cl_index ecl_read_byte8(cl_object stream, unsigned char *c, cl_index n); +static cl_index ecl_write_byte8(cl_object stream, unsigned char *c, cl_index n); struct ecl_file_ops *duplicate_dispatch_table(const struct ecl_file_ops *ops); const struct ecl_file_ops *stream_dispatch_table(cl_object strm); static int flisten(FILE *); +static int file_listen(int); static void io_stream_begin_write(cl_object strm); static void io_stream_begin_read(cl_object strm); static cl_object ecl_off_t_to_integer(ecl_off_t offset); @@ -86,28 +87,28 @@ static void wrong_file_handler(cl_object strm); */ static cl_index -not_output_write_byte8(cl_object strm, char *c, cl_index n) +not_output_write_byte8(cl_object strm, unsigned char *c, cl_index n) { not_an_output_stream(strm); return 0; } static cl_index -not_input_read_byte8(cl_object strm, char *c, cl_index n) +not_input_read_byte8(cl_object strm, unsigned char *c, cl_index n) { not_an_input_stream(strm); return 0; } static cl_index -not_binary_write_byte8(cl_object strm, char *c, cl_index n) +not_binary_write_byte8(cl_object strm, unsigned char *c, cl_index n) { not_a_binary_stream(strm); return 0; } static cl_index -not_binary_read_byte8(cl_object strm, char *c, cl_index n) +not_binary_read_byte8(cl_object strm, unsigned char *c, cl_index n) { not_a_binary_stream(strm); return 0; @@ -214,13 +215,13 @@ not_implemented_set_position(cl_object strm, cl_object pos) */ static cl_index -closed_stream_read_byte8(cl_object strm, char *c, cl_index n) +closed_stream_read_byte8(cl_object strm, unsigned char *c, cl_index n) { FEclosed_stream(strm); } static cl_index -closed_stream_write_byte8(cl_object strm, char *c, cl_index n) +closed_stream_write_byte8(cl_object strm, unsigned char *c, cl_index n) { FEclosed_stream(strm); } @@ -284,7 +285,7 @@ closed_stream_set_position(cl_object strm, cl_object position) * the character size matches that of the byte. */ static cl_index -generic_write_byte8(cl_object strm, char *c, cl_index n) +generic_write_byte8(cl_object strm, unsigned char *c, cl_index n) { const struct ecl_file_ops *ops = stream_dispatch_table(strm); cl_index i; @@ -295,7 +296,7 @@ generic_write_byte8(cl_object strm, char *c, cl_index n) } static cl_index -generic_read_byte8(cl_object strm, char *c, cl_index n) +generic_read_byte8(cl_object strm, unsigned char *c, cl_index n) { const struct ecl_file_ops *ops = stream_dispatch_table(strm); cl_index i; @@ -315,7 +316,7 @@ generic_read_char(cl_object strm) int c = strm->stream.unread; if (c == EOF) { const struct ecl_file_ops *ops = stream_dispatch_table(strm); - char aux; + unsigned char aux; if (ops->read_byte8(strm, &aux, 1) < 1) c = EOF; else @@ -462,7 +463,7 @@ generic_read_vector(cl_object strm, cl_object data, cl_index start, cl_index end */ static cl_index -clos_stream_read_byte8(cl_object strm, char *c, cl_index n) +clos_stream_read_byte8(cl_object strm, unsigned char *c, cl_index n) { cl_index i; for (i = 0; i < n; i++) { @@ -475,7 +476,7 @@ clos_stream_read_byte8(cl_object strm, char *c, cl_index n) } static cl_index -clos_stream_write_byte8(cl_object strm, char *c, cl_index n) +clos_stream_write_byte8(cl_object strm, unsigned char *c, cl_index n) { cl_index i; for (i = 0; i < n; i++) { @@ -671,7 +672,12 @@ static cl_object str_out_set_position(cl_object strm, cl_object pos) { cl_object string = STRING_OUTPUT_STRING(strm); - cl_fixnum disp = fixnnint(pos); + cl_fixnum disp; + if (Null(pos)) { + disp = strm->base_string.dim; + } else { + disp = fixnnint(pos); + } if (disp < string->base_string.fillp) { string->base_string.fillp = disp; } else { @@ -846,9 +852,14 @@ str_in_get_position(cl_object strm) static cl_object str_in_set_position(cl_object strm, cl_object pos) { - cl_fixnum disp = fixnnint(pos); - if (disp >= STRING_INPUT_LIMIT(strm)) { + cl_fixnum disp; + if (Null(pos)) { disp = STRING_INPUT_LIMIT(strm); + } else { + disp = fixnnint(pos); + if (disp >= STRING_INPUT_LIMIT(strm)) { + disp = STRING_INPUT_LIMIT(strm); + } } STRING_INPUT_POSITION(strm) = disp; return Ct; @@ -941,7 +952,7 @@ for the string ~S.", */ static cl_index -two_way_read_byte8(cl_object strm, char *c, cl_index n) +two_way_read_byte8(cl_object strm, unsigned char *c, cl_index n) { if (strm == cl_core.terminal_io) ecl_force_output(TWO_WAY_STREAM_OUTPUT(cl_core.terminal_io)); @@ -949,7 +960,7 @@ two_way_read_byte8(cl_object strm, char *c, cl_index n) } static cl_index -two_way_write_byte8(cl_object strm, char *c, cl_index n) +two_way_write_byte8(cl_object strm, unsigned char *c, cl_index n) { return ecl_write_byte8(TWO_WAY_STREAM_OUTPUT(strm), c, n); } @@ -1119,7 +1130,7 @@ cl_two_way_stream_output_stream(cl_object strm) #define broadcast_read_byte8 not_input_read_byte8 static cl_index -broadcast_write_byte8(cl_object strm, char *c, cl_index n) +broadcast_write_byte8(cl_object strm, unsigned char *c, cl_index n) { cl_object l; cl_index out = n; @@ -1286,14 +1297,14 @@ cl_broadcast_stream_streams(cl_object strm) */ static cl_index -echo_read_byte8(cl_object strm, char *c, cl_index n) +echo_read_byte8(cl_object strm, unsigned char *c, cl_index n) { cl_index out = ecl_read_byte8(ECHO_STREAM_INPUT(strm), c, n); return ecl_write_byte8(ECHO_STREAM_OUTPUT(strm), c, out); } static cl_index -echo_write_byte8(cl_object strm, char *c, cl_index n) +echo_write_byte8(cl_object strm, unsigned char *c, cl_index n) { return ecl_write_byte8(ECHO_STREAM_OUTPUT(strm), c, n); } @@ -1448,7 +1459,7 @@ cl_echo_stream_output_stream(cl_object strm) */ static cl_index -concatenated_read_byte8(cl_object strm, char *c, cl_index n) +concatenated_read_byte8(cl_object strm, unsigned char *c, cl_index n) { cl_object l = CONCATENATED_STREAM_LIST(strm); cl_index out = 0; @@ -1583,13 +1594,13 @@ cl_concatenated_stream_streams(cl_object strm) */ static cl_index -synonym_read_byte8(cl_object strm, char *c, cl_index n) +synonym_read_byte8(cl_object strm, unsigned char *c, cl_index n) { return ecl_read_byte8(SYNONYM_STREAM_STREAM(strm), c, n); } static cl_index -synonym_write_byte8(cl_object strm, char *c, cl_index n) +synonym_write_byte8(cl_object strm, unsigned char *c, cl_index n) { return ecl_write_byte8(SYNONYM_STREAM_STREAM(strm), c, n); } @@ -1764,11 +1775,397 @@ cl_synonym_stream_symbol(cl_object strm) } /********************************************************************** - * TWO WAY STREAM + * POSIX FILE STREAM */ static cl_index -io_stream_read_byte8(cl_object strm, char *c, cl_index n) +io_file_read_byte8(cl_object strm, unsigned char *c, cl_index n) +{ + int f = IO_FILE_DESCRIPTOR(strm); + cl_fixnum out; + ecl_disable_interrupts(); + do { + out = read(f, c, sizeof(char)*n); + } while (out < 0 && restartable_io_error(strm)); + ecl_enable_interrupts(); + return out; +} + +static cl_index +io_file_write_byte8(cl_object strm, unsigned char *c, cl_index n) +{ + int f = IO_FILE_DESCRIPTOR(strm); + cl_index out; + ecl_disable_interrupts(); + do { + out = write(f, c, sizeof(char)*n); + } while (out < 0 && restartable_io_error(strm)); + ecl_enable_interrupts(); + return out; +} + +#define io_file_read_char generic_read_char + +static int +io_file_write_char(cl_object strm, int c) +{ + char aux = c; + strm->stream.unread = EOF; + if (c == '\n') + IO_FILE_COLUMN(strm) = 0; + else if (c == '\t') + IO_FILE_COLUMN(strm) = (IO_FILE_COLUMN(strm)&~07) + 8; + else + IO_FILE_COLUMN(strm)++; + io_file_write_byte8(strm, &aux, 1); + return c; +} + +#define io_file_unread_char generic_unread_char +#define io_file_peek_char generic_peek_char + +static int +io_file_listen(cl_object strm) +{ + int f = IO_FILE_DESCRIPTOR(strm); + return file_listen(f); +} + +static void +io_file_clear_input(cl_object strm) +{ + int f = IO_FILE_DESCRIPTOR(strm); +#if defined(mingw32) || defined(_MSC_VER) + if (isatty(f)) { + /* Flushes Win32 console */ + if (!FlushConsoleInputBuffer((HANDLE)_get_osfhandle(fileno(fp)))) + FEwin32_error("FlushConsoleInputBuffer() failed", 0); + /* Do not stop here: the FILE structure needs also to be flushed */ + } +#endif + while (file_listen(f) == ECL_LISTEN_AVAILABLE) { + io_file_read_char(strm); + } +} + +#define io_file_clear_output generic_void +#define io_file_force_output generic_void +#define io_file_finish_output io_file_force_output +#define io_file_input_p generic_always_true +#define io_file_output_p generic_always_true + +static int +io_file_interactive_p(cl_object strm) +{ + int f = IO_FILE_DESCRIPTOR(strm); + return isatty(f); +} + +static cl_object +io_file_element_type(cl_object strm) +{ + return IO_FILE_ELT_TYPE(strm); +} + +static cl_object +io_file_length(cl_object strm) +{ + int f = IO_FILE_DESCRIPTOR(strm); + cl_object output = ecl_file_len(f); + if (strm->stream.byte_size != 8) { + cl_index bs = strm->stream.byte_size; + output = ecl_floor2(output, MAKE_FIXNUM(bs/8)); + if (VALUES(1) != MAKE_FIXNUM(0)) { + FEerror("File length is not on byte boundary", 0); + } + } + return output; +} + +static cl_object +io_file_get_position(cl_object strm) +{ + int f = IO_FILE_DESCRIPTOR(strm); + cl_object output; + ecl_off_t offset; + + ecl_disable_interrupts(); + offset = lseek(f, 0, SEEK_CUR); + ecl_enable_interrupts(); + if (offset < 0) + io_error(strm); + if (sizeof(ecl_off_t) == sizeof(long)) { + output = ecl_make_integer(offset); + } else { + output = ecl_off_t_to_integer(offset); + } + if (strm->stream.byte_size != 8) { + output = ecl_floor2(output, MAKE_FIXNUM(strm->stream.byte_size / 8)); + } + return output; +} + +static cl_object +io_file_set_position(cl_object strm, cl_object large_disp) +{ + int f = IO_FILE_DESCRIPTOR(strm); + cl_object output; + if (Null(large_disp)) { + ecl_disable_interrupts(); + if (lseek(f, 0, SEEK_END) == (ecl_off_t)-1) + output = Cnil; + else + output = Ct; + ecl_enable_interrupts(); + } else { + ecl_off_t disp; + if (strm->stream.byte_size != 8) { + large_disp = ecl_times(large_disp, + MAKE_FIXNUM(strm->stream.byte_size / 8)); + } + disp = ecl_integer_to_off_t(large_disp); + ecl_disable_interrupts(); + if (lseek(f, disp, SEEK_SET) == (ecl_off_t)-1) + output = Cnil; + else + output = Ct; + ecl_enable_interrupts(); + } + return output; +} + +static int +io_file_column(cl_object strm) +{ + return IO_FILE_COLUMN(strm); +} + +static cl_object +io_file_close(cl_object strm) +{ + int f = IO_FILE_DESCRIPTOR(strm); + int failed; + if (f == STDOUT_FILENO) + FEerror("Cannot close the standard output", 0); + if (f == STDIN_FILENO) + FEerror("Cannot close the standard input", 0); + ecl_disable_interrupts(); + failed = close(f); + ecl_enable_interrupts(); + if (failed < 0) + FElibc_error("Cannot close stream ~S.", 1, strm); + strm->stream.file = (void*)-1; + return generic_close(strm); +} + +static cl_index +io_file_read_vector(cl_object strm, cl_object data, cl_index start, cl_index end) +{ + cl_elttype t = data->vector.elttype; + if (start >= end) + return start; + if (t == aet_b8 || t == aet_i8 || t == aet_bc) { + if (strm->stream.byte_size == 8) { + void *aux = data->vector.self.ch + start; + return strm->stream.ops->read_byte8(strm, aux, end-start); + } + } + if (t == aet_fix || t == aet_index) { + if (strm->stream.byte_size == sizeof(cl_fixnum)*8) { + void *aux = data->vector.self.fix + start; + cl_index bytes = (end - start) * sizeof(cl_fixnum); + bytes = strm->stream.ops->read_byte8(strm, aux, bytes); + return start + bytes / sizeof(cl_fixnum); + } + } + return generic_read_vector(strm, data, start, end); +} + +static cl_index +io_file_write_vector(cl_object strm, cl_object data, cl_index start, cl_index end) +{ + cl_elttype t = data->vector.elttype; + if (start >= end) + return start; + if (t == aet_b8 || t == aet_i8 || t == aet_bc) { + if (strm->stream.byte_size == 8) { + void *aux = data->vector.self.fix + start; + return strm->stream.ops->write_byte8(strm, aux, end-start); + } + } + if (t == aet_fix || t == aet_index) { + if (strm->stream.byte_size == sizeof(cl_fixnum)*8) { + void *aux = data->vector.self.fix + start; + cl_index bytes = (end - start) * sizeof(cl_fixnum); + bytes = strm->stream.ops->write_byte8(strm, aux, bytes); + return start + bytes / sizeof(cl_fixnum); + } + } + return generic_write_vector(strm, data, start, end); +} + +const struct ecl_file_ops io_file_ops = { + io_file_write_byte8, + io_file_read_byte8, + + io_file_read_char, + io_file_write_char, + io_file_unread_char, + io_file_peek_char, + + io_file_read_vector, + io_file_write_vector, + + io_file_listen, + io_file_clear_input, + io_file_clear_output, + io_file_finish_output, + io_file_force_output, + + io_file_input_p, + io_file_output_p, + io_file_interactive_p, + io_file_element_type, + + io_file_length, + io_file_get_position, + io_file_set_position, + io_file_column, + io_file_close +}; + +const struct ecl_file_ops output_file_ops = { + io_file_write_byte8, + not_input_read_byte8, + + not_input_read_char, + io_file_write_char, + not_input_unread_char, + not_input_read_char, + + generic_read_vector, + io_file_write_vector, + + not_input_listen, + generic_void, + io_file_clear_output, + io_file_finish_output, + io_file_force_output, + + generic_always_false, + io_file_output_p, + generic_always_false, + io_file_element_type, + + io_file_length, + io_file_get_position, + io_file_set_position, + io_file_column, + io_file_close +}; + +const struct ecl_file_ops input_file_ops = { + not_output_write_byte8, + io_file_read_byte8, + + io_file_read_char, + not_output_write_char, + io_file_unread_char, + io_file_peek_char, + + io_file_read_vector, + generic_write_vector, + + io_file_listen, + io_file_clear_input, + generic_void, + generic_void, + generic_void, + + io_file_input_p, + generic_always_false, + io_file_interactive_p, + io_file_element_type, + + io_file_length, + io_file_get_position, + io_file_set_position, + generic_column, + io_file_close +}; + +static void +set_stream_elt_type(cl_object stream, cl_fixnum byte_size, int char_stream_p) +{ + if (char_stream_p) { + if (byte_size != 8) { + FEerror("Cannot create a character stream when byte size is not 8.", 0); + } + stream->stream.signed_bytes = 0; + IO_STREAM_ELT_TYPE(stream) = @'base-char'; + byte_size = 8; + } else { + cl_object t; + if (byte_size > 0) { + stream->stream.signed_bytes = 0; + t = @'unsigned-byte'; + } else { + byte_size = -byte_size; + stream->stream.signed_bytes = 1; + t = @'signed-byte'; + } + IO_STREAM_ELT_TYPE(stream) = cl_list(2, t, MAKE_FIXNUM(byte_size)); + } + stream->stream.char_stream_p = char_stream_p; + stream->stream.byte_size = (byte_size+7)&(~(cl_fixnum)7); +} + +cl_object +ecl_make_file_stream_from_fd(cl_object fname, int fd, enum ecl_smmode smm, + cl_fixnum byte_size, int char_stream_p) +{ + cl_object stream = alloc_stream(); + stream->stream.mode = (short)smm; + stream->stream.closed = 0; +#if defined (ECL_WSOCK) + if (smm == smm_input_wsock || smm == smm_io_wsock) + character_p = 1; +#endif + switch(smm) { + case smm_probe: + case smm_input: + smm = smm_input_file; + case smm_input_file: + stream->stream.ops = duplicate_dispatch_table(&input_file_ops); + break; + case smm_output: + smm = smm_output_file; + case smm_output_file: + stream->stream.ops = duplicate_dispatch_table(&output_file_ops); + break; + case smm_io: + smm = smm_io_file; + case smm_io_file: + stream->stream.ops = duplicate_dispatch_table(&io_file_ops); + break; + default: + FEerror("make_stream: wrong mode", 0); + } + set_stream_elt_type(stream, byte_size, char_stream_p); + IO_FILE_FILENAME(stream) = fname; /* not really used */ + IO_FILE_COLUMN(stream) = 0; + stream->stream.file = (void*)fd; + stream->stream.last_op = 0; + si_set_finalizer(stream, Ct); + return stream; +} + +/********************************************************************** + * C STREAMS + */ + +static cl_index +io_stream_read_byte8(cl_object strm, unsigned char *c, cl_index n) { FILE *f = IO_STREAM_FILE(strm); cl_index out; @@ -1783,7 +2180,7 @@ io_stream_read_byte8(cl_object strm, char *c, cl_index n) } static cl_index -io_stream_write_byte8(cl_object strm, char *c, cl_index n) +io_stream_write_byte8(cl_object strm, unsigned char *c, cl_index n) { FILE *f = IO_STREAM_FILE(strm); cl_index out; @@ -1822,29 +2219,21 @@ io_stream_write_char(cl_object strm, int c) char aux = c; int outcome; strm->stream.unread = EOF; + ecl_disable_interrupts(); + do { + outcome = putc(c, f); + } while (outcome == EOF && restartable_io_error(strm)); + ecl_enable_interrupts(); if (c == '\n') IO_STREAM_COLUMN(strm) = 0; else if (c == '\t') IO_STREAM_COLUMN(strm) = (IO_STREAM_COLUMN(strm)&~07) + 8; else IO_STREAM_COLUMN(strm)++; - ecl_disable_interrupts(); - do { - outcome = putc(c, f); - } while (outcome == EOF && restartable_io_error(strm)); - ecl_enable_interrupts(); return c; } -static void -io_stream_unread_char(cl_object strm, int c) -{ - if (strm->stream.unread != EOF) { - unread_twice(strm); - } - strm->stream.unread = c; -} - +#define io_stream_unread_char generic_unread_char #define io_stream_peek_char generic_peek_char static int @@ -1896,27 +2285,13 @@ io_stream_interactive_p(cl_object strm) return isatty(fileno(f)); } -static cl_object -io_stream_element_type(cl_object strm) -{ - cl_object output; - if (strm->stream.char_stream_p) { - output = @'base-char'; - } else { - cl_fixnum bs = strm->stream.byte_size; - output = strm->stream.signed_bytes? - @'signed-byte' : @'unsigned-byte'; - if (bs != 8) - output = cl_list(2, output, MAKE_FIXNUM(bs)); - } - return output; -} +#define io_stream_element_type io_file_element_type static cl_object io_stream_length(cl_object strm) { FILE *f = IO_STREAM_FILE(strm); - cl_object output = ecl_file_len(f); + cl_object output = ecl_file_len(fileno(f)); if (strm->stream.byte_size != 8) { cl_index bs = strm->stream.byte_size; output = ecl_floor2(output, MAKE_FIXNUM(bs/8)); @@ -1954,19 +2329,28 @@ static cl_object io_stream_set_position(cl_object strm, cl_object large_disp) { FILE *f = IO_STREAM_FILE(strm); - ecl_off_t disp; cl_object output; - if (strm->stream.byte_size != 8) { - large_disp = ecl_times(large_disp, - MAKE_FIXNUM(strm->stream.byte_size / 8)); + if (Null(large_disp)) { + ecl_disable_interrupts(); + if (ecl_fseeko(f, -1, SEEK_END) != 0) + output = Cnil; + else + output = Ct; + ecl_enable_interrupts(); + } else { + ecl_off_t disp; + if (strm->stream.byte_size != 8) { + large_disp = ecl_times(large_disp, + MAKE_FIXNUM(strm->stream.byte_size / 8)); + } + disp = ecl_integer_to_off_t(large_disp); + ecl_disable_interrupts(); + if (ecl_fseeko(f, disp, SEEK_SET) != 0) + output = Cnil; + else + output = Ct; + ecl_enable_interrupts(); } - disp = ecl_integer_to_off_t(large_disp); - ecl_disable_interrupts(); - if (ecl_fseeko(f, disp, 0) != 0) - output = Cnil; - else - output = Ct; - ecl_enable_interrupts(); return output; } @@ -2006,51 +2390,8 @@ io_stream_close(cl_object strm) * Specialized sequence operations */ -static cl_index -io_stream_read_vector(cl_object strm, cl_object data, cl_index start, cl_index end) -{ - cl_elttype t = data->vector.elttype; - if (start >= end) - return start; - if (t == aet_b8 || t == aet_i8 || t == aet_bc) { - if (strm->stream.byte_size == 8) { - void *aux = data->vector.self.ch + start; - return io_stream_read_byte8(strm, aux, end-start); - } - } - if (t == aet_fix || t == aet_index) { - if (strm->stream.byte_size == sizeof(cl_fixnum)*8) { - void *aux = data->vector.self.fix + start; - cl_index bytes = (end - start) * sizeof(cl_fixnum); - bytes = io_stream_read_byte8(strm, aux, bytes); - return start + bytes / sizeof(cl_fixnum); - } - } - return generic_read_vector(strm, data, start, end); -} - -static cl_index -io_stream_write_vector(cl_object strm, cl_object data, cl_index start, cl_index end) -{ - cl_elttype t = data->vector.elttype; - if (start >= end) - return start; - if (t == aet_b8 || t == aet_i8 || t == aet_bc) { - if (strm->stream.byte_size == 8) { - void *aux = data->vector.self.fix + start; - return io_stream_write_byte8(strm, aux, end-start); - } - } - if (t == aet_fix || t == aet_index) { - if (strm->stream.byte_size == sizeof(cl_fixnum)*8) { - void *aux = data->vector.self.fix + start; - cl_index bytes = (end - start) * sizeof(cl_fixnum); - bytes = io_stream_write_byte8(strm, aux, bytes); - return start + bytes / sizeof(cl_fixnum); - } - } - return generic_write_vector(strm, data, start, end); -} +#define io_stream_read_vector io_file_read_vector +#define io_stream_write_vector io_file_write_vector const struct ecl_file_ops io_stream_ops = { io_stream_write_byte8, @@ -2162,11 +2503,11 @@ si_set_buffering_mode(cl_object stream, cl_object buffer_mode_symbol) } if (mode == smm_output || mode == smm_io || mode == smm_input) { FILE *fp = (FILE*)stream->stream.file; - char *new_buffer = 0; + unsigned char *new_buffer = 0; setvbuf(fp, 0, _IONBF, 0); if (buffer_mode != _IONBF) { cl_index buffer_size = BUFSIZ; - char *new_buffer = ecl_alloc_atomic(buffer_size); + unsigned char *new_buffer = ecl_alloc_atomic(buffer_size); stream->stream.buffer = new_buffer; setvbuf(fp, new_buffer, buffer_mode, buffer_size); } @@ -2200,22 +2541,7 @@ ecl_make_stream_from_FILE(cl_object fname, void *f, enum ecl_smmode smm, default: FEerror("Not a valid mode ~D for ecl_make_stream_from_FILE", 1, MAKE_FIXNUM(smm)); } - if (char_stream_p) { - if (byte_size != 8) { - FEerror("Cannot create a character stream when byte size is not 8.", 0); - } - IO_STREAM_ELT_TYPE(stream) = @'base-char'; - } else { - IO_STREAM_ELT_TYPE(stream) = Cnil; - } - stream->stream.char_stream_p = char_stream_p; - if (byte_size > 0) { - stream->stream.signed_bytes = 0; - } else { - byte_size = -byte_size; - stream->stream.signed_bytes = 1; - } - stream->stream.byte_size = (byte_size+7)&(~(cl_fixnum)7); + set_stream_elt_type(stream, byte_size, char_stream_p); IO_STREAM_FILENAME(stream) = fname; /* not really used */ IO_STREAM_COLUMN(stream) = 0; stream->stream.file = f; @@ -2262,25 +2588,30 @@ ecl_make_stream_from_fd(cl_object fname, int fd, enum ecl_smmode smm, return ecl_make_stream_from_FILE(fname, fp, smm, byte_size, char_stream_p); } + int ecl_stream_to_handle(cl_object s, bool output) { - FILE *f; BEGIN: if (type_of(s) != t_stream) return -1; switch ((enum ecl_smmode)s->stream.mode) { case smm_input: if (output) return -1; - f = (FILE*)s->stream.file; - break; + return fileno((FILE*)s->stream.file); + case smm_input_file: + if (output) return -1; + return (int)s->stream.file; case smm_output: if (!output) return -1; - f = (FILE*)s->stream.file; - break; + return fileno((FILE*)s->stream.file); + case smm_output_file: + if (!output) return -1; + return (int)s->stream.file; case smm_io: - f = (FILE*)s->stream.file; - break; + return fileno((FILE*)s->stream.file); + case smm_io_file: + return (int)s->stream.file; case smm_synonym: s = SYNONYM_STREAM_STREAM(s); goto BEGIN; @@ -2290,7 +2621,6 @@ ecl_stream_to_handle(cl_object s, bool output) default: ecl_internal_error("illegal stream mode"); } - return fileno(f); } /********************************************************************** @@ -2319,13 +2649,13 @@ stream_dispatch_table(cl_object strm) } static cl_index -ecl_read_byte8(cl_object strm, char *c, cl_index n) +ecl_read_byte8(cl_object strm, unsigned char *c, cl_index n) { return stream_dispatch_table(strm)->read_byte8(strm, c, n); } static cl_index -ecl_write_byte8(cl_object strm, char *c, cl_index n) +ecl_write_byte8(cl_object strm, unsigned char *c, cl_index n) { return stream_dispatch_table(strm)->write_byte8(strm, c, n); } @@ -2348,7 +2678,7 @@ ecl_read_char_noeof(cl_object strm) cl_object ecl_read_byte(cl_object strm) { - cl_index (*read_byte8)(cl_object, char *, cl_index); + cl_index (*read_byte8)(cl_object, unsigned char *, cl_index); cl_index bs; #ifdef ECL_CLOS_STREAMS if (ECL_INSTANCEP(strm)) { @@ -2386,7 +2716,7 @@ ecl_read_byte(cl_object strm) void ecl_write_byte(cl_object c, cl_object strm) { - cl_index (*write_byte8)(cl_object strm, char *c, cl_index n); + cl_index (*write_byte8)(cl_object strm, unsigned char *c, cl_index n); cl_index bs; /* * The first part is only for composite or complex streams. @@ -2673,11 +3003,7 @@ cl_file_length(cl_object strm) if (position == @':start') { position = MAKE_FIXNUM(0); } else if (position == @':end') { - position = cl_file_length(file_stream); - if (position == Cnil) { - output = Cnil; - goto OUTPUT; - } + position = Cnil; } output = ecl_file_position_set(file_stream, position); } @@ -2799,11 +3125,12 @@ normalize_stream_element_type(cl_object element_type) cl_object ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, cl_object if_does_not_exist, cl_fixnum byte_size, - bool char_stream_p) + int char_stream_p, int cstream) { cl_env_ptr the_env = &cl_env; cl_object x; - FILE *fp; + int f; + mode_t mode = S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH; cl_object filename = si_coerce_to_filename(fn); char *fname = filename->base_string.self; bool appending = FALSE; @@ -2813,17 +3140,17 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, } ecl_disable_interrupts_env(the_env); if (smm == smm_input || smm == smm_probe) { - fp = fopen(fname, OPEN_R); - if (fp == NULL) { + f = open(fname, O_RDONLY, mode); + if (f < 0) { if (if_does_not_exist == @':error') { goto CANNOT_OPEN; } else if (if_does_not_exist == @':create') { - fp = fopen(fname, OPEN_W); - if (fp == NULL) + f = open(fname, O_WRONLY|O_CREAT, mode); + if (f < 0) goto CANNOT_OPEN; - fclose(fp); - fp = fopen(fname, OPEN_R); - if (fp == NULL) + close(f); + f = open(fname, O_RDONLY, mode); + if (f < 0) goto CANNOT_OPEN; } else if (Null(if_does_not_exist)) { x = Cnil; @@ -2837,42 +3164,36 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, } else if (smm == smm_output || smm == smm_io) { if (if_exists == @':new_version' && if_does_not_exist == @':create') goto CREATE; - fp = fopen(fname, OPEN_R); - if (fp != NULL) { - fclose(fp); + f = open(fname, O_RDONLY, mode); + if (f >= 0) { + close(f); if (if_exists == @':error') { goto CANNOT_OPEN; } else if (if_exists == @':rename') { - fp = ecl_backup_fopen(fname, (smm == smm_output) - ? OPEN_W - : OPEN_RW); - if (fp == NULL) { + f = ecl_backup_open(fname, (smm == smm_output) + ? O_WRONLY|O_CREAT + : O_RDWR|O_CREAT, + mode); + if (f < 0) goto CANNOT_OPEN; - } } else if (if_exists == @':rename_and_delete' || if_exists == @':new_version' || if_exists == @':supersede') { - fp = fopen(fname, (smm == smm_output) - ? OPEN_W - : OPEN_RW); - if (fp == NULL) { + f = open(fname, (smm == smm_output) + ? O_WRONLY|O_TRUNC : O_RDWR|O_TRUNC, + mode); + if (f < 0) goto CANNOT_OPEN; - } } else if (if_exists == @':overwrite' || if_exists == @':append') { /* We cannot use "w+b" because it truncates. We cannot use "a+b" because writes jump to the end. */ - int f = open(filename->base_string.self, (smm == smm_output)? - (O_WRONLY|O_CREAT) : (O_RDWR|O_CREAT)); - if (f < 0) { + f = open(filename->base_string.self, (smm == smm_output)? + (O_WRONLY|O_CREAT) : (O_RDWR|O_CREAT), + mode); + if (f < 0) goto CANNOT_OPEN; - } - fp = fdopen(f, (smm == smm_output)? OPEN_W : OPEN_RW); - if (fp == NULL) { - close(f); - goto CANNOT_OPEN; - } if (if_exists == @':append') { - ecl_fseeko(fp, 0, SEEK_END); + lseek(f, 0, SEEK_END); appending = TRUE; } } else if (Null(if_exists)) { @@ -2888,12 +3209,11 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, goto CANNOT_OPEN; } else if (if_does_not_exist == @':create') { CREATE: - fp = fopen(fname, (smm == smm_output) - ? OPEN_W - : OPEN_RW); - if (fp == NULL) { + f = open(fname, (smm == smm_output)? + O_WRONLY|O_CREAT : O_RDWR|O_CREAT, + mode); + if (f < 0) goto CANNOT_OPEN; - } } else if (Null(if_does_not_exist)) { x = Cnil; goto OUTPUT; @@ -2906,19 +3226,32 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, } else { goto INVALID_MODE; } - x = ecl_make_stream_from_FILE(fn, fp, smm, byte_size, char_stream_p); - si_set_buffering_mode(x, char_stream_p? @':line-buffered' : @':fully-buffered'); + ecl_enable_interrupts_env(the_env); + if (cstream) { + FILE *fp; + switch (smm) { + case smm_input: fp = fdopen(f, OPEN_R); break; + case smm_output: fp = fdopen(f, OPEN_W); break; + case smm_io: fp = fdopen(f, OPEN_RW); break; + } + x = ecl_make_stream_from_FILE(fn, fp, smm, byte_size, char_stream_p); + si_set_buffering_mode(x, char_stream_p? @':line-buffered' : @':fully-buffered'); + } else { + x = ecl_make_file_stream_from_fd(fn, f, smm, byte_size, char_stream_p); + } if (smm == smm_probe) { cl_close(1, x); } else { si_set_finalizer(x, Ct); if (!char_stream_p) { /* Set file pointer to the correct position */ + ecl_disable_interrupts_env(the_env); if (appending) { - ecl_fseeko(fp, -1, SEEK_END); + lseek(f, -1, SEEK_END); } else { - ecl_fseeko(fp, 0, SEEK_SET); + lseek(f, 0, SEEK_SET); } + ecl_enable_interrupts_env(the_env); } } OUTPUT: @@ -2938,14 +3271,13 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, return Cnil; } - @(defun open (filename &key (direction @':input') (element_type @'base-char') (if_exists Cnil iesp) (if_does_not_exist Cnil idnesp) (external_format @':default') - (use_header_p Cnil) + (cstream Cnil) &aux strm) enum ecl_smmode smm; bool char_stream_p; @@ -3006,7 +3338,7 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, byte_size = normalize_stream_element_type(element_type); } strm = ecl_open_stream(filename, smm, if_exists, if_does_not_exist, - byte_size, char_stream_p); + byte_size, char_stream_p, !Null(cstream)); @(return strm) @) @@ -3021,39 +3353,31 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, */ static int -flisten(FILE *fp) +file_listen(int fileno) { -#ifdef HAVE_SELECT +#if !defined(mingw32) && !defined(_MSC_VER) +# if defined(HAVE_SELECT) fd_set fds; int retv, fd; struct timeval tv = { 0, 0 }; -#endif -#if defined(mingw32) || defined(_MSC_VER) - HANDLE hnd; -#endif - if (feof(fp)) - return ECL_LISTEN_EOF; -#ifdef FILE_CNT - if (FILE_CNT(fp) > 0) - return ECL_LISTEN_AVAILABLE; -#endif -#if !defined(mingw32) && !defined(_MSC_VER) -#if defined(HAVE_SELECT) - fd = fileno(fp); FD_ZERO(&fds); - FD_SET(fd, &fds); - retv = select(fd + 1, &fds, NULL, NULL, &tv); + FD_SET(fileno, &fds); + retv = select(fileno + 1, &fds, NULL, NULL, &tv); if (retv < 0) FElibc_error("select() returned an error value", 0); - return (retv > 0)? ECL_LISTEN_AVAILABLE : ECL_LISTEN_NO_CHAR; -#elif defined(FIONREAD) - { long c = 0; - ioctl(fileno(fp), FIONREAD, &c); - return (c > 0)? ECL_LISTEN_AVAILABLE : ECL_LISTEN_NO_CHAR; + else if (retv > 0) + return ECL_LISTEN_AVAILABLE; + else + return ECL_LISTEN_NO_CHAR; +# elif defined(FIONREAD) + { + long c = 0; + ioctl(fileno, FIONREAD, &c); + return (c > 0)? ECL_LISTEN_AVAILABLE : ECL_LISTEN_NO_CHAR; } -#endif /* FIONREAD */ +# endif /* FIONREAD */ #else - hnd = (HANDLE)_get_osfhandle(fileno(fp)); + HANDLE hnd = (HANDLE)_get_osfhandle(fileno); switch (GetFileType(hnd)) { case FILE_TYPE_CHAR: { DWORD dw, dw_read, cm; @@ -3104,6 +3428,22 @@ flisten(FILE *fp) break; } #endif + return -3; +} + +static int +flisten(FILE *fp) +{ + int aux; + if (feof(fp)) + return ECL_LISTEN_EOF; +#ifdef FILE_CNT + if (FILE_CNT(fp) > 0) + return ECL_LISTEN_AVAILABLE; +#endif + aux = file_listen(fileno(fp)); + if (aux != -3) + return aux; /* This code is portable, and implements the expected behavior for regular files. It will fail on noninteractive streams. */ { @@ -3290,14 +3630,24 @@ unread_twice(cl_object s) CEerror(Ct, "Used UNREAD-CHAR twice on stream ~D", 1, s); } +static void +maybe_clearerr(cl_object strm) +{ + cl_type t = type_of(strm); + if (t == smm_io || t == smm_output || t == smm_input) { + FILE *f = IO_STREAM_FILE(strm); + if (f != NULL) clearerr(f); + } +} + static int restartable_io_error(cl_object strm) { - cl_env_ptr the_env = &cl_env; + cl_env_ptr the_env = ecl_process_env(); volatile int old_errno = errno; /* ecl_disable_interrupts(); ** done by caller */ - clearerr((FILE*)strm->stream.file); - ecl_enable_interrupts(); + maybe_clearerr(strm); + ecl_enable_interrupts_env(the_env); if (errno == EINTR) { return 1; } else { @@ -3310,11 +3660,10 @@ restartable_io_error(cl_object strm) static void io_error(cl_object strm) { - cl_env_ptr the_env = &cl_env; - FILE *f = IO_STREAM_FILE(strm); + cl_env_ptr the_env = ecl_process_env(); /* ecl_disable_interrupts(); ** done by caller */ - clearerr(f); - ecl_enable_interrupts(); + maybe_clearerr(strm); + ecl_enable_interrupts_env(the_env); FElibc_error("Read or write operation to stream ~S signaled an error.", 1, strm); } @@ -3360,18 +3709,27 @@ init_file(void) null_stream = cl_make_two_way_stream(null_stream, cl_make_broadcast_stream(0)); cl_core.null_stream = null_stream; +#if 0 standard_input = ecl_make_stream_from_FILE(make_constant_base_string("stdin"), stdin, smm_input, 8, 1); - standard_output = ecl_make_stream_from_FILE(make_constant_base_string("stdout"), stdout, smm_output, 8, 1); - error_output = ecl_make_stream_from_FILE(make_constant_base_string("stderr"), stderr, smm_output, 8, 1); - +#else + standard_input = ecl_make_file_stream_from_fd(make_constant_base_string("stdin"), + STDIN_FILENO, smm_input, 8, 1); + standard_output = ecl_make_file_stream_from_fd(make_constant_base_string("stdout"), + STDOUT_FILENO, smm_output, 8, 1); + error_output = ecl_make_file_stream_from_fd(make_constant_base_string("stderr"), + STDERR_FILENO, smm_output, 8, 1); +#endif + cl_core.standard_input = standard_input; ECL_SET(@'*standard-input*', standard_input); + cl_core.standard_output = standard_output; ECL_SET(@'*standard-output*', standard_output); ECL_SET(@'*trace-output*', standard_output); + cl_core.error_output = error_output; ECL_SET(@'*error-output*', error_output); cl_core.terminal_io = aux diff --git a/src/c/load.d b/src/c/load.d index 8d7dd05ca..ffc14aa9f 100644 --- a/src/c/load.d +++ b/src/c/load.d @@ -423,7 +423,7 @@ si_load_source(cl_object source, cl_object verbose, cl_object print) /* INV: if "source" is not a valid stream, file.d will complain */ strm = source; } else { - strm = ecl_open_stream(source, smm_input, Cnil, Cnil, 8, 1); + strm = ecl_open_stream(source, smm_input, Cnil, Cnil, 8, 1, 0); if (Null(strm)) @(return Cnil) } diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index b139d9442..2a7594cbf 100644 --- a/src/c/symbols_list.h +++ b/src/c/symbols_list.h @@ -1369,7 +1369,7 @@ cl_symbols[] = { {KEY_ "UP", KEYWORD, NULL, -1, OBJNULL}, {KEY_ "UPCASE", KEYWORD, NULL, -1, OBJNULL}, {KEY_ "USE", KEYWORD, NULL, -1, OBJNULL}, -{KEY_ "USE-HEADER-P", KEYWORD, NULL, -1, OBJNULL}, +{KEY_ "CSTREAM", KEYWORD, NULL, -1, OBJNULL}, {KEY_ "VERBOSE", KEYWORD, NULL, -1, OBJNULL}, {KEY_ "VERSION", KEYWORD, NULL, -1, OBJNULL}, {KEY_ "WILD", KEYWORD, NULL, -1, OBJNULL}, diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h index adf2dad68..263ecfb9e 100644 --- a/src/c/symbols_list2.h +++ b/src/c/symbols_list2.h @@ -1369,7 +1369,7 @@ cl_symbols[] = { {KEY_ "UP",NULL}, {KEY_ "UPCASE",NULL}, {KEY_ "USE",NULL}, -{KEY_ "USE-HEADER-P",NULL}, +{KEY_ "CSTREAM",NULL}, {KEY_ "VERBOSE",NULL}, {KEY_ "VERSION",NULL}, {KEY_ "WILD",NULL}, diff --git a/src/c/unixfsys.d b/src/c/unixfsys.d index 04be7425e..e621711f1 100644 --- a/src/c/unixfsys.d +++ b/src/c/unixfsys.d @@ -303,8 +303,8 @@ ERROR: FElibc_error("Can't change the current directory to ~S", @(return pathname) } -void * -ecl_backup_fopen(const char *filename, const char *option) +int +ecl_backup_open(const char *filename, int option, int mode) { char *backupfilename = ecl_alloc(strlen(filename) + 5); if (backupfilename == NULL) { @@ -327,15 +327,15 @@ ecl_backup_fopen(const char *filename, const char *option) } ecl_enable_interrupts(); ecl_dealloc(backupfilename); - return fopen(filename, option); + return open(filename, option, mode); } cl_object -ecl_file_len(void *fp) +ecl_file_len(int f) { struct stat filestatus; ecl_disable_interrupts(); - fstat(fileno((FILE*)fp), &filestatus); + fstat(f, &filestatus); ecl_enable_interrupts(); return ecl_make_integer(filestatus.st_size); } diff --git a/src/h/external.h b/src/h/external.h index 8ceebb694..76cac4091 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -161,6 +161,9 @@ struct cl_core_struct { cl_object terminal_io; cl_object null_stream; + cl_object standard_input; + cl_object standard_output; + cl_object error_output; cl_object standard_readtable; cl_object dispatch_reader; cl_object default_dispatch_macro; @@ -597,7 +600,7 @@ extern ECL_API bool ecl_input_stream_p(cl_object strm); extern ECL_API bool ecl_output_stream_p(cl_object strm); extern ECL_API cl_object ecl_stream_element_type(cl_object strm); extern ECL_API bool ecl_interactive_stream_p(cl_object strm); -extern ECL_API cl_object ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, cl_object if_does_not_exist, cl_fixnum byte_size, bool char_stream_p); +extern ECL_API cl_object ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, cl_object if_does_not_exist, cl_fixnum byte_size, int char_stream_p, int cstream); extern ECL_API cl_object ecl_make_string_input_stream(cl_object strng, cl_index istart, cl_index iend); extern ECL_API cl_object ecl_make_string_output_stream(cl_index line_length); extern ECL_API cl_object ecl_read_byte(cl_object strm); @@ -1545,8 +1548,8 @@ extern ECL_API cl_object si_mkstemp(cl_object templ); extern ECL_API cl_object si_rmdir(cl_object directory); extern ECL_API cl_object ecl_cstring_to_pathname(char *s); -extern ECL_API void *ecl_backup_fopen(const char *filename, const char *option); -extern ECL_API cl_object ecl_file_len(void *fp); +extern ECL_API int ecl_backup_open(const char *filename, int option, int mode); +extern ECL_API cl_object ecl_file_len(int f); extern ECL_API cl_object ecl_homedir_pathname(cl_object user); #if defined(_MSC_VER) || defined(mingw32) extern ECL_API cl_object si_get_library_pathname(void); diff --git a/src/h/internal.h b/src/h/internal.h index 61a8cb7bf..2871dfa65 100644 --- a/src/h/internal.h +++ b/src/h/internal.h @@ -139,6 +139,10 @@ extern void* ecl_dynamic_callback_make(cl_object data, enum ecl_ffi_calling_conv #define IO_STREAM_COLUMN(strm) (strm)->stream.int1 #define IO_STREAM_ELT_TYPE(strm) (strm)->stream.object0 #define IO_STREAM_FILENAME(strm) (strm)->stream.object1 +#define IO_FILE_DESCRIPTOR(strm) (int)((strm)->stream.file) +#define IO_FILE_COLUMN(strm) (strm)->stream.int1 +#define IO_FILE_ELT_TYPE(strm) (strm)->stream.object0 +#define IO_FILE_FILENAME(strm) (strm)->stream.object1 /* format.d */ diff --git a/src/h/object.h b/src/h/object.h index 178a6af04..0235e0bcd 100644 --- a/src/h/object.h +++ b/src/h/object.h @@ -454,8 +454,11 @@ struct ecl_structure { /* structure header */ enum ecl_smmode { /* stream mode */ smm_input, /* input */ + smm_input_file, /* input */ smm_output, /* output */ + smm_output_file, /* output */ smm_io, /* input-output */ + smm_io_file, /* input-output */ smm_synonym, /* synonym */ smm_broadcast, /* broadcast */ smm_concatenated, /* concatenated */ @@ -473,8 +476,8 @@ enum ecl_smmode { /* stream mode */ }; struct ecl_file_ops { - cl_index (*write_byte8)(cl_object strm, char *c, cl_index n); - cl_index (*read_byte8)(cl_object strm, char *c, cl_index n); + cl_index (*write_byte8)(cl_object strm, unsigned char *c, cl_index n); + cl_index (*read_byte8)(cl_object strm, unsigned char *c, cl_index n); int (*read_char)(cl_object strm); int (*write_char)(cl_object strm, int c); From e7d6aac15e23958f52ab0ac7f41b6401f73c26cc Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Thu, 23 Oct 2008 19:33:46 +0200 Subject: [PATCH 38/60] Add smm_*_file types in several cases. --- src/c/pathname.d | 3 +++ src/c/print.d | 6 +++--- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/src/c/pathname.d b/src/c/pathname.d index cee9c3b19..8c5a7442e 100644 --- a/src/c/pathname.d +++ b/src/c/pathname.d @@ -652,6 +652,9 @@ L: case smm_output: case smm_probe: case smm_io: + case smm_input_file: + case smm_output_file: + case smm_io_file: x = IO_STREAM_FILENAME(x); goto L; case smm_synonym: diff --git a/src/c/print.d b/src/c/print.d index d886cc77c..d0c8cdce5 100644 --- a/src/c/print.d +++ b/src/c/print.d @@ -1344,16 +1344,16 @@ si_write_ugly_object(cl_object x, cl_object stream) if (ecl_print_readably()) FEprint_not_readable(x); write_str(x->stream.closed? "#stream.mode) { + case smm_input_file: case smm_input: write_str("input stream ", stream); si_write_ugly_object(IO_STREAM_FILENAME(x), stream); break; - + case smm_output_file: case smm_output: write_str("output stream ", stream); si_write_ugly_object(IO_STREAM_FILENAME(x), stream); break; - #ifdef _MSC_VER case smm_input_wsock: write_str("input win32 socket stream ", stream); @@ -1370,7 +1370,7 @@ si_write_ugly_object(cl_object x, cl_object stream) si_write_ugly_object(IO_STREAM_FILENAME(x), stream); break; #endif - + case smm_io_file: case smm_io: write_str("io stream ", stream); si_write_ugly_object(IO_STREAM_FILENAME(x), stream); From d2a8385f7dc6c55c3ffaf3ae6af50319707519e6 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Thu, 23 Oct 2008 23:17:35 +0200 Subject: [PATCH 39/60] Basic support for multibyte external formats --- src/CHANGELOG | 7 + src/c/file.d | 432 +++++++++++++++++++++++++++++++++--------- src/c/load.d | 3 +- src/c/symbols_list.h | 6 + src/c/symbols_list2.h | 6 + src/cmp/cmpmain.lsp | 4 +- src/cmp/cmpwt.lsp | 2 +- src/h/external.h | 2 +- src/h/object.h | 24 ++- 9 files changed, 392 insertions(+), 94 deletions(-) diff --git a/src/CHANGELOG b/src/CHANGELOG index 8f45b6f32..928c0a08a 100644 --- a/src/CHANGELOG +++ b/src/CHANGELOG @@ -82,6 +82,8 @@ ECL 8.9.0: - Binary streams now can only read or write bytes whose size is a multiple of 8. +* Streams: + - ECL has now a new and more easily extensible implementation of streams, based on C structures with a method dispatch table. Apart from code reuse and better maintainability, this allows a more sensible design of read/write-sequence. @@ -93,6 +95,11 @@ ECL 8.9.0: - Internally, ECL allows to work with POSIX file descriptors directly, without using C streams. + - POSIX files and C streams now support different external formats. ECL + understands right now :UTF-8, :UCS-2 (bigendian), :UCS-4 (bigendian), + :LATIN-1 and :ISO-8859-1. If built _without_ support for Unicode, only the + last two are available. + * Embedding: - ECL now implements a more transparent interface for setting and querying diff --git a/src/c/file.d b/src/c/file.d index 82fa890fd..4966af28c 100644 --- a/src/c/file.d +++ b/src/c/file.d @@ -80,6 +80,7 @@ static int restartable_io_error(cl_object strm); static void unread_error(cl_object strm); static void unread_twice(cl_object strm); static void io_error(cl_object strm); +static void character_size_overflow(cl_object strm, int c); static void wrong_file_handler(cl_object strm); /********************************************************************** @@ -339,8 +340,12 @@ static int generic_write_char(cl_object strm, int c) { const struct ecl_file_ops *ops = stream_dispatch_table(strm); - char aux = c; - ops->write_byte8(strm, &aux, 1); + if (c > 0xFF) { + character_overflow(strm, c); + } else { + unsigned char aux = c; + ops->write_byte8(strm, &aux, 1); + } return c; } @@ -458,6 +463,175 @@ generic_read_vector(cl_object strm, cl_object data, cl_index start, cl_index end return start; } +/********************************************************************** + * WIDE CHARACTER SUPPORT + */ + +#ifdef ECL_UNICODE +/* + * UCS-4 BIG ENDIAN + */ + +static int +ucs_4_read_char(cl_object strm) +{ + unsigned char buffer[4]; + int c = strm->stream.unread; + if (c != EOF) { + strm->stream.unread = EOF; + return c; + } + if (strm->stream.ops->read_byte8(strm, buffer, 4) < 4) + return EOF; + return buffer[3]+buffer[2]<<8+buffer[1]<<16+buffer[0]<<24; +} + +static int +ucs_4_write_char(cl_object strm, int c_orig) +{ + int c = c_orig; + unsigned char buffer[4]; + buffer[3] = c & 8; c >>= 8; + buffer[2] = c & 8; c >>= 8; + buffer[1] = c & 8; c >>= 8; + buffer[0] = c; + strm->stream.ops->write_byte8(strm, buffer, 4); + return c_orig; +} + +/* + * UCS-2 BIG ENDIAN + */ + +static int +ucs_2_read_char(cl_object strm) +{ + unsigned char buffer[2]; + int c = strm->stream.unread; + if (c != EOF) { + strm->stream.unread = EOF; + return c; + } + if (strm->stream.ops->read_byte8(strm, buffer, 2) < 4) + return EOF; + return buffer[1]+buffer[0]<<8; +} + +static int +ucs_2_write_char(cl_object strm, int c_orig) +{ + int c = c_orig; + unsigned char buffer[2]; + buffer[1] = c & 8; c >>= 8; + buffer[0] = c & 8; + strm->stream.ops->write_byte8(strm, buffer, 2); + return c; +} + +/* + * UTF-8 + */ + +static int +utf_8_read_char(cl_object strm) +{ + /* In understanding this code: + * 0x8 = 1000, 0xC = 1100, 0xE = 1110, 0xF = 1111 + * 0x1 = 0001, 0x3 = 0011, 0x7 = 0111, 0xF = 1111 + */ + int cum = 0; + unsigned char buffer[5]; + int nbytes, i; + cum = strm->stream.unread; + if (cum != EOF) { + strm->stream.unread = EOF; + return cum; + } + if (strm->stream.ops->read_byte8(strm, buffer, 1) < 1) + return EOF; + printf("%0x\n", buffer[0]); + if ((buffer[0] & 0x80) == 0) + return buffer[0]; + if ((buffer[0] & 0x40) == 0) + goto MALFORMED; + if ((buffer[0] & 0x20) == 0) { + buffer[0] &= 0x1F; + nbytes = 1; + } else if ((buffer[0] & 0x10) == 0) { + buffer[0] &= 0x0F; + nbytes = 2; + } else if ((buffer[0] & 0x08) == 0) { + buffer[0] &= 0x07; + nbytes = 3; + } else { + FEerror("ECL does not support Unicode characters with more than 21 bits.", 0); + } + if (buffer[0] == 0) { + goto TOO_LONG; + } + if (strm->stream.ops->read_byte8(strm, buffer+1, nbytes) < nbytes) + return EOF; + for (i = 1, cum = buffer[0]; i <= nbytes; i++) { + unsigned char c = buffer[i]; + if ((c & 0xC0) != 0x80) + goto MALFORMED; + c &= 0x3F; + if (c == 0) + goto TOO_LONG; + cum = (cum << 6) | c; + } + if (cum >= 0xd800) { + if (cum <= 0xdfff) + goto INVALID_CODE_POINT; + if (cum >= 0xFFFE && cum <= 0xFFFF) + goto INVALID_CODE_POINT; + } + return cum; + TOO_LONG: + FEerror("In ~A found an UTF-8 encoding which is too large for the given character", + 1, strm); + return EOF; + MALFORMED: + FEerror("Invalid byte found in UTF-8 stream ~A", 1, strm); + return EOF; + INVALID_CODE_POINT: + FEerror("Invalid code point ~D found in ~A", 2, MAKE_FIXNUM(cum), strm); + return EOF; +} + +static int +utf_8_write_char(cl_object strm, int c_orig) +{ + int c = c_orig; + unsigned char buffer[5]; + int nbytes; + if (c < 0) { + FEerror("Not a valid character code ~D written to ~A", 2, + MAKE_FIXNUM(c), strm); + } else if (c <= 0x7F) { + buffer[0] = c; + nbytes = 1; + } else if (c <= 0x7ff) { + buffer[1] = c & 0x3f; c >>= 6; + buffer[0] = c | 0xC0; + nbytes = 2; + } else if (c <= 0xFFFF) { + buffer[2] = c & 0x3f; c >>= 6; + buffer[1] = c & 0x3f; c >>= 6; + buffer[0] = c | 0xE0; + nbytes = 3; + } else if (c <= 0x1FFFFFL) { + buffer[3] = c & 0x3f; c >>= 6; + buffer[2] = c & 0x3f; c >>= 6; + buffer[1] = c & 0x3f; c >>= 6; + buffer[0] = c | 0xF0; + nbytes = 4; + } + strm->stream.ops->write_byte8(strm, buffer, nbytes); + return c_orig; +} +#endif + /******************************************************************************** * CLOS STREAMS */ @@ -738,9 +912,9 @@ si_make_string_output_stream_from_string(cl_object s) strm->stream.mode = (short)smm_string_output; STRING_OUTPUT_STRING(strm) = s; STRING_OUTPUT_COLUMN(strm) = 0; - strm->stream.char_stream_p = 1; + strm->stream.format = @':latin-1'; + strm->stream.flags = ECL_STREAM_LATIN_1; strm->stream.byte_size = 8; - strm->stream.signed_bytes = 0; @(return strm) } @@ -909,9 +1083,9 @@ ecl_make_string_input_stream(cl_object strng, cl_index istart, cl_index iend) STRING_INPUT_STRING(strm) = strng; STRING_INPUT_POSITION(strm) = istart; STRING_INPUT_LIMIT(strm) = iend; - strm->stream.char_stream_p = 1; + strm->stream.format = @':latin-1'; + strm->stream.flags = ECL_STREAM_LATIN_1; strm->stream.byte_size = 8; - strm->stream.signed_bytes = 0; return strm; } @@ -1100,6 +1274,7 @@ cl_make_two_way_stream(cl_object istrm, cl_object ostrm) if (!ecl_output_stream_p(ostrm)) not_an_output_stream(ostrm); strm = alloc_stream(); + strm->stream.format = cl_stream_external_format(istrm); strm->stream.mode = (short)smm_two_way; strm->stream.ops = duplicate_dispatch_table(&two_way_ops); TWO_WAY_STREAM_INPUT(strm) = istrm; @@ -1278,6 +1453,11 @@ const struct ecl_file_ops broadcast_ops = { streams = CONS(x, streams); } x = alloc_stream(); + if (Null(streams)) { + x->stream.format = @':default'; + } else { + x->stream.format = cl_stream_external_format(ECL_CONS_CAR(streams)); + } x->stream.ops = duplicate_dispatch_table(&broadcast_ops); x->stream.mode = (short)smm_broadcast; BROADCAST_STREAM_LIST(x) = cl_nreverse(streams); @@ -1431,6 +1611,7 @@ cl_make_echo_stream(cl_object strm1, cl_object strm2) if (!ecl_output_stream_p(strm2)) not_an_output_stream(strm2); strm = alloc_stream(); + strm->stream.format = cl_stream_external_format(strm1); strm->stream.mode = (short)smm_echo; strm->stream.ops = duplicate_dispatch_table(&echo_ops); ECHO_STREAM_INPUT(strm) = strm1; @@ -1575,6 +1756,11 @@ const struct ecl_file_ops concatenated_ops = { streams = CONS(x, streams); } x = alloc_stream(); + if (Null(streams)) { + x->stream.format = @':default'; + } else { + x->stream.format = cl_stream_external_format(ECL_CONS_CAR(streams)); + } x->stream.mode = (short)smm_concatenated; x->stream.ops = duplicate_dispatch_table(&concatenated_ops); CONCATENATED_STREAM_LIST(x) = cl_nreverse(streams); @@ -1809,7 +1995,9 @@ io_file_write_byte8(cl_object strm, unsigned char *c, cl_index n) static int io_file_write_char(cl_object strm, int c) { - char aux = c; + if (c > 0xFF) { + character_size_overflow(strm, c); + } strm->stream.unread = EOF; if (c == '\n') IO_FILE_COLUMN(strm) = 0; @@ -1817,7 +2005,10 @@ io_file_write_char(cl_object strm, int c) IO_FILE_COLUMN(strm) = (IO_FILE_COLUMN(strm)&~07) + 8; else IO_FILE_COLUMN(strm)++; - io_file_write_byte8(strm, &aux, 1); + { + char aux = c; + io_file_write_byte8(strm, &aux, 1); + } return c; } @@ -2095,34 +2286,61 @@ const struct ecl_file_ops input_file_ops = { }; static void -set_stream_elt_type(cl_object stream, cl_fixnum byte_size, int char_stream_p) +set_stream_elt_type(cl_object stream, cl_fixnum byte_size, int flags) { - if (char_stream_p) { - if (byte_size != 8) { - FEerror("Cannot create a character stream when byte size is not 8.", 0); - } - stream->stream.signed_bytes = 0; - IO_STREAM_ELT_TYPE(stream) = @'base-char'; - byte_size = 8; - } else { - cl_object t; - if (byte_size > 0) { - stream->stream.signed_bytes = 0; - t = @'unsigned-byte'; - } else { - byte_size = -byte_size; - stream->stream.signed_bytes = 1; - t = @'signed-byte'; - } - IO_STREAM_ELT_TYPE(stream) = cl_list(2, t, MAKE_FIXNUM(byte_size)); + cl_object t; + if (byte_size < 0) { + byte_size = -byte_size; + flags |= ECL_STREAM_SIGNED_BYTES; + t = @'signed-byte'; + } else { + flags &= ~ECL_STREAM_SIGNED_BYTES; + t = @'unsigned-byte'; } - stream->stream.char_stream_p = char_stream_p; + switch (flags & ECL_STREAM_FORMAT) { + case ECL_STREAM_BINARY: + IO_STREAM_ELT_TYPE(stream) = cl_list(2, t, MAKE_FIXNUM(byte_size)); + stream->stream.format = @':default'; + break; + /*case ECL_ISO_8859_1:*/ + case ECL_STREAM_LATIN_1: + IO_STREAM_ELT_TYPE(stream) = @'base-char'; + stream->stream.format = @':latin-1'; + byte_size = 8; + break; +#ifdef ECL_UNICODE + case ECL_STREAM_UTF_8: + IO_STREAM_ELT_TYPE(stream) = @'character'; + byte_size = 8*2; + stream->stream.format = @':utf-8'; + stream->stream.ops->read_char = utf_8_read_char; + stream->stream.ops->write_char = utf_8_write_char; + break; + case ECL_STREAM_UCS_2: + IO_STREAM_ELT_TYPE(stream) = @'character'; + stream->stream.format = @':ucs-2'; + stream->stream.ops->read_char = ucs_2_read_char; + stream->stream.ops->write_char = ucs_2_write_char; + byte_size = 8*2; + break; + case ECL_STREAM_UCS_4: + IO_STREAM_ELT_TYPE(stream) = @'character'; + stream->stream.format = @':ucs-4'; + stream->stream.ops->read_char = ucs_4_read_char; + stream->stream.ops->write_char = ucs_4_write_char; + byte_size = 8*4; + break; +#endif + default: + FEerror("Invalid external format code ~D", 1, MAKE_FIXNUM(flags)); + } + stream->stream.flags = flags; stream->stream.byte_size = (byte_size+7)&(~(cl_fixnum)7); } cl_object ecl_make_file_stream_from_fd(cl_object fname, int fd, enum ecl_smmode smm, - cl_fixnum byte_size, int char_stream_p) + cl_fixnum byte_size, int flags) { cl_object stream = alloc_stream(); stream->stream.mode = (short)smm; @@ -2151,7 +2369,7 @@ ecl_make_file_stream_from_fd(cl_object fname, int fd, enum ecl_smmode smm, default: FEerror("make_stream: wrong mode", 0); } - set_stream_elt_type(stream, byte_size, char_stream_p); + set_stream_elt_type(stream, byte_size, flags); IO_FILE_FILENAME(stream) = fname; /* not really used */ IO_FILE_COLUMN(stream) = 0; stream->stream.file = (void*)fd; @@ -2216,11 +2434,14 @@ static int io_stream_write_char(cl_object strm, int c) { FILE *f = IO_STREAM_FILE(strm); - char aux = c; int outcome; + if (c > 0xFF) { + character_size_overflow(strm, c); + } strm->stream.unread = EOF; ecl_disable_interrupts(); do { + char aux = c; outcome = putc(c, f); } while (outcome == EOF && restartable_io_error(strm)); ecl_enable_interrupts(); @@ -2517,7 +2738,7 @@ si_set_buffering_mode(cl_object stream, cl_object buffer_mode_symbol) cl_object ecl_make_stream_from_FILE(cl_object fname, void *f, enum ecl_smmode smm, - cl_fixnum byte_size, int char_stream_p) + cl_fixnum byte_size, int flags) { cl_object stream; stream = alloc_stream(); @@ -2541,7 +2762,7 @@ ecl_make_stream_from_FILE(cl_object fname, void *f, enum ecl_smmode smm, default: FEerror("Not a valid mode ~D for ecl_make_stream_from_FILE", 1, MAKE_FIXNUM(smm)); } - set_stream_elt_type(stream, byte_size, char_stream_p); + set_stream_elt_type(stream, byte_size, flags); IO_STREAM_FILENAME(stream) = fname; /* not really used */ IO_STREAM_COLUMN(stream) = 0; stream->stream.file = f; @@ -2552,7 +2773,7 @@ ecl_make_stream_from_FILE(cl_object fname, void *f, enum ecl_smmode smm, cl_object ecl_make_stream_from_fd(cl_object fname, int fd, enum ecl_smmode smm, - cl_fixnum byte_size, int char_stream_p) + cl_fixnum byte_size, int flags) { char *mode; /* file open mode */ FILE *fp; /* file pointer */ @@ -2585,7 +2806,7 @@ ecl_make_stream_from_fd(cl_object fname, int fd, enum ecl_smmode smm, fp = fdopen(fd, mode); #endif ecl_enable_interrupts(); - return ecl_make_stream_from_FILE(fname, fp, smm, byte_size, char_stream_p); + return ecl_make_stream_from_FILE(fname, fp, smm, byte_size, flags); } @@ -2689,9 +2910,9 @@ ecl_read_byte(cl_object strm) bs = strm->stream.byte_size; if (bs == 8) { unsigned char c; - if (read_byte8(strm, (char*)&c, 1) < 1) + if (read_byte8(strm, &c, 1) < 1) return Cnil; - if (strm->stream.signed_bytes) { + if (strm->stream.flags & ECL_STREAM_SIGNED_BYTES) { return MAKE_FIXNUM((signed char)c); } else { return MAKE_FIXNUM((unsigned char)c); @@ -2702,9 +2923,9 @@ ecl_read_byte(cl_object strm) cl_object output = MAKE_FIXNUM(0); for (nb = 0; bs >= 8; bs -= 8, nb += 8) { cl_object aux; - if (read_byte8(strm, (char*)&c, 1) < 1) + if (read_byte8(strm, &c, 1) < 1) return Cnil; - if (bs <= 8 && strm->stream.signed_bytes) + if (bs <= 8 && (strm->stream.flags & ECL_STREAM_SIGNED_BYTES)) aux = MAKE_FIXNUM((signed char)c); else aux = MAKE_FIXNUM((unsigned char)c); @@ -2731,12 +2952,12 @@ BEGIN: write_byte8 = stream_dispatch_table(strm)->write_byte8; bs = strm->stream.byte_size; if (bs == 8) { - cl_fixnum i = (strm->stream.signed_bytes)? fixint(c) : fixnnint(c); - char c = (char)i; + cl_fixnum i = (strm->stream.flags & ECL_STREAM_SIGNED_BYTES)? fixint(c) : fixnnint(c); + unsigned char c = (unsigned char)i; write_byte8(strm, &c, 1); } else do { cl_object b = cl_logand(2, c, MAKE_FIXNUM(0xFF)); - char aux = (char)fix(b); + unsigned char aux = (unsigned char)fix(b); if (write_byte8(strm, &aux, 1) < 1) break; c = cl_ash(c, MAKE_FIXNUM(-8)); @@ -3050,16 +3271,21 @@ cl_object cl_stream_external_format(cl_object strm) { cl_object output; - cl_type t = type_of(strm); + cl_type t; + AGAIN: + t= type_of(strm); #ifdef ECL_CLOS_STREAMS if (t == t_instance) output = @':default'; else #endif - if (t == t_stream) - output = @':default'; - else + if (t != t_stream) FEwrong_type_argument(@'stream', strm); + if (strm->stream.mode == smm_synonym) { + strm = SYNONYM_STREAM_STREAM(strm); + goto AGAIN; + } + output = strm->stream.format; @(return output) } @@ -3122,10 +3348,45 @@ normalize_stream_element_type(cl_object element_type) } } +static int +parse_external_format(cl_object input_format) +{ +#ifdef ECL_UNICODE + if (input_format == @':UTF-8') { + return ECL_STREAM_UTF_8; + } + if (input_format == @':UCS-2') { + return ECL_STREAM_UCS_2; + } + if (input_format == @':UCS-4') { + return ECL_STREAM_UCS_4; + } + if (input_format == @':default') { + return ECL_STREAM_UTF_8; + } +#else + if (input_format == @':UTF-8' || input_format == @':UCS-2' || + input_format == @':UCS-4') { + FEerror("Unsupported external format: ~A", input_format); + } + if (input_format == @':default') { + return ECL_STREAM_LATIN_1; + } +#endif + if (input_format == @':ISO-8859-1') { + return ECL_STREAM_ISO_8859_1; + } + if (input_format == @':LATIN-1') { + return ECL_STREAM_LATIN_1; + } + FEerror("Unknown external format: ~A", 1, input_format); + return ECL_STREAM_DEFAULT_FORMAT; +} + cl_object ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, cl_object if_does_not_exist, cl_fixnum byte_size, - int char_stream_p, int cstream) + int flags) { cl_env_ptr the_env = &cl_env; cl_object x; @@ -3135,9 +3396,6 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, char *fname = filename->base_string.self; bool appending = FALSE; - if (char_stream_p && byte_size != 8) { - FEerror("Tried to make a character stream of byte size /= 8.",0); - } ecl_disable_interrupts_env(the_env); if (smm == smm_input || smm == smm_probe) { f = open(fname, O_RDONLY, mode); @@ -3227,32 +3485,24 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, goto INVALID_MODE; } ecl_enable_interrupts_env(the_env); - if (cstream) { + if (flags & ECL_STREAM_C_STREAM) { FILE *fp; switch (smm) { case smm_input: fp = fdopen(f, OPEN_R); break; case smm_output: fp = fdopen(f, OPEN_W); break; case smm_io: fp = fdopen(f, OPEN_RW); break; } - x = ecl_make_stream_from_FILE(fn, fp, smm, byte_size, char_stream_p); - si_set_buffering_mode(x, char_stream_p? @':line-buffered' : @':fully-buffered'); + x = ecl_make_stream_from_FILE(fn, fp, smm, byte_size, flags); + si_set_buffering_mode(x, (flags & ECL_STREAM_FORMAT)? @':line-buffered' : @':fully-buffered'); } else { - x = ecl_make_file_stream_from_fd(fn, f, smm, byte_size, char_stream_p); + x = ecl_make_file_stream_from_fd(fn, f, smm, byte_size, flags); } if (smm == smm_probe) { cl_close(1, x); } else { si_set_finalizer(x, Ct); - if (!char_stream_p) { - /* Set file pointer to the correct position */ - ecl_disable_interrupts_env(the_env); - if (appending) { - lseek(f, -1, SEEK_END); - } else { - lseek(f, 0, SEEK_SET); - } - ecl_enable_interrupts_env(the_env); - } + /* Set file pointer to the correct position */ + ecl_file_position_set(x, appending? Cnil : MAKE_FIXNUM(0)); } OUTPUT: ecl_enable_interrupts_env(the_env); @@ -3280,12 +3530,9 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, (cstream Cnil) &aux strm) enum ecl_smmode smm; - bool char_stream_p; + int flags = 0; cl_fixnum byte_size; @ - if (external_format != @':default') - FEerror("~S is not a valid stream external format.", 1, - external_format); /* INV: ecl_open_stream() checks types */ if (direction == @':input') { smm = smm_input; @@ -3321,24 +3568,27 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, FEerror("~S is an illegal DIRECTION for OPEN.", 1, direction); } - if (element_type == @':default') { - char_stream_p = 1; - byte_size = 8; - } else if (element_type == @'signed-byte') { - char_stream_p = 0; + if (element_type == @'signed-byte') { byte_size = -8; } else if (element_type == @'unsigned-byte') { - char_stream_p = 0; byte_size = 8; + } else if (element_type == @':default') { + flags |= parse_external_format(external_format); + byte_size = 0; } else if (funcall(3, @'subtypep', element_type, @'character') != Cnil) { - char_stream_p = 1; - byte_size = 8; + flags |= parse_external_format(external_format); + byte_size = 0; } else { - char_stream_p = 0; byte_size = normalize_stream_element_type(element_type); } + if (byte_size != 0 && external_format != @':default') { + FEerror("Cannot specify an external format for binary streams.", 0); + } + if (!Null(cstream)) { + flags |= ECL_STREAM_C_STREAM; + } strm = ecl_open_stream(filename, smm, if_exists, if_does_not_exist, - byte_size, char_stream_p, !Null(cstream)); + byte_size, flags); @(return strm) @) @@ -3557,9 +3807,8 @@ alloc_stream() x->stream.object1 = OBJNULL; x->stream.int0 = x->stream.int1 = 0; x->stream.unread = EOF; - x->stream.char_stream_p = 1; + x->stream.flags = ECL_STREAM_LATIN_1; x->stream.byte_size = 8; - x->stream.signed_bytes = 0; x->stream.buffer = NULL; return x; } @@ -3668,6 +3917,14 @@ io_error(cl_object strm) 1, strm); } +static void +character_size_overflow(cl_object strm, int c) +{ + FEerror("Tried to write a character code ~D in a ~A stream.", 0, + MAKE_FIXNUM(c), + cl_stream_external_format(strm)); +} + static void wrong_file_handler(cl_object strm) { @@ -3696,6 +3953,7 @@ void init_file(void) { const cl_env_ptr env = ecl_process_env(); + int flags = ECL_STREAM_DEFAULT_FORMAT; cl_object standard_input; cl_object standard_output; cl_object error_output; @@ -3709,20 +3967,20 @@ init_file(void) null_stream = cl_make_two_way_stream(null_stream, cl_make_broadcast_stream(0)); cl_core.null_stream = null_stream; -#if 0 +#if 1 standard_input = ecl_make_stream_from_FILE(make_constant_base_string("stdin"), - stdin, smm_input, 8, 1); + stdin, smm_input, 8, flags); standard_output = ecl_make_stream_from_FILE(make_constant_base_string("stdout"), - stdout, smm_output, 8, 1); + stdout, smm_output, 8, flags); error_output = ecl_make_stream_from_FILE(make_constant_base_string("stderr"), - stderr, smm_output, 8, 1); + stderr, smm_output, 8, flags); #else standard_input = ecl_make_file_stream_from_fd(make_constant_base_string("stdin"), - STDIN_FILENO, smm_input, 8, 1); + STDIN_FILENO, smm_input, 8, flags); standard_output = ecl_make_file_stream_from_fd(make_constant_base_string("stdout"), - STDOUT_FILENO, smm_output, 8, 1); + STDOUT_FILENO, smm_output, 8, flags); error_output = ecl_make_file_stream_from_fd(make_constant_base_string("stderr"), - STDERR_FILENO, smm_output, 8, 1); + STDERR_FILENO, smm_output, 8, flags); #endif cl_core.standard_input = standard_input; ECL_SET(@'*standard-input*', standard_input); diff --git a/src/c/load.d b/src/c/load.d index ffc14aa9f..123b434de 100644 --- a/src/c/load.d +++ b/src/c/load.d @@ -423,7 +423,8 @@ si_load_source(cl_object source, cl_object verbose, cl_object print) /* INV: if "source" is not a valid stream, file.d will complain */ strm = source; } else { - strm = ecl_open_stream(source, smm_input, Cnil, Cnil, 8, 1, 0); + strm = ecl_open_stream(source, smm_input, Cnil, Cnil, 8, + ECL_STREAM_DEFAULT_FORMAT); if (Null(strm)) @(return Cnil) } diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index 2a7594cbf..04d179eff 100644 --- a/src/c/symbols_list.h +++ b/src/c/symbols_list.h @@ -1710,5 +1710,11 @@ cl_symbols[] = { {SYS_ "CHECK-PENDING-INTERRUPTS", SI_ORDINARY, si_check_pending_interrupts, 0, OBJNULL}, +{KEY_ "LATIN-1", KEYWORD, NULL, -1, OBJNULL}, +{KEY_ "ISO-8859-1", KEYWORD, NULL, -1, OBJNULL}, +{KEY_ "UTF-8", KEYWORD, NULL, -1, OBJNULL}, +{KEY_ "UCS-2", KEYWORD, NULL, -1, OBJNULL}, +{KEY_ "UCS-4", KEYWORD, NULL, -1, OBJNULL}, + /* Tag for end of list */ {NULL, CL_ORDINARY, NULL, -1, OBJNULL}}; diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h index 263ecfb9e..56f1782f7 100644 --- a/src/c/symbols_list2.h +++ b/src/c/symbols_list2.h @@ -1710,5 +1710,11 @@ cl_symbols[] = { {SYS_ "CHECK-PENDING-INTERRUPTS","si_check_pending_interrupts"}, +{KEY_ "LATIN-1",NULL}, +{KEY_ "ISO-8859-1",NULL}, +{KEY_ "UTF-8",NULL}, +{KEY_ "UCS-2",NULL}, +{KEY_ "UCS-4",NULL}, + /* Tag for end of list */ {NULL,NULL}}; diff --git a/src/cmp/cmpmain.lsp b/src/cmp/cmpmain.lsp index d11605392..945c7d4e6 100644 --- a/src/cmp/cmpmain.lsp +++ b/src/cmp/cmpmain.lsp @@ -369,7 +369,7 @@ output = cl_safe_eval(c_string_to_object(lisp_code), Cnil, OBJNULL); ;; We should give a warning that we cannot link this module in (when flags (push flags ld-flags)) (push init-fn submodules)))))) - (setq c-file (open c-name :direction :output)) + (setq c-file (open c-name :direction :output :external-format :latin-1)) (format c-file +lisp-program-header+ submodules) (cond (shared-data-file (data-init shared-data-file) @@ -767,7 +767,7 @@ from the C language code. NIL means \"do not create the file\"." (let* ((null-stream (make-broadcast-stream)) (*compiler-output1* null-stream) (*compiler-output2* (if h-file - (open h-file :direction :output) + (open h-file :direction :output :external-format :latin-1) null-stream)) (t3local-fun (symbol-function 'T3LOCAL-FUN)) (compiler-conditions nil)) diff --git a/src/cmp/cmpwt.lsp b/src/cmp/cmpwt.lsp index 5b1e3478f..d59287da7 100644 --- a/src/cmp/cmpwt.lsp +++ b/src/cmp/cmpwt.lsp @@ -143,7 +143,7 @@ (null (return-from data-dump)) ((or pathname string) (setf stream (open stream :direction :output :if-does-not-exist :create - :if-exists :supersede) + :if-exists :supersede :external-format :latin-1) must-close stream)) (stream)) (let ((*print-radix* nil) diff --git a/src/h/external.h b/src/h/external.h index 76cac4091..a095f43d6 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -600,7 +600,7 @@ extern ECL_API bool ecl_input_stream_p(cl_object strm); extern ECL_API bool ecl_output_stream_p(cl_object strm); extern ECL_API cl_object ecl_stream_element_type(cl_object strm); extern ECL_API bool ecl_interactive_stream_p(cl_object strm); -extern ECL_API cl_object ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, cl_object if_does_not_exist, cl_fixnum byte_size, int char_stream_p, int cstream); +extern ECL_API cl_object ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, cl_object if_does_not_exist, cl_fixnum byte_size, int flags); extern ECL_API cl_object ecl_make_string_input_stream(cl_object strng, cl_index istart, cl_index iend); extern ECL_API cl_object ecl_make_string_output_stream(cl_index line_length); extern ECL_API cl_object ecl_read_byte(cl_object strm); diff --git a/src/h/object.h b/src/h/object.h index 0235e0bcd..127d5d55d 100644 --- a/src/h/object.h +++ b/src/h/object.h @@ -506,9 +506,28 @@ struct ecl_file_ops { cl_object (*close)(cl_object strm); }; +enum { + ECL_STREAM_BINARY = 0, + ECL_STREAM_FORMAT = 0xF, +#ifdef ECL_UNICODE + ECL_STREAM_DEFAULT_FORMAT = 2, +#else + ECL_STREAM_DEFAULT_FORMAT = 1, +#endif + ECL_STREAM_ISO_8859_1 = 1, + ECL_STREAM_LATIN_1 = 1, + ECL_STREAM_UTF_8 = 2, + ECL_STREAM_UCS_2 = 3, + ECL_STREAM_UCS_4 = 4, + ECL_STREAM_SIGNED_BYTES = 16, + ECL_STREAM_C_STREAM = 32 +}; + struct ecl_stream { - HEADER4(mode,char_stream_p,closed,signed_bytes); - /* stream mode of enum smmode */ + HEADER3(mode,closed,flags); + /* stream mode of enum smmode */ + /* closed stream? */ + /* character table, flags, etc */ struct ecl_file_ops *ops; /* dispatch table */ void *file; /* file pointer */ cl_object object0; /* some object */ @@ -519,6 +538,7 @@ struct ecl_stream { cl_index byte_size; /* size of byte in binary streams */ cl_fixnum last_op; /* 0: unknown, 1: reading, -1: writing */ char *buffer; /* buffer for FILE */ + cl_object format; /* external format */ }; struct ecl_random { From 609e1b83968bba01c79f33545f13f31dc14a8337 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Fri, 24 Oct 2008 23:10:49 +0200 Subject: [PATCH 40/60] Fix support for unicode characters in readtables --- src/CHANGELOG | 7 + src/c/file.d | 20 +- src/c/interpreter.d | 4 +- src/c/package.d | 5 - src/c/print.d | 8 +- src/c/read.d | 598 +++++++++++++++++++++++++------------------- src/c/string.d | 12 + src/cmp/cmpname.lsp | 2 +- src/h/external.h | 3 + src/h/object.h | 13 +- 10 files changed, 387 insertions(+), 285 deletions(-) diff --git a/src/CHANGELOG b/src/CHANGELOG index 928c0a08a..acdd45653 100644 --- a/src/CHANGELOG +++ b/src/CHANGELOG @@ -100,6 +100,11 @@ ECL 8.9.0: :LATIN-1 and :ISO-8859-1. If built _without_ support for Unicode, only the last two are available. + - Readtables now include entries for extended characters. + + - When a string is read, if the characters are base-char, the string is read + as a base-string. + * Embedding: - ECL now implements a more transparent interface for setting and querying @@ -204,6 +209,8 @@ ECL 8.9.0: - ENSURE-DIRECTORIES first has to merge the path with *DEFAULT-PATH...* + - The routines for printing symbols expected the names to be base strings. + ;;; Local Variables: *** ;;; mode:text *** ;;; fill-column:79 *** diff --git a/src/c/file.d b/src/c/file.d index 4966af28c..ea5458885 100644 --- a/src/c/file.d +++ b/src/c/file.d @@ -549,9 +549,10 @@ utf_8_read_char(cl_object strm) } if (strm->stream.ops->read_byte8(strm, buffer, 1) < 1) return EOF; - printf("%0x\n", buffer[0]); - if ((buffer[0] & 0x80) == 0) + /*printf(": %04x :", buffer[0]);*/ + if ((buffer[0] & 0x80) == 0) { return buffer[0]; + } if ((buffer[0] & 0x40) == 0) goto MALFORMED; if ((buffer[0] & 0x20) == 0) { @@ -573,6 +574,7 @@ utf_8_read_char(cl_object strm) return EOF; for (i = 1, cum = buffer[0]; i <= nbytes; i++) { unsigned char c = buffer[i]; + /*printf(": %04x :", c);*/ if ((c & 0xC0) != 0x80) goto MALFORMED; c &= 0x3F; @@ -586,6 +588,7 @@ utf_8_read_char(cl_object strm) if (cum >= 0xFFFE && cum <= 0xFFFF) goto INVALID_CODE_POINT; } + /*printf("; %04x ;", cum);*/ return cum; TOO_LONG: FEerror("In ~A found an UTF-8 encoding which is too large for the given character", @@ -612,18 +615,19 @@ utf_8_write_char(cl_object strm, int c_orig) buffer[0] = c; nbytes = 1; } else if (c <= 0x7ff) { - buffer[1] = c & 0x3f; c >>= 6; + buffer[1] = (c & 0x3f) | 0x80; c >>= 6; buffer[0] = c | 0xC0; + /*printf("\n; %04x ;: %04x :: %04x :\n", c_orig, buffer[0], buffer[1]);*/ nbytes = 2; } else if (c <= 0xFFFF) { - buffer[2] = c & 0x3f; c >>= 6; - buffer[1] = c & 0x3f; c >>= 6; + buffer[2] = (c & 0x3f) | 0x80; c >>= 6; + buffer[1] = (c & 0x3f) | 0x80; c >>= 6; buffer[0] = c | 0xE0; nbytes = 3; } else if (c <= 0x1FFFFFL) { - buffer[3] = c & 0x3f; c >>= 6; - buffer[2] = c & 0x3f; c >>= 6; - buffer[1] = c & 0x3f; c >>= 6; + buffer[3] = (c & 0x3f) | 0x80; c >>= 6; + buffer[2] = (c & 0x3f) | 0x80; c >>= 6; + buffer[1] = (c & 0x3f) | 0x80; c >>= 6; buffer[0] = c | 0xF0; nbytes = 4; } diff --git a/src/c/interpreter.d b/src/c/interpreter.d index 8661585a8..890d8a291 100644 --- a/src/c/interpreter.d +++ b/src/c/interpreter.d @@ -705,8 +705,10 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs frame_aux.top = the_env->stack_top; frame_aux.bottom = the_env->stack_top - narg; AGAIN: - if (reg0 == OBJNULL || reg0 == Cnil) + if (reg0 == OBJNULL || reg0 == Cnil) { + cl_print(1,x); FEundefined_function(x); + } switch (type_of(reg0)) { case t_cfunfixed: if (narg != (cl_index)reg0->cfun.narg) diff --git a/src/c/package.d b/src/c/package.d index 1f0e6b231..b9949c36c 100644 --- a/src/c/package.d +++ b/src/c/package.d @@ -328,11 +328,6 @@ ecl_intern(cl_object name, cl_object p, int *intern_flag) cl_object s, ul; name = ecl_check_type_string(@'intern', name); -#ifdef ECL_UNICODE - if (ecl_fits_in_base_string(name)) { - name = si_copy_to_simple_base_string(name); - } -#endif p = si_coerce_to_package(p); TRY_AGAIN_LABEL: PACKAGE_LOCK(p); diff --git a/src/c/print.d b/src/c/print.d index d0c8cdce5..0ac8e74d5 100644 --- a/src/c/print.d +++ b/src/c/print.d @@ -737,7 +737,7 @@ all_dots(cl_object s) { cl_index i; for (i = 0; i < s->base_string.fillp; i++) - if (s->base_string.self[i] != '.') + if (ecl_char(s, i) != '.') return 0; return 1; } @@ -757,8 +757,8 @@ needs_to_be_escaped(cl_object s, cl_object readtable, cl_object print_case) * string has to be escaped according to readtable case and the rules * of 22.1.3.3.2. */ for (i = 0; i < s->base_string.fillp; i++) { - int c = s->base_string.self[i] & 0377; - int syntax = readtable->readtable.table[c].syntax_type; + int c = ecl_char(s, i); + int syntax = ecl_readtable_get(readtable, c, 0); if (syntax != cat_constituent || ecl_invalid_character_p(c) || (c) == ':') return 1; if ((action == ecl_case_downcase) && isupper(c)) @@ -785,7 +785,7 @@ write_symbol_string(cl_object s, int action, cl_object print_case, write_ch('|', stream); capitalize = 1; for (i = 0; i < s->base_string.fillp; i++) { - int c = s->base_string.self[i]; + int c = ecl_char(s, i); if (escape) { if (c == '|' || c == '\\') { write_ch('\\', stream); diff --git a/src/c/read.d b/src/c/read.d index 8f8e20d57..d3475ffca 100644 --- a/src/c/read.d +++ b/src/c/read.d @@ -32,13 +32,23 @@ #undef _complex -#define cat(rtbl,c) ((rtbl)->readtable.table[c].syntax_type) +static cl_object dispatch_macro_character(cl_object table, cl_object strm, int c); + #define read_suppress (ecl_symbol_value(@'*read-suppress*') != Cnil) -static struct ecl_readtable_entry* -read_table_entry(cl_object rdtbl, cl_object c); - -/* FIXME! *READ-EVAL* is not taken into account */ +#ifdef ECL_UNICODE +# define TOKEN_STRING_DIM(s) ((s)->string.dim) +# define TOKEN_STRING_FILLP(s) ((s)->string.fillp) +# define TOKEN_STRING_CHAR(s,n) CHAR_CODE((s)->string.self[n]) +# define TOKEN_STRING_CHAR_SET(s,n,c) (s)->string.self[n]=CODE_CHAR(c) +# define TOKEN_STRING_CHAR_CMP(s,n,c) ((s)->string.self[n]==CODE_CHAR(c)) +#else +# define TOKEN_STRING_DIM(s) ((s)->base_string.dim) +# define TOKEN_STRING_FILLP(s) ((s)->base_string.fillp) +# define TOKEN_STRING_CHAR(s,n) ((s)->base_string.self[n]) +# define TOKEN_STRING_CHAR_SET(s,n,c) ((s)->base_string.self[n]=(c)) +# define TOKEN_STRING_CHAR_CMP(s,n,c) ((s)->base_string.self[n]==(c)) +#endif cl_object si_get_buffer_string() @@ -47,12 +57,16 @@ si_get_buffer_string() cl_object pool = env->string_pool; cl_object output; if (pool == Cnil) { +#ifdef ECL_UNICODE + output = ecl_alloc_adjustable_extended_string(ECL_BUFFER_STRING_SIZE); +#else output = cl_alloc_adjustable_base_string(ECL_BUFFER_STRING_SIZE); +#endif } else { output = CAR(pool); env->string_pool = CDR(pool); } - output->base_string.fillp = 0; + TOKEN_STRING_FILLP(output) = 0; @(return output) } @@ -65,14 +79,18 @@ si_put_buffer_string(cl_object string) cl_index l = 0; if (pool != Cnil) { /* We store the size of the pool in the string index */ - l = CAR(pool)->base_string.fillp; + l = TOKEN_STRING_FILLP(ECL_CONS_CAR(pool)); } if (l < ECL_MAX_STRING_POOL_SIZE) { - if (string->base_string.dim > ECL_BUFFER_STRING_SIZE) { + if (TOKEN_STRING_DIM(string) > ECL_BUFFER_STRING_SIZE) { /* String has been enlarged. Cut it. */ +#ifdef ECL_UNICODE + string = ecl_alloc_adjustable_extended_string(ECL_BUFFER_STRING_SIZE); +#else string = cl_alloc_adjustable_base_string(ECL_BUFFER_STRING_SIZE); +#endif } - string->base_string.fillp = l+1; + TOKEN_STRING_FILLP(string) = l+1; env->string_pool = CONS(string, pool); } } @@ -110,7 +128,7 @@ invert_buffer_case(cl_object x, cl_object escape_list, int sign) { cl_fixnum high_limit, low_limit; cl_object escape_interval; - cl_fixnum i = x->base_string.fillp; + cl_fixnum i = TOKEN_STRING_FILLP(x); do { if (escape_list != Cnil) { cl_object escape_interval = CAR(escape_list); @@ -122,13 +140,13 @@ invert_buffer_case(cl_object x, cl_object escape_list, int sign) } for (; i > high_limit; i--) { /* The character is not escaped */ - char c = x->base_string.self[i]; + int c = TOKEN_STRING_CHAR(x,i); if (isupper(c) && (sign < 0)) { c = tolower(c); } else if (islower(c) && (sign > 0)) { c = toupper(c); } - x->base_string.self[i] = c; + TOKEN_STRING_CHAR_SET(x,i,c); } for (; i > low_limit; i--) { /* The character is within an escaped interval */ @@ -163,11 +181,15 @@ BEGIN: return OBJNULL; if (c == EOF) FEend_of_file(in); - a = cat(rtbl, c); + a = ecl_readtable_get(rtbl, c, &x); } while (a == cat_whitespace); if ((a == cat_terminating || a == cat_non_terminating) && !only_token) { - cl_object x = rtbl->readtable.table[c].macro; - cl_object o = funcall(3, x, in, CODE_CHAR(c)); + cl_object o; + if (type_of(x) == t_hashtable) { + o = dispatch_macro_character(x, in, c); + } else { + o = funcall(3, x, in, CODE_CHAR(c)); + } if (NVALUES == 0) goto BEGIN; if (NVALUES > 1) FEerror("The readmacro ~S returned ~D values.", 2, x, MAKE_FIXNUM(i)); @@ -190,7 +212,7 @@ LOOP: } } else if (colon) { external_symbol = (colon == 1); - token->base_string.self[length] = '\0'; + TOKEN_STRING_CHAR_SET(token,length,'\0'); /* If the readtable case was :INVERT and all non-escaped characters * had the same case, we revert their case. */ if (read_case == ecl_case_invert) { @@ -212,7 +234,7 @@ LOOP: allow it, but later on in read_VV we make sure that all referenced packages have been properly built. */ - cl_object name = si_copy_to_simple_base_string(token); + cl_object name = cl_copy_seq(token); if (cl_core.packages_to_be_created == OBJNULL) { FEerror("There is no package with the name ~A.", 1, name); @@ -225,7 +247,7 @@ LOOP: cl_acons(name, p, cl_core.packages_to_be_created); } } - token->base_string.fillp = length = 0; + TOKEN_STRING_FILLP(token) = length = 0; upcase = count = colon = 0; escape_list = Cnil; } @@ -247,7 +269,7 @@ LOOP: cl_index begin = length; for (;;) { c = ecl_read_char_noeof(in); - a = cat(rtbl, c); + a = ecl_readtable_get(rtbl, c, NULL); if (a == cat_single_escape) { c = ecl_read_char_noeof(in); a = cat_constituent; @@ -291,7 +313,7 @@ LOOP: c = ecl_read_char(in); if (c == EOF) break; - a = cat(rtbl, c); + a = ecl_readtable_get(rtbl, c, NULL); } if (suppress) { @@ -304,12 +326,12 @@ LOOP: goto SYMBOL; /* The case in which the buffer is full of dots has to be especial cased */ - if (length == 1 && token->base_string.self[0] == '.') { + if (length == 1 && TOKEN_STRING_CHAR_CMP(token,0,'.')) { x = @'si::.'; goto OUTPUT; } else { for (i = 0; i < length; i++) - if (token->base_string.self[i] != '.') + if (!TOKEN_STRING_CHAR_CMP(token,i,'.')) goto MAYBE_NUMBER; FEreader_error("Dots appeared illegally.", in, 0); } @@ -317,16 +339,16 @@ LOOP: MAYBE_NUMBER: /* Here we try to parse a number from the content of the buffer */ base = ecl_current_read_base(); - if ((base <= 10) && isalpha(token->base_string.self[0])) + if ((base <= 10) && isalpha(TOKEN_STRING_CHAR(token,0))) goto SYMBOL; - x = ecl_parse_number(token, 0, token->base_string.fillp, &i, base); + x = ecl_parse_number(token, 0, TOKEN_STRING_FILLP(token), &i, base); if (x == Cnil) FEreader_error("Syntax error when reading number.~%Offending string: ~S.", in, 1, token); if (x != OBJNULL && length == i) goto OUTPUT; SYMBOL: - token->base_string.self[length] = '\0'; + /*TOKEN_STRING_CHAR_SET(token,length,'\0');*/ /* If the readtable case was :INVERT and all non-escaped characters * had the same case, we revert their case. */ if (read_case == ecl_case_invert) { @@ -342,7 +364,7 @@ LOOP: x = ecl_find_symbol(token, p, &intern_flag); if (intern_flag != EXTERNAL) { FEerror("Cannot find the external symbol ~A in ~S.", - 2, si_copy_to_simple_base_string(token), p); + 2, cl_copy_seq(token), p); } } else { if (p == Cnil) { @@ -635,7 +657,7 @@ read_constituent(cl_object in) if (c == EOF) { break; } - c_cat = cat(rtbl, c); + c_cat = ecl_readtable_get(rtbl, c, NULL); if (c_cat == cat_constituent || ((c_cat == cat_non_terminating) && not_first)) { @@ -662,11 +684,16 @@ double_quote_reader(cl_object in, cl_object c) int c = ecl_read_char_noeof(in); if (c == delim) break; - else if (cat(rtbl, c) == cat_single_escape) + else if (ecl_readtable_get(rtbl, c, NULL) == cat_single_escape) c = ecl_read_char_noeof(in); ecl_string_push_extend(token, c); } - output = si_copy_to_simple_base_string(token); +#ifdef ECL_UNICODE + if (ecl_fits_in_base_string(token)) + output = si_coerce_to_base_string(token); + else +#endif + output = cl_copy_seq(token); si_put_buffer_string(token); @(return output) } @@ -674,29 +701,44 @@ double_quote_reader(cl_object in, cl_object c) static cl_object dispatch_reader_fun(cl_object in, cl_object dc) { - cl_object x, y; - cl_fixnum i; - int d, c; - cl_object rtbl = ecl_current_readtable(); - - if (rtbl->readtable.table[ecl_char_code(dc)].dispatch_table == NULL) - FEreader_error("~C is not a dispatching macro character", in, 1, dc); + cl_object readtable = ecl_current_readtable(); + cl_object dispatch_table; + int c = ecl_char_code(dc); + ecl_readtable_get(readtable, c, &dispatch_table); + if (type_of(dispatch_table) != t_hashtable) + FEreader_error("~C is not a dispatching macro character", + in, 1, dc); + return dispatch_macro_character(dispatch_table, in, c); +} +static cl_object +dispatch_macro_character(cl_object table, cl_object in, int c) +{ + cl_object arg; + int d; c = ecl_read_char_noeof(in); d = ecl_digitp(c, 10); if (d >= 0) { - i = 0; + cl_fixnum i = 0; do { i = 10*i + d; c = ecl_read_char_noeof(in); d = ecl_digitp(c, 10); } while (d >= 0); - y = MAKE_FIXNUM(i); - } else - y = Cnil; - - x = rtbl->readtable.table[ecl_char_code(dc)].dispatch_table[c]; - return funcall(4, x, in, CODE_CHAR(c), y); + arg = MAKE_FIXNUM(i); + } else { + arg = Cnil; + } + { + cl_object dc = CODE_CHAR(c); + cl_object fun = ecl_gethash_safe(dc, table, Cnil); + if (Null(fun)) { + FEreader_error("No dispatch function defined " + "for character ~S", + in, 1, dc); + } + return funcall(4, fun, in, dc, arg); + } } static cl_object @@ -779,11 +821,11 @@ sharp_backslash_reader(cl_object in, cl_object c, cl_object d) ecl_bds_unwind1(env); if (token == Cnil) { c = Cnil; - } else if (token->base_string.fillp == 1) { - c = CODE_CHAR(token->base_string.self[0]); - } else if (token->base_string.fillp == 2 && token->base_string.self[0] == '^') { + } else if (TOKEN_STRING_FILLP(token) == 1) { + c = CODE_CHAR(TOKEN_STRING_CHAR(token,0)); + } else if (TOKEN_STRING_FILLP(token) == 2 && TOKEN_STRING_CHAR_CMP(token,0,'^')) { /* #\^x */ - c = CODE_CHAR(token->base_string.self[1] & 037); + c = CODE_CHAR(TOKEN_STRING_CHAR(token,1) & 037); } else { cl_object nc = cl_name_char(token); if (Null(nc)) { @@ -947,7 +989,7 @@ sharp_asterisk_reader(cl_object in, cl_object c, cl_object d) int x = ecl_read_char(in); if (x == EOF) break; - a = cat(rtbl, x); + a = ecl_readtable_get(rtbl, x, NULL); if (a == cat_terminating || a == cat_whitespace) { ecl_unread_char(x, in); break; @@ -994,7 +1036,7 @@ sharp_colon_reader(cl_object in, cl_object ch, cl_object d) if (d != Cnil && !read_suppress) extra_argument(':', in, d); c = ecl_read_char_noeof(in); - a = cat(rtbl, c); + a = ecl_readtable_get(rtbl, c, NULL); escape_flag = FALSE; token = si_get_buffer_string(); goto L; @@ -1004,7 +1046,7 @@ sharp_colon_reader(cl_object in, cl_object ch, cl_object d) c = ecl_read_char(in); if (c == EOF) goto M; - a = cat(rtbl, c); + a = ecl_readtable_get(rtbl, c, NULL); L: if (a == cat_single_escape) { c = ecl_read_char_noeof(in); @@ -1014,7 +1056,7 @@ sharp_colon_reader(cl_object in, cl_object ch, cl_object d) escape_flag = TRUE; for (;;) { c = ecl_read_char_noeof(in); - a = cat(rtbl, c); + a = ecl_readtable_get(rtbl, c, NULL); if (a == cat_single_escape) { c = ecl_read_char_noeof(in); a = cat_constituent; @@ -1065,8 +1107,8 @@ read_number(cl_object in, int radix, cl_object macro_char) if (token == Cnil) { x = Cnil; } else { - x = ecl_parse_number(token, 0, token->base_string.fillp, &i, radix); - if (x == OBJNULL || x == Cnil || i != token->base_string.fillp) { + x = ecl_parse_number(token, 0, TOKEN_STRING_FILLP(token), &i, radix); + if (x == OBJNULL || x == Cnil || i != TOKEN_STRING_FILLP(token)) { FEreader_error("Cannot parse the #~A readmacro.", in, 1, macro_char); } @@ -1318,41 +1360,43 @@ sharp_dollar_reader(cl_object in, cl_object c, cl_object d) cl_object ecl_copy_readtable(cl_object from, cl_object to) { - struct ecl_readtable_entry *rtab; + struct ecl_readtable_entry *from_rtab, *to_rtab; cl_index i; size_t entry_bytes = sizeof(struct ecl_readtable_entry); size_t total_bytes = entry_bytes * RTABSIZE; + cl_object output; - /* Copy also the case for reading */ - if (Null(to)) { - to = ecl_alloc_object(t_readtable); - to->readtable.table = NULL; - /* Saving for GC. */ - to->readtable.table = (struct ecl_readtable_entry *)ecl_alloc_align(total_bytes, entry_bytes); -/* - for (i = 0; i < RTABSIZE; i++) - rtab[i] = from->readtable.table[i]; -*/ - /* structure assignment */ - } - rtab=to->readtable.table; - memcpy(rtab, from->readtable.table, total_bytes); - to->readtable.read_case = from->readtable.read_case; - + assert_type_readtable(from); + /* For the sake of garbage collector and thread safety we + * create an incomplete object and only copy to the destination + * at the end in a more or less "atomic" (meaning "fast") way. + */ + output = ecl_alloc_object(t_readtable); + output->readtable.table = to_rtab = (struct ecl_readtable_entry *) + ecl_alloc_align(total_bytes, entry_bytes); + from_rtab = from->readtable.table; + memcpy(to_rtab, from_rtab, total_bytes); for (i = 0; i < RTABSIZE; i++) { - if (from->readtable.table[i].dispatch_table != NULL) { - rtab[i].dispatch_table - = (cl_object *)ecl_alloc_align(RTABSIZE * sizeof(cl_object), sizeof(cl_object)); - memcpy(rtab[i].dispatch_table, from->readtable.table[i].dispatch_table, - RTABSIZE * sizeof(cl_object *)); -/* - for (j = 0; j < RTABSIZE; j++) - rtab[i].dispatch_table[j] - = from->readtable.table[i].dispatch_table[j]; -*/ + cl_object d = from_rtab[i].dispatch; + if (type_of(d) == t_hashtable) { + d = si_copy_hash_table(d); } + to_rtab[i].dispatch = d; } - return(to); + output->readtable.read_case = from->readtable.read_case; +#ifdef ECL_UNICODE + if (!Null(from->readtable.hash)) { + output->readtable.hash = si_copy_hash_table(from->readtable.hash); + } else { + output->readtable.hash = Cnil; + } +#endif + if (!Null(to)) { + assert_type_readtable(to); + to->readtable = output->readtable; + output = to; + } + return output; } cl_object @@ -1442,7 +1486,7 @@ stream_or_default_input(cl_object stream) if (Null(recursivep)) { cl_object rtbl = ecl_current_readtable(); int c = ecl_read_char(strm); - if (c != EOF && (cat(rtbl, c) != cat_whitespace)) { + if (c != EOF && (ecl_readtable_get(rtbl, c, NULL) != cat_whitespace)) { ecl_unread_char(c, strm); } } @@ -1548,21 +1592,21 @@ do_read_delimited_list(int d, cl_object in, bool proper_list) break; ecl_string_push_extend(token, c); } while(1); - if (c == EOF && token->base_string.fillp == 0) { + if (c == EOF && TOKEN_STRING_FILLP(token) == 0) { if (!Null(eof_errorp)) FEend_of_file(strm); value0 = eof_value; value1 = Ct; } else { #ifdef ECL_NEWLINE_IS_CRLF /* From \r\n, ignore \r */ - if (token->base_string.fillp > 0 && - token->base_string.self[token->base_string.fillp-1] == '\r') - token->base_string.fillp--; + if (TOKEN_STRING_FILLP(token) > 0 && + TOKEN_STRING_CHAR_CMP(token,TOKEN_STRING_FILLP(token)-1,'\r')) + TOKEN_STRING_FILLP(token)--; #endif #ifdef ECL_NEWLINE_IS_LFCR /* From \n\r, ignore \r */ ecl_read_char(strm); #endif - value0 = si_copy_to_simple_base_string(token); + value0 = cl_copy_seq(token); value1 = (c == EOF? Ct : Cnil); } si_put_buffer_string(token); @@ -1602,7 +1646,7 @@ do_read_delimited_list(int d, cl_object in, bool proper_list) if (peek_type == Ct) { do { /* If the character is not a whitespace, output */ - if (cat(rtbl, c) != cat_whitespace) + if (ecl_readtable_get(rtbl, c, NULL) != cat_whitespace) break; /* Otherwise, read the whitespace and peek the * next character */ @@ -1687,8 +1731,7 @@ do_read_delimited_list(int d, cl_object in, bool proper_list) fix(radix) < 2 || fix(radix) > 36) FEerror("~S is an illegal radix.", 1, radix); while (s < e && - read_table_entry(rtbl, cl_char(strng, MAKE_FIXNUM(s)))->syntax_type - == cat_whitespace) { + ecl_readtable_get(rtbl, ecl_char(strng, s), NULL) == cat_whitespace) { s++; } if (s >= e) { @@ -1709,8 +1752,7 @@ do_read_delimited_list(int d, cl_object in, bool proper_list) @(return x MAKE_FIXNUM(ep)); } for (s = ep; s < e; s++) { - if (read_table_entry(rtbl, cl_char(strng, MAKE_FIXNUM(s)))->syntax_type - != cat_whitespace) { + if (ecl_readtable_get(rtbl, ecl_char(strng, s), NULL) != cat_whitespace) { CANNOT_PARSE: FEparse_error("Cannot parse an integer in the string ~S.", Cnil, 1, strng); } @@ -1745,19 +1787,11 @@ CANNOT_PARSE: FEparse_error("Cannot parse an integer in the string ~S.", @(defun copy_readtable (&o (from ecl_current_readtable()) to) @ if (Null(from)) { - from = cl_core.standard_readtable; - if (to != Cnil) - assert_type_readtable(to); + to = ecl_copy_readtable(cl_core.standard_readtable, to); + } else { to = ecl_copy_readtable(from, to); - to->readtable.table['#'].dispatch_table['!'] - = cl_core.default_dispatch_macro; - /* We must forget #! macro. */ - @(return to) } - assert_type_readtable(from); - if (to != Cnil) - assert_type_readtable(to); - @(return ecl_copy_readtable(from, to)) + @(return to) @) cl_object @@ -1804,21 +1838,55 @@ cl_readtablep(cl_object readtable) static struct ecl_readtable_entry default_readtable_entry; #endif -static struct ecl_readtable_entry* -read_table_entry(cl_object rdtbl, cl_object c) +int +ecl_readtable_get(cl_object readtable, int c, cl_object *macro_or_table) { - /* INV: ecl_char_code() checks the type of `c' */ - cl_index code = ecl_char_code(c); - assert_type_readtable(rdtbl); + cl_object m; + enum ecl_chattrib cat; #ifdef ECL_UNICODE - if (!BASE_CHAR_CODE_P(code)) { - default_readtable_entry.syntax_type = cat_constituent; - default_readtable_entry.macro = Cnil; - default_readtable_entry.dispatch_table = NULL; - return &default_readtable_entry; - } + if (c >= RTABSIZE) { + cl_object hash = readtable->readtable.hash; + cat = cat_constituent; + m = Cnil; + if (!Null(hash)) { + cl_object pair = ecl_gethash_safe(CODE_CHAR(c), hash, Cnil); + if (!Null(pair)) { + cat = fix(ECL_CONS_CAR(pair)); + m = ECL_CONS_CDR(pair); + } + } + } else #endif - return &(rdtbl->readtable.table[code]); + { + m = readtable->readtable.table[c].dispatch; + cat = readtable->readtable.table[c].syntax_type; + } + if (macro_or_table) *macro_or_table = m; + return cat; +} + +void +ecl_readtable_set(cl_object readtable, int c, enum ecl_chattrib cat, + cl_object macro_or_table) +{ +#ifdef ECL_UNICODE + if (c >= RTABSIZE) { + cl_object hash = readtable->readtable.hash; + if (Null(hash)) { + hash = cl__make_hash_table(@'eql', MAKE_FIXNUM(128), + ecl_make_singlefloat(1.5f), + ecl_make_singlefloat(0.5f), + Ct); + readtable->readtable.hash = hash; + } + ecl_sethash(CODE_CHAR(c), hash, + CONS(MAKE_FIXNUM(cat), macro_or_table)); + } else +#endif + { + readtable->readtable.table[c].dispatch = macro_or_table; + readtable->readtable.table[c].syntax_type = cat; + } } bool @@ -1830,107 +1898,115 @@ ecl_invalid_character_p(int c) @(defun set_syntax_from_char (tochr fromchr &o (tordtbl ecl_current_readtable()) fromrdtbl) - struct ecl_readtable_entry*torte, *fromrte; + enum ecl_chattrib cat; + cl_object dispatch; + cl_fixnum fc, tc; @ - /* INV: read_table_entry() checks all values */ if (Null(fromrdtbl)) fromrdtbl = cl_core.standard_readtable; - /* INV: ecl_char_code() checks the types of `tochar',`fromchar' */ - torte = read_table_entry(tordtbl, tochr); - fromrte = read_table_entry(fromrdtbl, fromchr); - torte->syntax_type = fromrte->syntax_type; - torte->macro = fromrte->macro; - if ((torte->dispatch_table = fromrte->dispatch_table) != NULL) { - size_t rtab_size = RTABSIZE * sizeof(cl_object); - torte->dispatch_table = (cl_object *)ecl_alloc(rtab_size); - memcpy(torte->dispatch_table, fromrte->dispatch_table, rtab_size); + assert_type_readtable(fromrdtbl); + assert_type_readtable(tordtbl); + fc = ecl_char_code(fromchr); + tc = ecl_char_code(tochr); + + cat = ecl_readtable_get(fromrdtbl, fc, &dispatch); + if (type_of(dispatch) == t_hashtable) { + dispatch = si_copy_hash_table(dispatch); } + ecl_readtable_set(tordtbl, tc, cat, dispatch); @(return Ct) @) -@(defun set_macro_character (chr fnc - &optional ntp - (rdtbl ecl_current_readtable())) - struct ecl_readtable_entry*entry; +@(defun set_macro_character (c function &optional non_terminating_p + (readtable ecl_current_readtable())) @ - /* INV: read_table_entry() checks our arguments */ - entry = read_table_entry(rdtbl, chr); - if (ntp != Cnil) - entry->syntax_type = cat_non_terminating; - else - entry->syntax_type = cat_terminating; - entry->macro = fnc; + ecl_readtable_set(readtable, ecl_char_code(c), + Null(non_terminating_p)? + cat_non_terminating : + cat_terminating, + function); @(return Ct) @) -@(defun get_macro_character (chr &o (rdtbl ecl_current_readtable())) - struct ecl_readtable_entry*entry; - cl_object m; +@(defun get_macro_character (c &optional readtable) + enum ecl_chattrib cat; + cl_object dispatch, non_terminating_p; @ - - /* fix to allow NIL as readtable argument. Beppe */ - if (Null(rdtbl)) - rdtbl = cl_core.standard_readtable; - /* INV: read_table_entry() checks our arguments */ - entry = read_table_entry(rdtbl, chr); - m = entry->macro; - if (m == OBJNULL) - @(return Cnil Cnil) - @(return m ((entry->syntax_type == cat_non_terminating)? Ct : Cnil)) + if (Null(readtable)) + readtable = cl_core.standard_readtable; + cat = ecl_readtable_get(readtable, ecl_char_code(c), &dispatch); + if (type_of(dispatch) == t_hashtable) + dispatch = cl_core.dispatch_reader; + @(return dispatch ((cat == cat_non_terminating)? Ct : Cnil)) @) @(defun make_dispatch_macro_character (chr - &optional ntp (rdtbl ecl_current_readtable())) - struct ecl_readtable_entry*entry; - cl_object *table; - int i; + &optional non_terminating_p (readtable ecl_current_readtable())) + enum ecl_chattrib cat; + cl_object table; + int i, c; @ - /* INV: read_table_entry() checks our arguments */ - entry = read_table_entry(rdtbl, chr); - if (ntp != Cnil) - entry->syntax_type = cat_non_terminating; - else - entry->syntax_type = cat_terminating; - table = (cl_object *)ecl_alloc(RTABSIZE * sizeof(cl_object)); - entry->dispatch_table = table; - for (i = 0; i < RTABSIZE; i++) - table[i] = cl_core.default_dispatch_macro; - entry->macro = cl_core.dispatch_reader; + assert_type_readtable(readtable); + c = ecl_char_code(chr); + cat = Null(non_terminating_p)? cat_non_terminating : cat_terminating; + table = cl__make_hash_table(@'eql', MAKE_FIXNUM(128), + ecl_make_singlefloat(1.5f), + ecl_make_singlefloat(0.5f), + Ct); + ecl_readtable_set(readtable, c, cat, table); @(return Ct) @) @(defun set_dispatch_macro_character (dspchr subchr fnc - &optional (rdtbl ecl_current_readtable())) - struct ecl_readtable_entry*entry; + &optional (readtable ecl_current_readtable())) + cl_object table; cl_fixnum subcode; @ - entry = read_table_entry(rdtbl, dspchr); - if (entry->macro != cl_core.dispatch_reader || entry->dispatch_table == NULL) + assert_type_readtable(readtable); + ecl_readtable_get(readtable, ecl_char_code(dspchr), &table); + if (type_of(table) != t_hashtable) { FEerror("~S is not a dispatch character.", 1, dspchr); + } subcode = ecl_char_code(subchr); - entry->dispatch_table[subcode] = fnc; + if (Null(fnc)) { + ecl_remhash(CODE_CHAR(subcode), table); + } else { + ecl_sethash(CODE_CHAR(subcode), table, fnc); + } if (islower(subcode)) { - entry->dispatch_table[toupper(subcode)] = fnc; + subcode = toupper(subcode); } else if (isupper(subcode)) { - entry->dispatch_table[tolower(subcode)] = fnc; + subcode = tolower(subcode); + } + if (Null(fnc)) { + ecl_remhash(CODE_CHAR(subcode), table); + } else { + ecl_sethash(CODE_CHAR(subcode), table, fnc); } @(return Ct) @) @(defun get_dispatch_macro_character (dspchr subchr - &optional (rdtbl ecl_current_readtable())) - struct ecl_readtable_entry*entry; - cl_fixnum subcode; + &optional (readtable ecl_current_readtable())) + cl_object table; + cl_fixnum c; @ - if (Null(rdtbl)) - rdtbl = cl_core.standard_readtable; - entry = read_table_entry(rdtbl, dspchr); - if (entry->macro != cl_core.dispatch_reader || entry->dispatch_table == NULL) + if (Null(readtable)) { + readtable = cl_core.standard_readtable; + } + assert_type_readtable(readtable); + c = ecl_char_code(dspchr); + ecl_readtable_get(readtable, c, &table); + if (type_of(table) != t_hashtable) { FEerror("~S is not a dispatch character.", 1, dspchr); - subcode = ecl_char_code(subchr); - if (ecl_digitp(subcode, 10) >= 0) + } + c = ecl_char_code(subchr); + + /* Since macro characters may take a number as argument, it is + not allowed to turn digits into dispatch macro characters */ + if (ecl_digitp(c, 10) >= 0) @(return Cnil) - @(return entry->dispatch_table[subcode]) + @(return ecl_gethash_safe(subchr, table, Cnil)) @) cl_object @@ -1946,7 +2022,7 @@ si_string_to_object(cl_object x) /* FIXME! Restricted to base string */ x = ecl_check_cl_type(@'si::string-to-object', x, t_base_string); - in = ecl_make_string_input_stream(x, 0, x->base_string.fillp); + in = ecl_make_string_input_stream(x, 0, TOKEN_STRING_FILLP(x)); x = ecl_read_object(in); if (x == OBJNULL) FEend_of_file(in); @@ -1974,101 +2050,107 @@ void init_read(void) { struct ecl_readtable_entry *rtab; - cl_object readtable; - cl_object *dtab; + cl_object r; int i; - cl_core.standard_readtable = ecl_alloc_object(t_readtable); + cl_core.standard_readtable = r = ecl_alloc_object(t_readtable); cl_core.standard_readtable->readtable.read_case = ecl_case_upcase; cl_core.standard_readtable->readtable.table = rtab - = (struct ecl_readtable_entry *)ecl_alloc(RTABSIZE * sizeof(struct ecl_readtable_entry)); + = (struct ecl_readtable_entry *) + ecl_alloc(RTABSIZE * sizeof(struct ecl_readtable_entry)); for (i = 0; i < RTABSIZE; i++) { rtab[i].syntax_type = cat_constituent; - rtab[i].macro = OBJNULL; - rtab[i].dispatch_table = NULL; + rtab[i].dispatch = Cnil; } +#ifdef ECL_UNICODE + cl_core.standard_readtable->readtable.hash = Cnil; +#endif cl_core.dispatch_reader = make_cf2(dispatch_reader_fun); - rtab['\t'].syntax_type = cat_whitespace; - rtab['\n'].syntax_type = cat_whitespace; - rtab['\f'].syntax_type = cat_whitespace; - rtab['\r'].syntax_type = cat_whitespace; - rtab[' '].syntax_type = cat_whitespace; - rtab['"'].syntax_type = cat_terminating; - rtab['"'].macro = make_cf2(double_quote_reader); - rtab['#'].syntax_type = cat_non_terminating; - rtab['#'].macro = cl_core.dispatch_reader; - rtab['\''].syntax_type = cat_terminating; - rtab['\''].macro = make_cf2(single_quote_reader); - rtab['('].syntax_type = cat_terminating; - rtab['('].macro = make_cf2(left_parenthesis_reader); - rtab[')'].syntax_type = cat_terminating; - rtab[')'].macro = make_cf2(right_parenthesis_reader); - rtab[','].syntax_type = cat_terminating; - rtab[','].macro = make_cf2(comma_reader); - rtab[';'].syntax_type = cat_terminating; - rtab[';'].macro = make_cf2(semicolon_reader); - rtab['\\'].syntax_type = cat_single_escape; - rtab['`'].syntax_type = cat_terminating; - rtab['`'].macro = make_cf2(backquote_reader); - rtab['|'].syntax_type = cat_multiple_escape; -/* - rtab['|'].macro = make_cf2(vertical_bar_reader); -*/ + ecl_readtable_set(r, '\t', cat_whitespace, Cnil); + ecl_readtable_set(r, '\n', cat_whitespace, Cnil); + ecl_readtable_set(r, '\f', cat_whitespace, Cnil); + ecl_readtable_set(r, '\r', cat_whitespace, Cnil); + ecl_readtable_set(r, ' ', cat_whitespace, Cnil); + + ecl_readtable_set(r, '"', cat_terminating, + make_cf2(double_quote_reader)); + + ecl_readtable_set(r, '\'', cat_terminating, + make_cf2(single_quote_reader)); + ecl_readtable_set(r, '(', cat_terminating, + make_cf2(left_parenthesis_reader)); + ecl_readtable_set(r, ')', cat_terminating, + make_cf2(right_parenthesis_reader)); + ecl_readtable_set(r, ',', cat_terminating, + make_cf2(comma_reader)); + ecl_readtable_set(r, ';', cat_terminating, + make_cf2(semicolon_reader)); + ecl_readtable_set(r, '\\', cat_single_escape, Cnil); + ecl_readtable_set(r, '`', cat_terminating, + make_cf2(backquote_reader)); + ecl_readtable_set(r, '|', cat_multiple_escape, Cnil); cl_core.default_dispatch_macro = make_cf3(default_dispatch_macro_fun); - rtab['#'].dispatch_table - = dtab - = (cl_object *)ecl_alloc(RTABSIZE * sizeof(cl_object)); - for (i = 0; i < RTABSIZE; i++) - dtab[i] = cl_core.default_dispatch_macro; - dtab['C'] = dtab['c'] = make_cf3(sharp_C_reader); - dtab['\\'] = make_cf3(sharp_backslash_reader); - dtab['\''] = make_cf3(sharp_single_quote_reader); - dtab['('] = make_cf3(sharp_left_parenthesis_reader); - dtab['*'] = make_cf3(sharp_asterisk_reader); - dtab[':'] = make_cf3(sharp_colon_reader); - dtab['.'] = make_cf3(sharp_dot_reader); - /* Used for fasload only. */ - dtab['B'] = dtab['b'] = make_cf3(sharp_B_reader); - dtab['O'] = dtab['o'] = make_cf3(sharp_O_reader); - dtab['X'] = dtab['x'] = make_cf3(sharp_X_reader); - dtab['R'] = dtab['r'] = make_cf3(sharp_R_reader); -/* - dtab['A'] = dtab['a'] = make_cf3(sharp_A_reader); - dtab['S'] = dtab['s'] = make_cf3(sharp_S_reader); -*/ - dtab['A'] = dtab['a'] = @'si::sharp-a-reader'; - dtab['S'] = dtab['s'] = @'si::sharp-s-reader'; - dtab['P'] = dtab['p'] = make_cf3(sharp_P_reader); + cl_make_dispatch_macro_character(3, CODE_CHAR('#'), + Ct /* terminating */, r); - dtab['='] = make_cf3(sharp_eq_reader); - dtab['#'] = make_cf3(sharp_sharp_reader); - dtab['+'] = make_cf3(sharp_plus_reader); - dtab['-'] = make_cf3(sharp_minus_reader); -/* - dtab['<'] = make_cf3(sharp_less_than_reader); -*/ - dtab['|'] = make_cf3(sharp_vertical_bar_reader); + cl_set_dispatch_macro_character(4, CODE_CHAR('#'), CODE_CHAR('C'), + make_cf3(sharp_C_reader), r); + cl_set_dispatch_macro_character(4, CODE_CHAR('#'), CODE_CHAR('\\'), + make_cf3(sharp_backslash_reader), r); + cl_set_dispatch_macro_character(4, CODE_CHAR('#'), CODE_CHAR('\''), + make_cf3(sharp_single_quote_reader), r); + cl_set_dispatch_macro_character(4, CODE_CHAR('#'), CODE_CHAR('('), + make_cf3(sharp_left_parenthesis_reader), r); + cl_set_dispatch_macro_character(4, CODE_CHAR('#'), CODE_CHAR('*'), + make_cf3(sharp_asterisk_reader), r); + cl_set_dispatch_macro_character(4, CODE_CHAR('#'), CODE_CHAR(':'), + make_cf3(sharp_colon_reader), r); + cl_set_dispatch_macro_character(4, CODE_CHAR('#'), CODE_CHAR('.'), + make_cf3(sharp_dot_reader), r); + /* Used for fasload only. */ + cl_set_dispatch_macro_character(4, CODE_CHAR('#'), CODE_CHAR('B'), + make_cf3(sharp_B_reader), r); + cl_set_dispatch_macro_character(4, CODE_CHAR('#'), CODE_CHAR('O'), + make_cf3(sharp_O_reader), r); + cl_set_dispatch_macro_character(4, CODE_CHAR('#'), CODE_CHAR('X'), + make_cf3(sharp_X_reader), r); + cl_set_dispatch_macro_character(4, CODE_CHAR('#'), CODE_CHAR('R'), + make_cf3(sharp_R_reader), r); + cl_set_dispatch_macro_character(4, CODE_CHAR('#'), CODE_CHAR('A'), + @'si::sharp-a-reader', r); + cl_set_dispatch_macro_character(4, CODE_CHAR('#'), CODE_CHAR('S'), + @'si::sharp-s-reader', r); + cl_set_dispatch_macro_character(4, CODE_CHAR('#'), CODE_CHAR('P'), + make_cf3(sharp_P_reader), r); + + cl_set_dispatch_macro_character(4, CODE_CHAR('#'), CODE_CHAR('='), + make_cf3(sharp_eq_reader), r); + cl_set_dispatch_macro_character(4, CODE_CHAR('#'), CODE_CHAR('#'), + make_cf3(sharp_sharp_reader), r); + cl_set_dispatch_macro_character(4, CODE_CHAR('#'), CODE_CHAR('+'), + make_cf3(sharp_plus_reader), r); + cl_set_dispatch_macro_character(4, CODE_CHAR('#'), CODE_CHAR('-'), + make_cf3(sharp_minus_reader), r); + cl_set_dispatch_macro_character(4, CODE_CHAR('#'), CODE_CHAR('|'), + make_cf3(sharp_vertical_bar_reader), r); /* This is specific to this implementation */ - dtab['$'] = make_cf3(sharp_dollar_reader); + cl_set_dispatch_macro_character(4, CODE_CHAR('#'), CODE_CHAR('$'), + make_cf3(sharp_dollar_reader), r); /* This is specific to this implimentation */ -/* - dtab[' '] = dtab['\t'] = dtab['\n'] = dtab['\f'] - = make_cf3(sharp_whitespace_reader); - dtab[')'] = make_cf3(sharp_right_parenthesis_reader); -*/ - dtab['Y'] = dtab['y'] = make_cf3(sharp_Y_reader); + cl_set_dispatch_macro_character(4, CODE_CHAR('#'), CODE_CHAR('Y'), + make_cf3(sharp_Y_reader), r); init_backq(); ECL_SET(@'*readtable*', - readtable=ecl_copy_readtable(cl_core.standard_readtable, Cnil)); - readtable->readtable.table['#'].dispatch_table['!'] - = cl_core.default_dispatch_macro; /* We must forget #! macro. */ + r=ecl_copy_readtable(cl_core.standard_readtable, Cnil)); + cl_set_dispatch_macro_character(4, CODE_CHAR('#'), CODE_CHAR('!'), + Cnil, r); ECL_SET(@'*read-default-float-format*', @'single-float'); } @@ -2156,7 +2238,7 @@ read_VV(cl_object block, void (*entry_point)(cl_object)) FEreader_error("Not enough data while loading binary file", in, 0); NO_DATA_LABEL: for (i = 0; i < block->cblock.cfuns_size; i++) { - struct ecl_cfun *prototype = block->cblock.cfuns+i; + const struct ecl_cfun *prototype = block->cblock.cfuns+i; cl_index fname_location = fix(prototype->block); cl_object fname = VV[fname_location]; cl_index location = fix(prototype->name); diff --git a/src/c/string.d b/src/c/string.d index 7781f34d8..97aaf6f27 100644 --- a/src/c/string.d +++ b/src/c/string.d @@ -122,6 +122,18 @@ cl_alloc_adjustable_base_string(cl_index l) return output; } +#ifdef ECL_UNICODE +cl_object +ecl_alloc_adjustable_extended_string(cl_index l) +{ + cl_object output = cl_alloc_simple_extended_string(l); + output->base_string.fillp = 0; + output->base_string.hasfillp = TRUE; + output->base_string.adjustable = TRUE; + return output; +} +#endif + /* Make_simple_base_string(s) makes a simple-base string from C string s. */ diff --git a/src/cmp/cmpname.lsp b/src/cmp/cmpname.lsp index 5d03d7949..0f3d7f866 100644 --- a/src/cmp/cmpname.lsp +++ b/src/cmp/cmpname.lsp @@ -86,7 +86,7 @@ initialization function in object files have more or less unpredictable names, we store them in a string in the object file. This string is recognized by the TAG it has at the beginning This function searches that tag and retrieves the function name it precedes." - (with-open-file (stream file :direction :input) + (with-open-file (stream file :direction :input :external-format :latin-1) (cmpnote "Scanning ~S" file) (when (search-tag stream tag) (let ((name (read-name stream))) diff --git a/src/h/external.h b/src/h/external.h index a095f43d6..45b3c31b9 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -1279,6 +1279,8 @@ extern ECL_API cl_object cl_make_dispatch_macro_character _ARGS((cl_narg narg, c extern ECL_API cl_object cl_set_dispatch_macro_character _ARGS((cl_narg narg, cl_object dspchr, cl_object subchr, cl_object fnc, ...)); extern ECL_API cl_object cl_get_dispatch_macro_character _ARGS((cl_narg narg, cl_object dspchr, cl_object subchr, ...)); +extern ECL_API int ecl_readtable_get(cl_object rdtbl, int c, cl_object *macro); +extern ECL_API void ecl_readtable_set(cl_object rdtbl, int c, enum ecl_chattrib cat, cl_object macro_or_table); extern ECL_API cl_object ecl_read_object_non_recursive(cl_object in); extern ECL_API cl_object ecl_read_object(cl_object in); extern ECL_API cl_object ecl_parse_number(cl_object s, cl_index start, cl_index end, cl_index *ep, unsigned int radix); @@ -1593,6 +1595,7 @@ extern ECL_API cl_object si_base_string_p(cl_object x); extern ECL_API cl_object si_coerce_to_base_string(cl_object x); extern ECL_API cl_object si_coerce_to_extended_string(cl_object x); extern ECL_API cl_object cl_alloc_simple_extended_string(cl_index l); +extern ECL_API cl_object ecl_alloc_adjustable_extended_string(cl_index l); #else #define si_base_char_p cl_characterp #define si_base_string_p cl_stringp diff --git a/src/h/object.h b/src/h/object.h index 127d5d55d..333de757b 100644 --- a/src/h/object.h +++ b/src/h/object.h @@ -557,13 +557,7 @@ enum ecl_chattrib { /* character attribute */ struct ecl_readtable_entry { /* read table entry */ enum ecl_chattrib syntax_type; /* character attribute */ - cl_object macro; /* macro function */ - cl_object *dispatch_table; /* pointer to the */ - /* dispatch table */ - /* NULL for */ - /* non-dispatching */ - /* macro character, or */ - /* non-macro character */ + cl_object dispatch; /* a macro, a hash or NIL */ }; enum ecl_readtable_case { @@ -573,10 +567,13 @@ enum ecl_readtable_case { ecl_case_preserve, }; -struct ecl_readtable { /* read table */ +struct ecl_readtable { /* read table */ HEADER; enum ecl_readtable_case read_case; /* readtable-case */ struct ecl_readtable_entry *table; /* read table itself */ +#ifdef ECL_UNICODE + cl_object hash; /* hash for values outside base-char range */ +#endif }; struct ecl_pathname { From 0a286237d650da5a54e9499a3f6acf9ea8fd56b5 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sat, 25 Oct 2008 17:53:35 +0200 Subject: [PATCH 41/60] Add detection of out of memory conditions. --- src/CHANGELOG | 6 ++++++ src/c/alloc_2.d | 22 ++++++++++++++++++++++ src/c/file.d | 20 +++++++++++++++++++- src/c/main.d | 4 +++- src/c/symbols_list.h | 2 ++ src/c/symbols_list2.h | 2 ++ src/clos/conditions.lsp | 5 ++++- src/h/external.h | 4 ++++ 8 files changed, 62 insertions(+), 3 deletions(-) diff --git a/src/CHANGELOG b/src/CHANGELOG index acdd45653..5ff31f202 100644 --- a/src/CHANGELOG +++ b/src/CHANGELOG @@ -82,6 +82,10 @@ ECL 8.9.0: - Binary streams now can only read or write bytes whose size is a multiple of 8. + - ECL now has an implicit memory limit of 128Mb, which can be raised using + ecl_set_option(ECL_OPT_HEAP_SIZE, new_limit). Out of memory conditions are + detected and gracefully handled. + * Streams: - ECL has now a new and more easily extensible implementation of streams, based @@ -129,6 +133,8 @@ ECL 8.9.0: ECL_OPT_C_STACK_SIZE, ECL_OPT_C_STACK_SAFETY_AREA, ECL_OPT_SIGALTSTACK_SIZE, + ECL_OPT_HEAP_SIZE, + ECL_OPT_HEAP_SAFETY_AREA, ECL_OPT_LIMIT * Bugs fixed: diff --git a/src/c/alloc_2.d b/src/c/alloc_2.d index 0c8df6c58..f25b58801 100644 --- a/src/c/alloc_2.d +++ b/src/c/alloc_2.d @@ -37,6 +37,19 @@ static void finalize_queued(); * OBJECT ALLOCATION * **********************************************************/ +static void +out_of_memory() +{ + /* Free up some memory and try working with the condition */ + cl_env_ptr the_env = ecl_process_env(); + the_env->string_pool = Cnil; + cl_index new_size = ecl_get_option(ECL_OPT_HEAP_SIZE) + + ecl_get_option(ECL_OPT_HEAP_SAFETY_AREA); + ecl_set_option(ECL_OPT_HEAP_SIZE, new_size); + GC_set_max_heap_size(new_size); + cl_error(1, @'ext::storage-exhausted'); +} + #ifdef alloc_object #undef alloc_object #endif @@ -56,6 +69,7 @@ ecl_alloc_object(cl_type t) return CODE_CHAR(' '); /* Immediate character */ case t_codeblock: obj = (cl_object)GC_MALLOC(sizeof(struct ecl_codeblock)); + if (obj == NULL) out_of_memory(); obj->cblock.locked = 0; obj->cblock.links = Cnil; obj->cblock.name = Cnil; @@ -75,6 +89,7 @@ ecl_alloc_object(cl_type t) case t_singlefloat: case t_doublefloat: obj = (cl_object)GC_MALLOC_ATOMIC(type_size[t]); + if (obj == NULL) out_of_memory(); break; case t_bignum: case t_ratio: @@ -110,6 +125,7 @@ ecl_alloc_object(cl_type t) #endif case t_foreign: obj = (cl_object)GC_MALLOC(type_size[t]); + if (obj == NULL) out_of_memory(); break; default: printf("\ttype = %d\n", t); @@ -130,6 +146,7 @@ ecl_cons(cl_object a, cl_object d) ecl_disable_interrupts(); obj = GC_MALLOC(sizeof(struct ecl_cons)); ecl_enable_interrupts(); + if (obj == NULL) out_of_memory(); #ifdef ECL_SMALL_CONS obj->car = a; obj->cdr = d; @@ -149,6 +166,7 @@ ecl_list1(cl_object a) ecl_disable_interrupts(); obj = GC_MALLOC(sizeof(struct ecl_cons)); ecl_enable_interrupts(); + if (obj == NULL) out_of_memory(); #ifdef ECL_SMALL_CONS obj->car = a; obj->cdr = Cnil; @@ -178,6 +196,7 @@ ecl_alloc_uncollectable(size_t size) ecl_disable_interrupts(); output = GC_MALLOC_UNCOLLECTABLE(size); ecl_enable_interrupts(); + if (output == NULL) out_of_memory(); return output; } @@ -196,6 +215,7 @@ ecl_alloc(cl_index n) ecl_disable_interrupts(); output = GC_MALLOC_IGNORE_OFF_PAGE(n); ecl_enable_interrupts(); + if (output == NULL) out_of_memory(); return output; } @@ -206,6 +226,7 @@ ecl_alloc_atomic(cl_index n) ecl_disable_interrupts(); output = GC_MALLOC_ATOMIC_IGNORE_OFF_PAGE(n); ecl_enable_interrupts(); + if (output == NULL) out_of_memory(); return output; } @@ -254,6 +275,7 @@ init_alloc(void) #endif GC_clear_roots(); GC_disable(); + GC_set_max_heap_size(ecl_get_option(ECL_OPT_HEAP_SIZE)); #define init_tm(x,y,z) type_size[x] = (z) for (i = 0; i < t_end; i++) { diff --git a/src/c/file.d b/src/c/file.d index ea5458885..9e9badf55 100644 --- a/src/c/file.d +++ b/src/c/file.d @@ -496,6 +496,12 @@ ucs_4_write_char(cl_object strm, int c_orig) buffer[1] = c & 8; c >>= 8; buffer[0] = c; strm->stream.ops->write_byte8(strm, buffer, 4); + if (c_orig == '\n') + IO_STREAM_COLUMN(strm) = 0; + else if (c_orig == '\t') + IO_STREAM_COLUMN(strm) = (IO_STREAM_COLUMN(strm)&~07) + 8; + else + IO_STREAM_COLUMN(strm)++; return c_orig; } @@ -525,7 +531,13 @@ ucs_2_write_char(cl_object strm, int c_orig) buffer[1] = c & 8; c >>= 8; buffer[0] = c & 8; strm->stream.ops->write_byte8(strm, buffer, 2); - return c; + if (c_orig == '\n') + IO_STREAM_COLUMN(strm) = 0; + else if (c_orig == '\t') + IO_STREAM_COLUMN(strm) = (IO_STREAM_COLUMN(strm)&~07) + 8; + else + IO_STREAM_COLUMN(strm)++; + return c_orig; } /* @@ -632,6 +644,12 @@ utf_8_write_char(cl_object strm, int c_orig) nbytes = 4; } strm->stream.ops->write_byte8(strm, buffer, nbytes); + if (c == '\n') + IO_STREAM_COLUMN(strm) = 0; + else if (c == '\t') + IO_STREAM_COLUMN(strm) = (IO_STREAM_COLUMN(strm)&~07) + 8; + else + IO_STREAM_COLUMN(strm)++; return c_orig; } #endif diff --git a/src/c/main.d b/src/c/main.d index f49666831..bc4d71f2e 100644 --- a/src/c/main.d +++ b/src/c/main.d @@ -75,6 +75,8 @@ static cl_fixnum option_values[ECL_OPT_LIMIT+1] = { 131072, /* ECL_OPT_C_STACK_SIZE */ 4192, /* ECL_OPT_C_STACK_SAFETY_AREA */ 1, /* ECL_OPT_SIGALTSTACK_SIZE */ + 128*1024*1024, /* ECL_OPT_HEAP_SIZE */ + 1024*1024, /* ECL_OPT_HEAP_SAFETY_AREA */ 0}; #if !defined(GBC_BOEHM) @@ -98,7 +100,7 @@ ecl_set_option(int option, cl_fixnum value) if (option > ECL_OPT_LIMIT || option < 0) { FEerror("Invalid boot option ~D", 1, MAKE_FIXNUM(option)); } else { - if (option > ECL_OPT_BOOTED && + if (option < ECL_OPT_BOOTED && option_values[ECL_OPT_BOOTED]) { FEerror("Cannot change option ~D while ECL is running", 1, MAKE_FIXNUM(option)); diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index 04d179eff..dd59b73a3 100644 --- a/src/c/symbols_list.h +++ b/src/c/symbols_list.h @@ -1716,5 +1716,7 @@ cl_symbols[] = { {KEY_ "UCS-2", KEYWORD, NULL, -1, OBJNULL}, {KEY_ "UCS-4", KEYWORD, NULL, -1, OBJNULL}, +{EXT_ "STORAGE-EXHAUSTED", EXT_ORDINARY, NULL, -1, OBJNULL}, + /* Tag for end of list */ {NULL, CL_ORDINARY, NULL, -1, OBJNULL}}; diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h index 56f1782f7..79146859a 100644 --- a/src/c/symbols_list2.h +++ b/src/c/symbols_list2.h @@ -1716,5 +1716,7 @@ cl_symbols[] = { {KEY_ "UCS-2",NULL}, {KEY_ "UCS-4",NULL}, +{EXT_ "STORAGE-EXHAUSTED",NULL}, + /* Tag for end of list */ {NULL,NULL}}; diff --git a/src/clos/conditions.lsp b/src/clos/conditions.lsp index 0eb9398c7..7f69300b0 100644 --- a/src/clos/conditions.lsp +++ b/src/clos/conditions.lsp @@ -554,7 +554,10 @@ returns with NIL." or return to an outer frame, undoing all the function calls so far." type)))))) -(define-condition storage-exhausted (storage-condition) ()) +(define-condition ext:storage-exhausted (storage-condition) () + (:REPORT + (lambda (condition stream) + (format stream "Memory limit reached. Please jump to an outer point or quit program.")))) (define-condition type-error (error) ((datum :INITARG :DATUM :READER type-error-datum) diff --git a/src/h/external.h b/src/h/external.h index 45b3c31b9..314f61db8 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -216,6 +216,8 @@ extern ECL_API cl_object si_gc_dump(void); extern ECL_API cl_object si_gc_stats(cl_object enable); extern ECL_API void *ecl_alloc(cl_index n); extern ECL_API void *ecl_alloc_atomic(cl_index n); +extern ECL_API void *ecl_alloc_uncollectable(size_t size); +extern ECL_API void ecl_free_uncollectable(void *); extern ECL_API void ecl_dealloc(void *); #define ecl_alloc_align(s,d) ecl_alloc(s) #define ecl_alloc_atomic_align(s,d) ecl_alloc_atomic(s) @@ -868,6 +870,8 @@ typedef enum { ECL_OPT_C_STACK_SIZE, ECL_OPT_C_STACK_SAFETY_AREA, ECL_OPT_SIGALTSTACK_SIZE, + ECL_OPT_HEAP_SIZE, + ECL_OPT_HEAP_SAFETY_AREA, ECL_OPT_LIMIT } ecl_option; From d916ff8349c7acc11dfbf724b891ccaf62343798 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sat, 25 Oct 2008 20:49:00 +0200 Subject: [PATCH 42/60] Replaced EXT:SET-STACK-SIZE with the pair EXT:SET/GET-LIMIT which also allows to adjust the heap size. --- src/CHANGELOG | 2 +- src/c/alloc_2.d | 152 ++++++++++++++++++++++++------------------ src/c/load.d | 14 ++++ src/c/read.d | 14 ++++ src/c/stacks.d | 25 ++++++- src/c/symbols_list.h | 3 +- src/c/symbols_list2.h | 3 +- src/h/external.h | 5 +- src/h/internal.h | 1 + 9 files changed, 148 insertions(+), 71 deletions(-) diff --git a/src/CHANGELOG b/src/CHANGELOG index 5ff31f202..77a781677 100644 --- a/src/CHANGELOG +++ b/src/CHANGELOG @@ -204,7 +204,7 @@ ECL 8.9.0: (handler-bind ((ext:stack-overflow #'handle-overflow)) (foo 1)))) - - New function (EXT:SET-STACK-SIZE type size) can resize type = + - New function (EXT:SET-LIMIT type size) can resize type = EXT:BINDING-STACK, EXT:LISP-STACK and EXT:FRAME-STACK. - FLOAT-SIGN returns the right value on negative zeros. diff --git a/src/c/alloc_2.d b/src/c/alloc_2.d index f25b58801..67a5b5600 100644 --- a/src/c/alloc_2.d +++ b/src/c/alloc_2.d @@ -37,16 +37,21 @@ static void finalize_queued(); * OBJECT ALLOCATION * **********************************************************/ -static void -out_of_memory() +void +_ecl_set_max_heap_size(cl_index new_size) +{ + const cl_env_ptr the_env = ecl_process_env(); + ecl_disable_interrupts_env(the_env); + GC_set_max_heap_size(cl_core.max_heap_size = new_size); + ecl_enable_interrupts_env(the_env); +} + +static void +out_of_memory(cl_env_ptr the_env) { - /* Free up some memory and try working with the condition */ - cl_env_ptr the_env = ecl_process_env(); the_env->string_pool = Cnil; - cl_index new_size = ecl_get_option(ECL_OPT_HEAP_SIZE) + - ecl_get_option(ECL_OPT_HEAP_SAFETY_AREA); - ecl_set_option(ECL_OPT_HEAP_SIZE, new_size); - GC_set_max_heap_size(new_size); + _ecl_set_max_heap_size(cl_core.max_heap_size + + ecl_get_option(ECL_OPT_HEAP_SAFETY_AREA)); cl_error(1, @'ext::storage-exhausted'); } @@ -59,7 +64,7 @@ static size_t type_size[t_end]; cl_object ecl_alloc_object(cl_type t) { - cl_object obj; + const cl_env_ptr the_env = ecl_process_env(); /* GC_MALLOC already resets objects */ switch (t) { @@ -67,19 +72,6 @@ ecl_alloc_object(cl_type t) return MAKE_FIXNUM(0); /* Immediate fixnum */ case t_character: return CODE_CHAR(' '); /* Immediate character */ - case t_codeblock: - obj = (cl_object)GC_MALLOC(sizeof(struct ecl_codeblock)); - if (obj == NULL) out_of_memory(); - obj->cblock.locked = 0; - obj->cblock.links = Cnil; - obj->cblock.name = Cnil; - obj->cblock.next = Cnil; - obj->cblock.data_text = NULL; - obj->cblock.data = NULL; - obj->cblock.data_text_size = 0; - obj->cblock.data_size = 0; - obj->cblock.handle = NULL; - break; #ifdef ECL_SHORT_FLOAT case t_shortfloat: #endif @@ -87,10 +79,17 @@ ecl_alloc_object(cl_type t) case t_longfloat: #endif case t_singlefloat: - case t_doublefloat: + case t_doublefloat: { + cl_object obj; + ecl_disable_interrupts_env(the_env); obj = (cl_object)GC_MALLOC_ATOMIC(type_size[t]); - if (obj == NULL) out_of_memory(); + ecl_enable_interrupts_env(the_env); + if (obj != NULL) { + obj->d.t = t; + return obj; + } break; + } case t_bignum: case t_ratio: case t_complex: @@ -124,15 +123,23 @@ ecl_alloc_object(cl_type t) case t_condition_variable: #endif case t_foreign: + case t_codeblock: { + cl_object obj; + ecl_disable_interrupts_env(the_env); obj = (cl_object)GC_MALLOC(type_size[t]); - if (obj == NULL) out_of_memory(); + ecl_enable_interrupts_env(the_env); + if (obj != NULL) { + obj->d.t = t; + return obj; + } break; + } default: printf("\ttype = %d\n", t); ecl_internal_error("alloc botch."); } - obj->d.t = t; - return obj; + out_of_memory(the_env); + return OBJNULL; } #ifdef make_cons @@ -142,11 +149,12 @@ ecl_alloc_object(cl_type t) cl_object ecl_cons(cl_object a, cl_object d) { + const cl_env_ptr the_env = ecl_process_env(); struct ecl_cons *obj; - ecl_disable_interrupts(); + ecl_disable_interrupts_env(the_env); obj = GC_MALLOC(sizeof(struct ecl_cons)); - ecl_enable_interrupts(); - if (obj == NULL) out_of_memory(); + ecl_enable_interrupts_env(the_env); + if (obj == NULL) out_of_memory(the_env); #ifdef ECL_SMALL_CONS obj->car = a; obj->cdr = d; @@ -162,11 +170,12 @@ ecl_cons(cl_object a, cl_object d) cl_object ecl_list1(cl_object a) { + const cl_env_ptr the_env = ecl_process_env(); struct ecl_cons *obj; - ecl_disable_interrupts(); + ecl_disable_interrupts_env(the_env); obj = GC_MALLOC(sizeof(struct ecl_cons)); - ecl_enable_interrupts(); - if (obj == NULL) out_of_memory(); + ecl_enable_interrupts_env(the_env); + if (obj == NULL) out_of_memory(the_env); #ifdef ECL_SMALL_CONS obj->car = a; obj->cdr = Cnil; @@ -192,50 +201,55 @@ ecl_alloc_instance(cl_index slots) void * ecl_alloc_uncollectable(size_t size) { + const cl_env_ptr the_env = ecl_process_env(); void *output; - ecl_disable_interrupts(); + ecl_disable_interrupts_env(the_env); output = GC_MALLOC_UNCOLLECTABLE(size); - ecl_enable_interrupts(); - if (output == NULL) out_of_memory(); + ecl_enable_interrupts_env(the_env); + if (output == NULL) out_of_memory(the_env); return output; } void ecl_free_uncollectable(void *pointer) { - ecl_disable_interrupts(); + const cl_env_ptr the_env = ecl_process_env(); + ecl_disable_interrupts_env(the_env); GC_FREE(pointer); - ecl_enable_interrupts(); + ecl_enable_interrupts_env(the_env); } void * ecl_alloc(cl_index n) { + const cl_env_ptr the_env = ecl_process_env(); void *output; - ecl_disable_interrupts(); + ecl_disable_interrupts_env(the_env); output = GC_MALLOC_IGNORE_OFF_PAGE(n); - ecl_enable_interrupts(); - if (output == NULL) out_of_memory(); + ecl_enable_interrupts_env(the_env); + if (output == NULL) out_of_memory(the_env); return output; } void * ecl_alloc_atomic(cl_index n) { + const cl_env_ptr the_env = ecl_process_env(); void *output; - ecl_disable_interrupts(); + ecl_disable_interrupts_env(the_env); output = GC_MALLOC_ATOMIC_IGNORE_OFF_PAGE(n); - ecl_enable_interrupts(); - if (output == NULL) out_of_memory(); + ecl_enable_interrupts_env(the_env); + if (output == NULL) out_of_memory(the_env); return output; } void ecl_dealloc(void *ptr) { - ecl_disable_interrupts(); + const cl_env_ptr the_env = ecl_process_env(); + ecl_disable_interrupts_env(the_env); GC_FREE(ptr); - ecl_enable_interrupts(); + ecl_enable_interrupts_env(the_env); } static int alloc_initialized = FALSE; @@ -275,7 +289,7 @@ init_alloc(void) #endif GC_clear_roots(); GC_disable(); - GC_set_max_heap_size(ecl_get_option(ECL_OPT_HEAP_SIZE)); + _ecl_set_max_heap_size(ecl_get_option(ECL_OPT_HEAP_SIZE)); #define init_tm(x,y,z) type_size[x] = (z) for (i = 0; i < t_end; i++) { @@ -349,25 +363,29 @@ standard_finalizer(cl_object o) cl_close(1, o); break; #ifdef ECL_THREADS - case t_lock: - ecl_disable_interrupts(); + case t_lock: { + const cl_env_ptr the_env = ecl_process_env(); + ecl_disable_interrupts_env(the_env); #if defined(_MSC_VER) || defined(mingw32) CloseHandle(o->lock.mutex); #else pthread_mutex_destroy(&o->lock.mutex); #endif - ecl_enable_interrupts(); + ecl_enable_interrupts_env(the_env); break; - case t_condition_variable: - ecl_disable_interrupts(); + } + case t_condition_variable: { + const cl_env_ptr the_env = ecl_process_env(); + ecl_disable_interrupts_env(the_env); #if defined(_MSC_VER) || defined(mingw32) CloseHandle(o->condition_variable.cv); #else pthread_cond_destroy(&o->condition_variable.cv); #endif - ecl_enable_interrupts(); + ecl_enable_interrupts_env(the_env); break; #endif + } default:; } } @@ -404,12 +422,13 @@ queueing_finalizer(cl_object o, cl_object finalizer) volatile cl_object aux = ACONS(o, finalizer, Cnil); cl_object l = cl_core.to_be_finalized; if (ATOM(l)) { + const cl_env_ptr the_env = ecl_process_env(); GC_finalization_proc ofn; void *odata; cl_core.to_be_finalized = aux; - ecl_disable_interrupts(); + ecl_disable_interrupts_env(the_env); GC_register_finalizer_no_order(aux, (GC_finalization_proc*)group_finalizer, NULL, &ofn, &odata); - ecl_enable_interrupts(); + ecl_enable_interrupts_env(the_env); } else { ECL_RPLACD(aux, ECL_CONS_CDR(l)); ECL_RPLACD(l, aux); @@ -421,10 +440,11 @@ queueing_finalizer(cl_object o, cl_object finalizer) cl_object si_get_finalizer(cl_object o) { + const cl_env_ptr the_env = ecl_process_env(); cl_object output; GC_finalization_proc ofn; void *odata; - ecl_disable_interrupts(); + ecl_disable_interrupts_env(the_env); GC_register_finalizer_no_order(o, (GC_finalization_proc)0, 0, &ofn, &odata); if (ofn == 0) { output = Cnil; @@ -434,22 +454,23 @@ si_get_finalizer(cl_object o) output = Cnil; } GC_register_finalizer_no_order(o, ofn, odata, &ofn, &odata); - ecl_enable_interrupts(); + ecl_enable_interrupts_env(the_env); @(return output) } cl_object si_set_finalizer(cl_object o, cl_object finalizer) { + const cl_env_ptr the_env = ecl_process_env(); GC_finalization_proc ofn; void *odata; - ecl_disable_interrupts(); + ecl_disable_interrupts_env(the_env); if (finalizer == Cnil) { GC_register_finalizer_no_order(o, (GC_finalization_proc)0, 0, &ofn, &odata); } else { GC_register_finalizer_no_order(o, (GC_finalization_proc)queueing_finalizer, finalizer, &ofn, &odata); } - ecl_enable_interrupts(); + ecl_enable_interrupts_env(the_env); @(return) } @@ -597,18 +618,19 @@ stacks_scanner() void ecl_register_root(cl_object *p) { - ecl_disable_interrupts(); + const cl_env_ptr the_env = ecl_process_env(); + ecl_disable_interrupts_env(the_env); GC_add_roots((char*)p, (char*)(p+1)); - ecl_enable_interrupts(); + ecl_enable_interrupts_env(the_env); } cl_object si_gc(cl_object area) { const cl_env_ptr the_env = ecl_process_env(); - ecl_disable_interrupts(); + ecl_disable_interrupts_env(the_env); GC_gcollect(); - ecl_enable_interrupts(); + ecl_enable_interrupts_env(the_env); @(return) } @@ -616,9 +638,9 @@ cl_object si_gc_dump() { const cl_env_ptr the_env = ecl_process_env(); - ecl_disable_interrupts(); + ecl_disable_interrupts_env(the_env); GC_dump(); - ecl_enable_interrupts(); + ecl_enable_interrupts_env(the_env); @(return) } diff --git a/src/c/load.d b/src/c/load.d index 123b434de..968bb6a43 100644 --- a/src/c/load.d +++ b/src/c/load.d @@ -148,7 +148,21 @@ ecl_library_open(cl_object filename, bool force_reload) { } block = ecl_alloc_object(t_codeblock); block->cblock.self_destruct = self_destruct; + block->cblock.locked = 0; + block->cblock.handle = NULL; + block->cblock.entry = NULL; + block->cblock.data = NULL; + block->cblock.data_size = 0; + block->cblock.temp_data = NULL; + block->cblock.temp_data_size = 0; + block->cblock.data_text = NULL; + block->cblock.data_text_size = 0; block->cblock.name = filename; + block->cblock.next = Cnil; + block->cblock.links = Cnil; + block->cblock.cfuns_size = 0; + block->cblock.cfuns = NULL; + ecl_disable_interrupts(); #ifdef HAVE_DLFCN_H block->cblock.handle = dlopen(filename->base_string.self, diff --git a/src/c/read.d b/src/c/read.d index d3475ffca..8c685226a 100644 --- a/src/c/read.d +++ b/src/c/read.d @@ -2177,6 +2177,20 @@ read_VV(cl_object block, void (*entry_point)(cl_object)) if (block == NULL) { block = ecl_alloc_object(t_codeblock); + block->cblock.self_destruct = 0; + block->cblock.locked = 0; + block->cblock.handle = NULL; + block->cblock.data = NULL; + block->cblock.data_size = 0; + block->cblock.temp_data = NULL; + block->cblock.temp_data_size = 0; + block->cblock.data_text = NULL; + block->cblock.data_text_size = 0; + block->cblock.next = Cnil; + block->cblock.name = Cnil; + block->cblock.links = Cnil; + block->cblock.cfuns_size = 0; + block->cblock.cfuns = NULL; si_set_finalizer(block, Ct); } block->cblock.entry = entry_point; diff --git a/src/c/stacks.d b/src/c/stacks.d index 1df60cda1..48a0e0f5f 100644 --- a/src/c/stacks.d +++ b/src/c/stacks.d @@ -482,7 +482,7 @@ si_sch_frs_base(cl_object fr, cl_object ihs) /********************* INITIALIZATION ***********************/ cl_object -si_set_stack_size(cl_object type, cl_object size) +si_set_limit(cl_object type, cl_object size) { cl_env_ptr env = ecl_process_env(); cl_index the_size = fixnnint(size); @@ -492,12 +492,33 @@ si_set_stack_size(cl_object type, cl_object size) ecl_bds_set_size(env, the_size); } else if (type == @'ext::c-stack') { cs_set_size(env, the_size); - } else { + } else if (type == @'ext::lisp-stack') { ecl_stack_set_size(env, the_size); + } else { + _ecl_set_max_heap_size(the_size); } @(return) } +cl_object +si_get_limit(cl_object type) +{ + cl_env_ptr env = ecl_process_env(); + cl_index output; + if (type == @'ext::frame-stack') { + output = env->frs_size; + } else if (type == @'ext::binding-stack') { + output = env->bds_size; + } else if (type == @'ext::c-stack') { + output = env->cs_size; + } else if (type == @'ext::lisp-stack') { + output = env->stack_size; + } else { + output = cl_core.max_heap_size; + } + @(return ecl_make_unsigned_integer(output)) +} + void init_stacks(cl_env_ptr env, int *new_cs_org) { diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index dd59b73a3..a898c1567 100644 --- a/src/c/symbols_list.h +++ b/src/c/symbols_list.h @@ -1705,7 +1705,8 @@ cl_symbols[] = { {EXT_ "FRAME-STACK", SI_ORDINARY, NULL, -1, OBJNULL}, {EXT_ "LISP-STACK", SI_ORDINARY, NULL, -1, OBJNULL}, {EXT_ "C-STACK", SI_ORDINARY, NULL, -1, OBJNULL}, -{EXT_ "SET-STACK-SIZE", SI_ORDINARY, si_set_stack_size, 2, OBJNULL}, +{EXT_ "SET-LIMIT", SI_ORDINARY, si_set_limit, 2, OBJNULL}, +{EXT_ "GET-LIMIT", SI_ORDINARY, si_get_limit, 1, OBJNULL}, {EXT_ "SEGMENTATION-VIOLATION", SI_ORDINARY, NULL, -1, OBJNULL}, {SYS_ "CHECK-PENDING-INTERRUPTS", SI_ORDINARY, si_check_pending_interrupts, 0, OBJNULL}, diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h index 79146859a..5ea02aa6d 100644 --- a/src/c/symbols_list2.h +++ b/src/c/symbols_list2.h @@ -1705,7 +1705,8 @@ cl_symbols[] = { {EXT_ "FRAME-STACK",NULL}, {EXT_ "LISP-STACK",NULL}, {EXT_ "C-STACK",NULL}, -{EXT_ "SET-STACK-SIZE","si_set_stack_size"}, +{EXT_ "SET-LIMIT","si_set_limit"}, +{EXT_ "GET-LIMIT","si_get_limit"}, {EXT_ "SEGMENTATION-VIOLATION",NULL}, {SYS_ "CHECK-PENDING-INTERRUPTS","si_check_pending_interrupts"}, diff --git a/src/h/external.h b/src/h/external.h index 314f61db8..f64e1ee64 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -196,6 +196,8 @@ struct cl_core_struct { #endif cl_object libraries; cl_object to_be_finalized; + + cl_index max_heap_size; cl_object bytes_consed; cl_object gc_counter; bool gc_stats; @@ -1340,7 +1342,8 @@ extern ECL_API cl_object si_bds_var(cl_object arg); extern ECL_API cl_object si_bds_val(cl_object arg); extern ECL_API cl_object si_sch_frs_base(cl_object fr, cl_object ihs); extern ECL_API cl_object si_reset_stack_limits(void); -extern ECL_API cl_object si_set_stack_size(cl_object type, cl_object size); +extern ECL_API cl_object si_set_limit(cl_object type, cl_object size); +extern ECL_API cl_object si_get_limit(cl_object type); extern ECL_API void ecl_bds_overflow(void) /*__attribute__((noreturn))*/; extern ECL_API void ecl_bds_unwind(cl_env_ptr env, cl_index new_bds_top_index); diff --git a/src/h/internal.h b/src/h/internal.h index 2871dfa65..e99cc8c5d 100644 --- a/src/h/internal.h +++ b/src/h/internal.h @@ -55,6 +55,7 @@ extern cl_env_ptr _ecl_alloc_env(void); /* alloc.d/alloc_2.d */ +extern void _ecl_set_max_heap_size(cl_index new_size); extern cl_object ecl_alloc_bytecodes(cl_index data_size, cl_index code_size); /* compiler.d */ From 11ad1aebe2edf245bc48815bffa2b5602842ce50 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sun, 26 Oct 2008 01:13:51 +0200 Subject: [PATCH 43/60] :if-exists :new-version :if-does-not-exist :create did not truncate the file. --- src/c/file.d | 46 +++++++++++++--------------------------------- 1 file changed, 13 insertions(+), 33 deletions(-) diff --git a/src/c/file.d b/src/c/file.d index 9e9badf55..f536b4171 100644 --- a/src/c/file.d +++ b/src/c/file.d @@ -3416,7 +3416,7 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, mode_t mode = S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH; cl_object filename = si_coerce_to_filename(fn); char *fname = filename->base_string.self; - bool appending = FALSE; + bool appending = 0; ecl_disable_interrupts_env(the_env); if (smm == smm_input || smm == smm_probe) { @@ -3426,12 +3426,10 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, goto CANNOT_OPEN; } else if (if_does_not_exist == @':create') { f = open(fname, O_WRONLY|O_CREAT, mode); - if (f < 0) - goto CANNOT_OPEN; + if (f < 0) goto CANNOT_OPEN; close(f); f = open(fname, O_RDONLY, mode); - if (f < 0) - goto CANNOT_OPEN; + if (f < 0) goto CANNOT_OPEN; } else if (Null(if_does_not_exist)) { x = Cnil; goto OUTPUT; @@ -3442,6 +3440,7 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, } } } else if (smm == smm_output || smm == smm_io) { + int base = (smm == smm_output)? O_WRONLY : O_RDWR; if (if_exists == @':new_version' && if_does_not_exist == @':create') goto CREATE; f = open(fname, O_RDONLY, mode); @@ -3450,32 +3449,17 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, if (if_exists == @':error') { goto CANNOT_OPEN; } else if (if_exists == @':rename') { - f = ecl_backup_open(fname, (smm == smm_output) - ? O_WRONLY|O_CREAT - : O_RDWR|O_CREAT, - mode); - if (f < 0) - goto CANNOT_OPEN; + f = ecl_backup_open(fname, base|O_CREAT, mode); + if (f < 0) goto CANNOT_OPEN; } else if (if_exists == @':rename_and_delete' || if_exists == @':new_version' || if_exists == @':supersede') { - f = open(fname, (smm == smm_output) - ? O_WRONLY|O_TRUNC : O_RDWR|O_TRUNC, - mode); - if (f < 0) - goto CANNOT_OPEN; + f = open(fname, base|O_TRUNC, mode); + if (f < 0) goto CANNOT_OPEN; } else if (if_exists == @':overwrite' || if_exists == @':append') { - /* We cannot use "w+b" because it truncates. - We cannot use "a+b" because writes jump to the end. */ - f = open(filename->base_string.self, (smm == smm_output)? - (O_WRONLY|O_CREAT) : (O_RDWR|O_CREAT), - mode); - if (f < 0) - goto CANNOT_OPEN; - if (if_exists == @':append') { - lseek(f, 0, SEEK_END); - appending = TRUE; - } + f = open(fname, base, mode); + if (f < 0) goto CANNOT_OPEN; + appending = (if_exists == @':append'); } else if (Null(if_exists)) { x = Cnil; goto OUTPUT; @@ -3488,12 +3472,8 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, if (if_does_not_exist == @':error') { goto CANNOT_OPEN; } else if (if_does_not_exist == @':create') { - CREATE: - f = open(fname, (smm == smm_output)? - O_WRONLY|O_CREAT : O_RDWR|O_CREAT, - mode); - if (f < 0) - goto CANNOT_OPEN; + CREATE: f = open(fname, base | O_CREAT | O_TRUNC, mode); + if (f < 0) goto CANNOT_OPEN; } else if (Null(if_does_not_exist)) { x = Cnil; goto OUTPUT; From abf186804a404a23e3776712f2252f54c32cae80 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sun, 26 Oct 2008 02:13:52 +0200 Subject: [PATCH 44/60] FILE-STRING-LENGTH supports unicode strings. More compact implementations of ecl_file_position_set. String output streams can now use unicode strings. The size of bytes is 8 bits when using UTF-8. --- src/c/file.d | 85 +++++++++++++++++++++++++++++----------------------- 1 file changed, 47 insertions(+), 38 deletions(-) diff --git a/src/c/file.d b/src/c/file.d index f536b4171..07fc7c6f7 100644 --- a/src/c/file.d +++ b/src/c/file.d @@ -927,9 +927,8 @@ cl_object si_make_string_output_stream_from_string(cl_object s) { cl_object strm = alloc_stream(); - - if (type_of(s) != t_base_string || !s->base_string.hasfillp) - FEerror("~S is not a base-string with a fill-pointer.", 1, s); + if (!ecl_stringp(s) || !s->base_string.hasfillp) + FEerror("~S is not a -string with a fill-pointer.", 1, s); strm->stream.ops = duplicate_dispatch_table(&str_out_ops); strm->stream.mode = (short)smm_string_output; STRING_OUTPUT_STRING(strm) = s; @@ -2040,8 +2039,9 @@ io_file_write_char(cl_object strm, int c) static int io_file_listen(cl_object strm) { - int f = IO_FILE_DESCRIPTOR(strm); - return file_listen(f); + if (strm->stream.unread != EOF) + return ECL_LISTEN_AVAILABLE; + return file_listen(IO_FILE_DESCRIPTOR(strm)); } static void @@ -2122,29 +2122,21 @@ static cl_object io_file_set_position(cl_object strm, cl_object large_disp) { int f = IO_FILE_DESCRIPTOR(strm); - cl_object output; + ecl_off_t disp; + int mode; if (Null(large_disp)) { - ecl_disable_interrupts(); - if (lseek(f, 0, SEEK_END) == (ecl_off_t)-1) - output = Cnil; - else - output = Ct; - ecl_enable_interrupts(); + disp = 0; + mode = SEEK_END; } else { - ecl_off_t disp; if (strm->stream.byte_size != 8) { large_disp = ecl_times(large_disp, MAKE_FIXNUM(strm->stream.byte_size / 8)); } disp = ecl_integer_to_off_t(large_disp); - ecl_disable_interrupts(); - if (lseek(f, disp, SEEK_SET) == (ecl_off_t)-1) - output = Cnil; - else - output = Ct; - ecl_enable_interrupts(); + mode = SEEK_SET; } - return output; + disp = lseek(f, 0, SEEK_END); + return (disp == (ecl_off_t)-1)? Cnil : Ct; } static int @@ -2333,7 +2325,7 @@ set_stream_elt_type(cl_object stream, cl_fixnum byte_size, int flags) #ifdef ECL_UNICODE case ECL_STREAM_UTF_8: IO_STREAM_ELT_TYPE(stream) = @'character'; - byte_size = 8*2; + byte_size = 8; stream->stream.format = @':utf-8'; stream->stream.ops->read_char = utf_8_read_char; stream->stream.ops->write_char = utf_8_write_char; @@ -2482,8 +2474,9 @@ io_stream_write_char(cl_object strm, int c) static int io_stream_listen(cl_object strm) { - FILE *f = IO_STREAM_FILE(strm); - return flisten(f); + if (strm->stream.unread != EOF) + return ECL_LISTEN_AVAILABLE; + return flisten(IO_STREAM_FILE(strm)); } static void @@ -2572,29 +2565,23 @@ static cl_object io_stream_set_position(cl_object strm, cl_object large_disp) { FILE *f = IO_STREAM_FILE(strm); - cl_object output; + ecl_off_t disp; + int mode; if (Null(large_disp)) { - ecl_disable_interrupts(); - if (ecl_fseeko(f, -1, SEEK_END) != 0) - output = Cnil; - else - output = Ct; - ecl_enable_interrupts(); + disp = 0; + mode = SEEK_END; } else { - ecl_off_t disp; if (strm->stream.byte_size != 8) { large_disp = ecl_times(large_disp, MAKE_FIXNUM(strm->stream.byte_size / 8)); } disp = ecl_integer_to_off_t(large_disp); - ecl_disable_interrupts(); - if (ecl_fseeko(f, disp, SEEK_SET) != 0) - output = Cnil; - else - output = Ct; - ecl_enable_interrupts(); + mode = SEEK_SET; } - return output; + ecl_disable_interrupts(); + mode = ecl_fseeko(f, disp, mode); + ecl_enable_interrupts(); + return mode? Cnil : Ct; } static int @@ -3118,6 +3105,28 @@ cl_file_string_length(cl_object stream, cl_object string) @(return MAKE_FIXNUM(1)) } switch (type_of(string)) { +#ifdef ECL_UNICODE + case t_string: { + cl_object c = cl_stream_external_format(stream); + cl_index i; + if (c == @':utf-8') + for (i = l = 0; i < string->string.fillp; i++) { + cl_index c = ecl_char(string, i); + l++; + if (c >= 0x7f) l++; + if (c >= 0x7ff) l++; + if (c >= 0xffff) l++; + if (c >= 0x1fffffL) l++; + } + else if (c == @':ucs-2') + l = string->string.fillp * 2; + else if (c == @':ucs-4') + l = string->string.fillp * 4; + else + l = string->string.fillp; + break; + } +#endif case t_base_string: l = string->base_string.fillp; break; From f7c965c3beaf7ac5faa8032afe9323fec43612b3 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sun, 26 Oct 2008 13:30:40 +0100 Subject: [PATCH 45/60] The single-threaded code did not build. file_listen() does not work on actual files. --- src/c/alloc_2.d | 4 ++-- src/h/object.h | 7 ++++--- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/src/c/alloc_2.d b/src/c/alloc_2.d index 67a5b5600..82320b964 100644 --- a/src/c/alloc_2.d +++ b/src/c/alloc_2.d @@ -289,7 +289,7 @@ init_alloc(void) #endif GC_clear_roots(); GC_disable(); - _ecl_set_max_heap_size(ecl_get_option(ECL_OPT_HEAP_SIZE)); + GC_set_max_heap_size(cl_core.max_heap_size = ecl_get_option(ECL_OPT_HEAP_SIZE)); #define init_tm(x,y,z) type_size[x] = (z) for (i = 0; i < t_end; i++) { @@ -384,8 +384,8 @@ standard_finalizer(cl_object o) #endif ecl_enable_interrupts_env(the_env); break; -#endif } +#endif default:; } } diff --git a/src/h/object.h b/src/h/object.h index 333de757b..3cf5c593a 100644 --- a/src/h/object.h +++ b/src/h/object.h @@ -520,14 +520,14 @@ enum { ECL_STREAM_UCS_2 = 3, ECL_STREAM_UCS_4 = 4, ECL_STREAM_SIGNED_BYTES = 16, - ECL_STREAM_C_STREAM = 32 + ECL_STREAM_C_STREAM = 32, + ECL_STREAM_MIGHT_SEEK = 64 }; struct ecl_stream { - HEADER3(mode,closed,flags); + HEADER2(mode,closed); /* stream mode of enum smmode */ /* closed stream? */ - /* character table, flags, etc */ struct ecl_file_ops *ops; /* dispatch table */ void *file; /* file pointer */ cl_object object0; /* some object */ @@ -539,6 +539,7 @@ struct ecl_stream { cl_fixnum last_op; /* 0: unknown, 1: reading, -1: writing */ char *buffer; /* buffer for FILE */ cl_object format; /* external format */ + int flags; /* character table, flags, etc */ }; struct ecl_random { From 2abb769a7a53f98f01592254af790ee3de38d5aa Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sun, 26 Oct 2008 13:30:54 +0100 Subject: [PATCH 46/60] The single-threaded code did not build. file_listen() does not work on actual files. --- src/c/file.d | 22 +++++++++++++++++++++- src/h/stacks.h | 5 +++-- 2 files changed, 24 insertions(+), 3 deletions(-) diff --git a/src/c/file.d b/src/c/file.d index 07fc7c6f7..e124d07e2 100644 --- a/src/c/file.d +++ b/src/c/file.d @@ -2041,6 +2041,25 @@ io_file_listen(cl_object strm) { if (strm->stream.unread != EOF) return ECL_LISTEN_AVAILABLE; + if (strm->stream.flags & ECL_STREAM_MIGHT_SEEK) { + cl_env_ptr the_env = ecl_process_env(); + int f = IO_FILE_DESCRIPTOR(strm); + ecl_off_t disp, new; + ecl_disable_interrupts_env(the_env); + disp = lseek(f, 0, SEEK_CUR); + ecl_enable_interrupts_env(the_env); + if (disp != (ecl_off_t)-1) { + ecl_disable_interrupts_env(the_env); + new = lseek(f, 0, SEEK_END); + ecl_enable_interrupts_env(the_env); + lseek(f, disp, SEEK_SET); + if (new == disp) { + return ECL_LISTEN_NO_CHAR; + } else if (new != (ecl_off_t)-1) { + return ECL_LISTEN_AVAILABLE; + } + } + } return file_listen(IO_FILE_DESCRIPTOR(strm)); } @@ -2135,7 +2154,7 @@ io_file_set_position(cl_object strm, cl_object large_disp) disp = ecl_integer_to_off_t(large_disp); mode = SEEK_SET; } - disp = lseek(f, 0, SEEK_END); + disp = lseek(f, disp, mode); return (disp == (ecl_off_t)-1)? Cnil : Ct; } @@ -3511,6 +3530,7 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, if (smm == smm_probe) { cl_close(1, x); } else { + x->stream.flags |= ECL_STREAM_MIGHT_SEEK; si_set_finalizer(x, Ct); /* Set file pointer to the correct position */ ecl_file_position_set(x, appending? Cnil : MAKE_FIXNUM(0)); diff --git a/src/h/stacks.h b/src/h/stacks.h index 176780db0..d92b6c65b 100644 --- a/src/h/stacks.h +++ b/src/h/stacks.h @@ -41,8 +41,9 @@ typedef struct bds_bd { #define ecl_bds_check(env) \ ((env->bds_top >= env->bds_limit)? ecl_bds_overflow() : (void)0) -#ifdef ECL_THREADS typedef struct cl_env_struct *cl_env_ptr; + +#ifdef ECL_THREADS extern ECL_API void ecl_bds_bind(cl_env_ptr env, cl_object symbol, cl_object v); extern ECL_API void ecl_bds_push(cl_env_ptr env, cl_object symbol); extern ECL_API void ecl_bds_unwind1(cl_env_ptr env); @@ -66,7 +67,7 @@ extern ECL_API cl_object ecl_set_symbol(cl_env_ptr env, cl_object s, cl_object v #define ecl_bds_push(env,sym) do { \ const cl_env_ptr env_copy = (env); \ const cl_object s = (sym); \ - const cl_object v = (val); \ + const cl_object v = s->symbol.value; \ ecl_bds_check(env_copy); \ (++(env_copy->bds_top))->symbol = s, \ env_copy->bds_top->value = s->symbol.value; } while (0); From 541956193a6ded1ba81d72a752f6a07863cf913d Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sun, 26 Oct 2008 15:04:57 +0100 Subject: [PATCH 47/60] # is a non terminating character --- src/c/read.d | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/c/read.d b/src/c/read.d index 8c685226a..82e3a4213 100644 --- a/src/c/read.d +++ b/src/c/read.d @@ -1922,8 +1922,8 @@ ecl_invalid_character_p(int c) @ ecl_readtable_set(readtable, ecl_char_code(c), Null(non_terminating_p)? - cat_non_terminating : - cat_terminating, + cat_terminating : + cat_non_terminating, function); @(return Ct) @) @@ -1948,7 +1948,7 @@ ecl_invalid_character_p(int c) @ assert_type_readtable(readtable); c = ecl_char_code(chr); - cat = Null(non_terminating_p)? cat_non_terminating : cat_terminating; + cat = Null(non_terminating_p)? cat_terminating : cat_non_terminating; table = cl__make_hash_table(@'eql', MAKE_FIXNUM(128), ecl_make_singlefloat(1.5f), ecl_make_singlefloat(0.5f), @@ -2096,7 +2096,7 @@ init_read(void) cl_core.default_dispatch_macro = make_cf3(default_dispatch_macro_fun); cl_make_dispatch_macro_character(3, CODE_CHAR('#'), - Ct /* terminating */, r); + Ct /* non terminating */, r); cl_set_dispatch_macro_character(4, CODE_CHAR('#'), CODE_CHAR('C'), make_cf3(sharp_C_reader), r); From fc60fc304c8257662dde96210a5de40dd3fd0f9e Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sun, 26 Oct 2008 17:45:22 +0100 Subject: [PATCH 48/60] The pretty printer has to accept extended characters now. --- src/lsp/pprint.lsp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lsp/pprint.lsp b/src/lsp/pprint.lsp index 424371e3e..d929a0c99 100644 --- a/src/lsp/pprint.lsp +++ b/src/lsp/pprint.lsp @@ -145,7 +145,7 @@ (defun pretty-out (stream char) (declare (type pretty-stream stream) - (type base-char char) + (type character char) (si::c-local)) (cond ((char= char #\newline) (enqueue-newline stream :literal)) From 19618912c8729931e2fab02e0f17158cf4d39fd2 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sun, 26 Oct 2008 17:46:18 +0100 Subject: [PATCH 49/60] Variable clobbers input argument in char_code. name_char did not work with extended strings. --- src/c/character.d | 25 +++++++------------------ 1 file changed, 7 insertions(+), 18 deletions(-) diff --git a/src/c/character.d b/src/c/character.d index 5e01a1eab..9c4a4a73a 100644 --- a/src/c/character.d +++ b/src/c/character.d @@ -34,9 +34,9 @@ ecl_base_char_code(cl_object c) { #ifdef ECL_UNICODE if (CHARACTERP(c)) { - cl_fixnum c = CHAR_CODE(c); - if (c <= 255) { - return (int)c; + cl_fixnum code = CHAR_CODE(c); + if (code <= 255) { + return (int)code; } } FEtype_error_character(c); @@ -563,21 +563,10 @@ cl_name_char(cl_object name) c = Cnil; } else { cl_index used_l; - if (type_of(name) == t_base_string) { - cl_index end = name->base_string.fillp; - cl_index real_end = end; - c = ecl_parse_integer(name, 1, end, &real_end, 16); - used_l = real_end; - } else { - /* Unsafe code: what about read errors? - bds_bind(@'*read-base*', MAKE_FIXNUM(16)); - c = cl_funcall(6, @'read-from-string', name, - Cnil, Cnil, @':start', MAKE_FIXNUM(1)); - bds_unwind1(); - used_l = fix(VALUES(0)); - */ - c = Cnil; - } + cl_index end = name->base_string.fillp; + cl_index real_end = end; + c = ecl_parse_integer(name, 1, end, &real_end, 16); + used_l = real_end; if (!FIXNUMP(c) || (used_l == (l - 1))) { c = Cnil; } else { From 6fe9d192ad446979c7a5f849b1cd620ac022f80d Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sun, 26 Oct 2008 17:46:59 +0100 Subject: [PATCH 50/60] Hashing of base strings has to be done using unsigned characters, to be compatible with extended strings. --- src/c/hash.d | 8 +++++--- src/c/newhash.h | 3 +-- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/src/c/hash.d b/src/c/hash.d index 7cd08570f..d46bc2077 100644 --- a/src/c/hash.d +++ b/src/c/hash.d @@ -92,12 +92,14 @@ _hash_equal(int depth, cl_hashkey h, cl_object x) x = x->symbol.name; #ifdef ECL_UNICODE case t_base_string: - return hash_base_string(x->base_string.self, x->base_string.fillp, h); + return hash_base_string((unsigned char *)x->base_string.self, + x->base_string.fillp, h); case t_string: - return hash_full_string(x->base_string.self, x->base_string.fillp, h); + return hash_full_string(x->string.self, x->string.fillp, h); #else case t_base_string: - return hash_string(h, x->base_string.self, x->base_string.fillp); + return hash_string(h, (unsigned char *)x->base_string.self, + x->base_string.fillp); #endif case t_pathname: h = _hash_equal(0, h, x->pathname.directory); diff --git a/src/c/newhash.h b/src/c/newhash.h index 770d575fe..3c121be92 100644 --- a/src/c/newhash.h +++ b/src/c/newhash.h @@ -144,7 +144,7 @@ static cl_index hash_word(cl_index c, cl_index w) return c; } -static cl_index hash_base_string(const char *s, cl_index len, cl_index h) +static cl_index hash_base_string(const unsigned char *s, cl_index len, cl_index h) { cl_index a = GOLDEN_RATIO, b = GOLDEN_RATIO, i; for (i = len; i >= 3; i -= 3) { @@ -179,4 +179,3 @@ static cl_index hash_full_string(const cl_object *s, cl_index len, cl_index h) mix(a, b, h); return h; } - From 9d1935c9d5383751efb9da5281106c392615c228 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sun, 26 Oct 2008 17:47:35 +0100 Subject: [PATCH 51/60] Now that base/extended strings produce the same hash codes, we find-symbol does not need to coerce extended strings to simple ones. --- src/c/package.d | 5 ----- 1 file changed, 5 deletions(-) diff --git a/src/c/package.d b/src/c/package.d index b9949c36c..759cb91c7 100644 --- a/src/c/package.d +++ b/src/c/package.d @@ -383,11 +383,6 @@ ecl_find_symbol_nolock(cl_object name, cl_object p, int *intern_flag) cl_object s, ul; name = ecl_check_type_string(@'find-symbol', name); -#ifdef ECL_UNICODE - if (ecl_fits_in_base_string(name)) { - name = si_copy_to_simple_base_string(name); - } -#endif s = ecl_gethash_safe(name, p->pack.external, OBJNULL); if (s != OBJNULL) { *intern_flag = EXTERNAL; From 404e4dedba04fc5735f5f8c4b63a440f5b5927c9 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sun, 26 Oct 2008 18:28:50 +0100 Subject: [PATCH 52/60] More fixes related to support of exteded strings in string-i/o-streams --- src/c/file.d | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/src/c/file.d b/src/c/file.d index e124d07e2..252776f02 100644 --- a/src/c/file.d +++ b/src/c/file.d @@ -942,7 +942,11 @@ si_make_string_output_stream_from_string(cl_object s) cl_object ecl_make_string_output_stream(cl_index line_length) { +#ifdef ECL_UNICODE + cl_object s = ecl_alloc_adjustable_extended_string(line_length); +#else cl_object s = cl_alloc_adjustable_base_string(line_length); +#endif return si_make_string_output_stream_from_string(s); } @@ -962,7 +966,7 @@ cl_get_output_stream_string(cl_object strm) if (type_of(strm) != t_stream || (enum ecl_smmode)strm->stream.mode != smm_string_output) FEerror("~S is not a string-output stream.", 1, strm); - strng = si_copy_to_simple_base_string(STRING_OUTPUT_STRING(strm)); + strng = cl_copy_seq(STRING_OUTPUT_STRING(strm)); STRING_OUTPUT_STRING(strm)->base_string.fillp = 0; @(return strng) } @@ -982,7 +986,7 @@ str_in_read_char(cl_object strm) if (curr_pos >= STRING_INPUT_LIMIT(strm)) { c = EOF; } else { - c = STRING_INPUT_STRING(strm)->base_string.self[curr_pos]; + c = ecl_char(STRING_INPUT_STRING(strm), curr_pos); STRING_INPUT_POSITION(strm) = curr_pos+1; } return c; @@ -1007,7 +1011,7 @@ str_in_peek_char(cl_object strm) if (pos >= STRING_INPUT_LIMIT(strm)) { return EOF; } else { - return STRING_INPUT_STRING(strm)->base_string.self[pos]; + return ecl_char(STRING_INPUT_STRING(strm), pos); } } @@ -1113,13 +1117,7 @@ ecl_make_string_input_stream(cl_object strng, cl_index istart, cl_index iend) @(defun make_string_input_stream (strng &o istart iend) cl_index s, e; @ - strng = si_coerce_to_base_string(strng); -#ifdef ECL_UNICODE - if (type_of(strng) == t_string) { - FEerror("Reading from extended strings is not supported: ~A", - 1, strng); - } -#endif + strng = cl_string(strng); if (Null(istart)) s = 0; else if (!FIXNUMP(istart) || FIXNUM_MINUSP(istart)) From 3aac33afa34fe5857e9bab9056cddd466e3624c5 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sun, 26 Oct 2008 18:29:15 +0100 Subject: [PATCH 53/60] Accept extended strings when they can be coerced to base-strings --- src/c/pathname.d | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/c/pathname.d b/src/c/pathname.d index 8c5a7442e..929435677 100644 --- a/src/c/pathname.d +++ b/src/c/pathname.d @@ -805,8 +805,10 @@ si_coerce_to_filename(cl_object pathname_orig) FEerror("Too long filename: ~S.", 1, namestring); #ifdef ECL_UNICODE if (type_of(namestring) == t_string) { - FEerror("The filesystem does not accept filenames with extended characters: ~S", - 1, namestring); + if (!ecl_fits_in_base_string(namestring)) + FEerror("The filesystem does not accept filenames with extended characters: ~S", + 1, namestring); + namestring = si_copy_to_simple_base_string(namestring); } #endif return namestring; From 4fd28315572328ed1e1f99918c3ebb8a9ee05909 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sun, 26 Oct 2008 18:29:42 +0100 Subject: [PATCH 54/60] Buffers must be strings, not base-strings --- src/lsp/format.lsp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/lsp/format.lsp b/src/lsp/format.lsp index 396bec3bc..bfa41f07e 100644 --- a/src/lsp/format.lsp +++ b/src/lsp/format.lsp @@ -1996,7 +1996,7 @@ :downcase))))) ,@(expand-directive-list before)) #+ecl - `(let ((string (make-array 10 :element-type 'base-char + `(let ((string (make-array 10 :element-type 'character :fill-pointer 0 :adjustable t))) (unwind-protect (with-output-to-string (stream string) @@ -2033,7 +2033,7 @@ (before (subseq directives 0 posn)) (jumped t) (after (nthcdr (1+ posn) directives)) - (string (make-array 10 :element-type 'base-char + (string (make-array 10 :element-type 'character :adjustable t :fill-pointer 0))) (unwind-protect (with-output-to-string (stream string) From 454d89d8d9c5f2f77ac9c739a18dcbe056df54cc Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sun, 26 Oct 2008 19:45:35 +0100 Subject: [PATCH 55/60] MAKE-STRING-OUTPUT-STREAM must be able to create both base and extended strings --- src/c/file.d | 41 +++++++++++++++++++++++++++-------------- src/c/format.d | 15 +++++++++------ src/c/load.d | 8 ++++---- src/c/main.d | 2 +- src/c/pathname.d | 2 +- src/c/symbol.d | 4 ++-- src/cmp/sysfun.lsp | 2 -- src/h/external.h | 2 +- 8 files changed, 45 insertions(+), 31 deletions(-) diff --git a/src/c/file.d b/src/c/file.d index 252776f02..7dea43953 100644 --- a/src/c/file.d +++ b/src/c/file.d @@ -940,23 +940,38 @@ si_make_string_output_stream_from_string(cl_object s) } cl_object -ecl_make_string_output_stream(cl_index line_length) +ecl_make_string_output_stream(cl_index line_length, int extended) { #ifdef ECL_UNICODE - cl_object s = ecl_alloc_adjustable_extended_string(line_length); + cl_object s = extended? + ecl_alloc_adjustable_extended_string(line_length) : + cl_alloc_adjustable_base_string(line_length); #else - cl_object s = cl_alloc_adjustable_base_string(line_length); + cl_object s = ecl_alloc_adjustable_base_string(line_length); #endif return si_make_string_output_stream_from_string(s); } -@(defun make-string-output-stream (&key (element_type @'base-char')) +@(defun make-string-output-stream (&key (element_type @'character')) + int extended = 0; @ - if (Null(funcall(3, @'subtypep', element_type, @'character'))) { + if (element_type == @'base-char') { + (void)0; + } else if (element_type == @'character') { +#ifdef ECL_UNICODE + extended = 1; +#endif + } else if (!Null(funcall(3, @'subtypep', element_type, @'base-char'))) { + (void)0; + } else if (!Null(funcall(3, @'subtypep', element_type, @'character'))) { +#ifdef ECL_UNICODE + extended = 1; +#endif + } else { FEerror("In MAKE-STRING-OUTPUT-STREAM, the argument :ELEMENT-TYPE (~A) must be a subtype of character", 1, element_type); } - @(return ecl_make_string_output_stream(128)) + @(return ecl_make_string_output_stream(128, extended)) @) cl_object @@ -3160,7 +3175,6 @@ cl_object si_do_write_sequence(cl_object seq, cl_object stream, cl_object s, cl_object e) { cl_fixnum start,limit,end; - cl_type t; /* Since we have called ecl_length(), we know that SEQ is a valid sequence. Therefore, we only need to check the type of the @@ -3175,9 +3189,9 @@ si_do_write_sequence(cl_object seq, cl_object stream, cl_object s, cl_object e) if (end <= start) { goto OUTPUT; } - t = type_of(seq); - if (t == t_list) { - bool ischar = cl_stream_element_type(stream) == @'base-char'; + if (LISTP(seq)) { + cl_object elt_type = cl_stream_element_type(stream); + bool ischar = (elt_type == @'base-char') || (elt_type == @'character'); cl_object s = ecl_nthcdr(start, seq); loop_for_in(s) { if (start < end) { @@ -3203,7 +3217,6 @@ cl_object si_do_read_sequence(cl_object seq, cl_object stream, cl_object s, cl_object e) { cl_fixnum start,limit,end; - cl_type t; /* Since we have called ecl_length(), we know that SEQ is a valid sequence. Therefore, we only need to check the type of the @@ -3218,9 +3231,9 @@ si_do_read_sequence(cl_object seq, cl_object stream, cl_object s, cl_object e) if (end <= start) { goto OUTPUT; } - t = type_of(seq); - if (t == t_list) { - bool ischar = cl_stream_element_type(stream) == @'base-char'; + if (LISTP(seq)) { + cl_object elt_type = cl_stream_element_type(stream); + bool ischar = (elt_type == @'base-char') || (elt_type == @'character'); seq = ecl_nthcdr(start, seq); loop_for_in(seq) { if (start >= end) { diff --git a/src/c/format.d b/src/c/format.d index c94696a77..0d21bbb3d 100644 --- a/src/c/format.d +++ b/src/c/format.d @@ -107,7 +107,7 @@ get_aux_stream(void) ecl_disable_interrupts_env(env); if (env->fmt_aux_stream == Cnil) { - stream = ecl_make_string_output_stream(64); + stream = ecl_make_string_output_stream(64, 1); } else { stream = env->fmt_aux_stream; env->fmt_aux_stream = Cnil; @@ -1431,7 +1431,7 @@ fmt_case(format_stack fmt, bool colon, bool atsign) int up_colon; bool b; - x = ecl_make_string_output_stream(64); + x = ecl_make_string_output_stream(64, 1); i = fmt->ctl_index; j = fmt_skip(fmt); if (fmt->ctl_str[--j] != ')' || fmt->ctl_str[--j] != '~') @@ -1709,7 +1709,7 @@ fmt_justification(format_stack fmt, volatile bool colon, bool atsign) fields = Cnil; for (;;) { - cl_object this_field = ecl_make_string_output_stream(64); + cl_object this_field = ecl_make_string_output_stream(64, 1); i = fmt->ctl_index; j0 = j = fmt_skip(fmt); while (fmt->ctl_str[--j] != '~') @@ -2106,12 +2106,16 @@ DIRECTIVE: int null_strm = 0; @ if (Null(strm)) { +#ifdef ECL_UNICODE + strm = ecl_alloc_adjustable_extended_string(64); +#else strm = cl_alloc_adjustable_base_string(64); +#endif null_strm = 1; } else if (strm == Ct) { strm = ecl_symbol_value(@'*standard-output*'); } - if (type_of(strm) == t_base_string) { + if (ecl_stringp(strm)) { output = strm; if (!output->base_string.hasfillp) { cl_error(7, @'si::format-error', @@ -2121,8 +2125,7 @@ DIRECTIVE: @':control-string', string, @':offset', MAKE_FIXNUM(0)); } - strm = ecl_make_string_output_stream(0); - STRING_OUTPUT_STRING(strm) = output; + strm = si_make_string_output_stream_from_string(strm); if (null_strm == 0) output = Cnil; } diff --git a/src/c/load.d b/src/c/load.d index 968bb6a43..eb9a07011 100644 --- a/src/c/load.d +++ b/src/c/load.d @@ -114,8 +114,7 @@ ecl_library_open(cl_object filename, bool force_reload) { cl_index i; /* Coerces to a file name but does not merge with cwd */ - filename = coerce_to_physical_pathname(filename); - filename = cl_namestring(filename); + filename = si_coerce_to_filename(filename); if (!force_reload) { /* When loading a foreign library, such as a dll or a @@ -371,7 +370,7 @@ si_load_binary(cl_object filename, cl_object verbose, cl_object print) } /* We need the full pathname */ - filename = cl_namestring(cl_truename(filename)); + filename = cl_truename(filename); #ifdef ECL_THREADS /* Loading binary code is not thread safe. When another thread tries @@ -544,7 +543,8 @@ NOT_A_FILENAME: ecl_bds_bind(the_env, @'*package*', ecl_symbol_value(@'*package*')); ecl_bds_bind(the_env, @'*readtable*', ecl_symbol_value(@'*readtable*')); ecl_bds_bind(the_env, @'*load-pathname*', not_a_filename? Cnil : source); - ecl_bds_bind(the_env, @'*load-truename*', not_a_filename? Cnil : cl_truename(filename)); + ecl_bds_bind(the_env, @'*load-truename*', + not_a_filename? Cnil : (filename = cl_truename(filename))); if (!Null(function)) { ok = funcall(4, function, filename, verbose, print); } else { diff --git a/src/c/main.d b/src/c/main.d index bc4d71f2e..5f3906be1 100644 --- a/src/c/main.d +++ b/src/c/main.d @@ -128,7 +128,7 @@ ecl_init_env(cl_env_ptr env) env->print_pretty = FALSE; env->queue = ecl_alloc_atomic(ECL_PPRINT_QUEUE_SIZE * sizeof(short)); env->indent_stack = ecl_alloc_atomic(ECL_PPRINT_INDENTATION_STACK_SIZE * sizeof(short)); - env->fmt_aux_stream = ecl_make_string_output_stream(64); + env->fmt_aux_stream = ecl_make_string_output_stream(64, 1); #endif #if !defined(GBC_BOEHM) # if defined(THREADS) diff --git a/src/c/pathname.d b/src/c/pathname.d index 929435677..afc468e0f 100644 --- a/src/c/pathname.d +++ b/src/c/pathname.d @@ -881,7 +881,7 @@ ecl_namestring(cl_object x, int truncate_if_unreadable) * or using ecl_make_pathname(). In all of these cases ECL will complain * at creation time if the pathname has wrong components. */ - buffer = ecl_make_string_output_stream(128); + buffer = ecl_make_string_output_stream(128, 1); logical = x->pathname.logical; host = x->pathname.host; if (logical) { diff --git a/src/c/symbol.d b/src/c/symbol.d index 242becfec..4f4758d1f 100644 --- a/src/c/symbol.d +++ b/src/c/symbol.d @@ -348,7 +348,7 @@ cl_symbol_name(cl_object x) cl_list(3, @'or', @'string', @'integer')); goto AGAIN; } - output = ecl_make_string_output_stream(64); + output = ecl_make_string_output_stream(64, 1); ecl_bds_bind(the_env, @'*print-escape*', Cnil); ecl_bds_bind(the_env, @'*print-readably*', Cnil); ecl_bds_bind(the_env, @'*print-base*', MAKE_FIXNUM(10)); @@ -369,7 +369,7 @@ cl_symbol_name(cl_object x) prefix = ecl_check_type_string(@'gentemp', prefix); pack = si_coerce_to_package(pack); ONCE_MORE: - output = ecl_make_string_output_stream(64); + output = ecl_make_string_output_stream(64, 1); ecl_bds_bind(the_env, @'*print-escape*', Cnil); ecl_bds_bind(the_env, @'*print-readably*', Cnil); ecl_bds_bind(the_env, @'*print-base*', MAKE_FIXNUM(10)); diff --git a/src/cmp/sysfun.lsp b/src/cmp/sysfun.lsp index 225a0fab1..44e35392f 100644 --- a/src/cmp/sysfun.lsp +++ b/src/cmp/sysfun.lsp @@ -355,8 +355,6 @@ (proclaim-function make-echo-stream (stream stream) echo-stream) (proclaim-function make-string-input-stream (*) string-stream) (proclaim-function make-string-output-stream (*) string-stream) -(def-inline make-string-output-stream :always () string-stream - "ecl_make_string_output_stream(128)") (proclaim-function get-output-stream-string (string-stream) string) (proclaim-function streamp (t) t :predicate t) diff --git a/src/h/external.h b/src/h/external.h index f64e1ee64..d3ed06335 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -606,7 +606,7 @@ extern ECL_API cl_object ecl_stream_element_type(cl_object strm); extern ECL_API bool ecl_interactive_stream_p(cl_object strm); extern ECL_API cl_object ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, cl_object if_does_not_exist, cl_fixnum byte_size, int flags); extern ECL_API cl_object ecl_make_string_input_stream(cl_object strng, cl_index istart, cl_index iend); -extern ECL_API cl_object ecl_make_string_output_stream(cl_index line_length); +extern ECL_API cl_object ecl_make_string_output_stream(cl_index line_length, int extended); extern ECL_API cl_object ecl_read_byte(cl_object strm); extern ECL_API void ecl_write_byte(cl_object byte, cl_object strm); extern ECL_API int ecl_read_char_noeof(cl_object strm); From 6fda953a2cf9a439d8530970039d60d4695d2212 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sun, 26 Oct 2008 20:44:54 +0100 Subject: [PATCH 56/60] Fixed typo that only affects non-Unicode build --- src/c/file.d | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/c/file.d b/src/c/file.d index 7dea43953..d04d67c8d 100644 --- a/src/c/file.d +++ b/src/c/file.d @@ -947,7 +947,7 @@ ecl_make_string_output_stream(cl_index line_length, int extended) ecl_alloc_adjustable_extended_string(line_length) : cl_alloc_adjustable_base_string(line_length); #else - cl_object s = ecl_alloc_adjustable_base_string(line_length); + cl_object s = cl_alloc_adjustable_base_string(line_length); #endif return si_make_string_output_stream_from_string(s); } From d09f7d4f9d8cbed4317738416c3684bc80a0f108 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sun, 9 Nov 2008 23:33:01 +0100 Subject: [PATCH 57/60] Improved interval type handling to include signed zeros in member types. --- src/lsp/predlib.lsp | 56 ++++++++++++++++++++++++++++++--------------- 1 file changed, 38 insertions(+), 18 deletions(-) diff --git a/src/lsp/predlib.lsp b/src/lsp/predlib.lsp index 80d9a7bfc..55bac0324 100644 --- a/src/lsp/predlib.lsp +++ b/src/lsp/predlib.lsp @@ -760,28 +760,48 @@ if not possible." ;;---------------------------------------------------------------------- ;; MEMBER types. We register this object in a separate list, *MEMBER-TYPES*, -;; and tag all types to which it belongs. +;; and tag all types to which it belongs. We need to treat three cases +;; separately +;; - Ordinary types, via simple-member-type, check the objects +;; against all pre-registered types, adding their tags. +;; - Ordinary numbers, are translated into intervals. +;; - Floating point zeros, have to be treated separately. This +;; is done by assigning a special tag to -0.0 and translating +;; (MEMBER 0.0) = (AND (float-type 0.0 0.0) (NOT (MEMBER -0.0))) ;; (defun register-member-type (object) ;(declare (si::c-local)) (let ((pos (assoc object *member-types*))) - (or (and pos (cdr pos)) - ;; We convert number into intervals, so that (AND INTEGER (NOT - ;; (EQL 10))) is detected as a subtype of (OR (INTEGER * 9) - ;; (INTEGER 11 *)). - (and (realp object) - (let* ((base-type (if (integerp object) 'INTEGER (type-of object))) - (type (list base-type object object))) - (or (find-registered-tag type) - (register-interval-type type)))) - (let* ((tag (new-type-tag))) - (maybe-save-types) - (setq *member-types* (acons object tag *member-types*)) - (dolist (i *elementary-types*) - (let ((type (car i))) - (when (typep object type) - (setf (cdr i) (logior tag (cdr i)))))) - tag)))) + (cond ((and pos (cdr pos))) + ((not (realp object)) + (simple-member-type object)) + ((and (floatp object) (zerop object)) + (if (minusp (float-sign object)) + (simple-member-type object) + (logandc2 (number-member-type object) + (register-member-type (- object))))) + (t + (number-member-type object))))) + +(defun simple-member-type (object) + (declare (si::c-local)) + (let* ((tag (new-type-tag))) + (maybe-save-types) + (setq *member-types* (acons object tag *member-types*)) + (dolist (i *elementary-types*) + (let ((type (car i))) + (when (typep object type) + (setf (cdr i) (logior tag (cdr i)))))) + tag)) + +;; We convert number into intervals, so that (AND INTEGER (NOT (EQL +;; 10))) is detected as a subtype of (OR (INTEGER * 9) (INTEGER 11 +;; *)). +(defun number-member-type (object) + (let* ((base-type (if (integerp object) 'INTEGER (type-of object))) + (type (list base-type object object))) + (or (find-registered-tag type) + (register-interval-type type)))) (defun push-type (type tag) (declare (si::c-local)) From d7ce7efa81a81c03b4c41dad4f64aaa6cbe9cb7e Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Thu, 20 Nov 2008 22:41:28 +0100 Subject: [PATCH 58/60] Unhandled compiler errors cause another error because of an undefined variable. --- src/cmp/cmputil.lsp | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/src/cmp/cmputil.lsp b/src/cmp/cmputil.lsp index 7c9b393f7..70cef73e6 100644 --- a/src/cmp/cmputil.lsp +++ b/src/cmp/cmputil.lsp @@ -137,11 +137,12 @@ (apply #'format t args))) (defun cmperr (string &rest args) - (signal 'compiler-error - :format-control string - :format-arguments args) - (print-compiler-message c t) - (abort)) + (let ((c (make-condition 'compiler-error + :format-control string + :format-arguments args))) + (signal c) + (print-compiler-message c t) + (abort))) (defun check-args-number (operator args &optional (min 0) (max nil)) (let ((l (length args))) @@ -195,7 +196,7 @@ (defun baboon (&aux (*print-case* :upcase)) (signal 'compiler-internal-error - :format-control "A bug was found in the compiler. Contact jjgarcia@users.sourceforge.net" + :format-control "A bug was found in the compiler." :format-arguments nil)) (defmacro with-cmp-protection (main-form error-form) @@ -208,21 +209,21 @@ (defun cmp-eval (form) (with-cmp-protection (eval form) - (cmperr "~&;;; The form ~s was not evaluated successfully.~ - ~%;;; You are recommended to compile again.~%" + (cmperr "The form ~s was not evaluated successfully.~ +~&You are recommended to compile again." form))) (defun cmp-macroexpand (form &optional (env *cmp-env*)) (with-cmp-protection (macroexpand form env) - (cmperr "~&;;; The macro form ~S was not expanded successfully.~ - ~%;;; You are recommended to compile again.~%" form))) + (cmperr "The macro form ~S was not expanded successfully.~ +~%You are recommended to compile again." form))) (defun cmp-expand-macro (fd form &optional (env *cmp-env*)) (with-cmp-protection (let ((new-form (funcall *macroexpand-hook* fd form env))) (values new-form (not (eql new-form form)))) - (cmperr "~&;;; The macro form ~S was not expanded successfully.~ - ~%;;; You are recommended to compile again.~%" form))) + (cmperr "The macro form ~S was not expanded successfully.~ +~%You are recommended to compile again." form))) (defun si::compiler-clear-compiler-properties (symbol) #-:CCL From 044caf8c4d34b7532a88bf8f2855d68a80d126fc Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sun, 30 Nov 2008 22:28:51 +0100 Subject: [PATCH 59/60] SUBTYPEP must abort on finding a complex CONS type, but this should not affect the TYPE-AND and TYPE-OR routines. --- src/c/file.d | 8 ++++---- src/cmp/cmptype.lsp | 13 ++++++++++--- src/lsp/predlib.lsp | 12 ++++++++---- 3 files changed, 22 insertions(+), 11 deletions(-) diff --git a/src/c/file.d b/src/c/file.d index d04d67c8d..155f887cf 100644 --- a/src/c/file.d +++ b/src/c/file.d @@ -2206,8 +2206,7 @@ io_file_read_vector(cl_object strm, cl_object data, cl_index start, cl_index end void *aux = data->vector.self.ch + start; return strm->stream.ops->read_byte8(strm, aux, end-start); } - } - if (t == aet_fix || t == aet_index) { + } else if (t == aet_fix || t == aet_index) { if (strm->stream.byte_size == sizeof(cl_fixnum)*8) { void *aux = data->vector.self.fix + start; cl_index bytes = (end - start) * sizeof(cl_fixnum); @@ -2229,8 +2228,7 @@ io_file_write_vector(cl_object strm, cl_object data, cl_index start, cl_index en void *aux = data->vector.self.fix + start; return strm->stream.ops->write_byte8(strm, aux, end-start); } - } - if (t == aet_fix || t == aet_index) { + } else if (t == aet_fix || t == aet_index) { if (strm->stream.byte_size == sizeof(cl_fixnum)*8) { void *aux = data->vector.self.fix + start; cl_index bytes = (end - start) * sizeof(cl_fixnum); @@ -2347,6 +2345,8 @@ set_stream_elt_type(cl_object stream, cl_fixnum byte_size, int flags) case ECL_STREAM_BINARY: IO_STREAM_ELT_TYPE(stream) = cl_list(2, t, MAKE_FIXNUM(byte_size)); stream->stream.format = @':default'; + stream->stream.ops->read_char = not_character_read_char; + stream->stream.ops->write_char = not_character_write_char; break; /*case ECL_ISO_8859_1:*/ case ECL_STREAM_LATIN_1: diff --git a/src/cmp/cmptype.lsp b/src/cmp/cmptype.lsp index dd44b09ab..7dfba46b7 100644 --- a/src/cmp/cmptype.lsp +++ b/src/cmp/cmptype.lsp @@ -143,12 +143,15 @@ t2) (t `(AND ,t1 ,t2)))) + ((eq tag1 'CONS) + (type-and 'CONS t2)) + ((eq tag2 'CONS) + (type-and t1 'CONS)) ((null tag1) - (cmpwarn "Unknown type ~S" t1) + (cmpwarn "Unknown type ~S. Assuming it is T." t1) t2) (t - (error t2) - (cmpwarn "Unknown type ~S" t2) + (cmpwarn "Unknown type ~S. Assuming it is T." t2) t1)))) (defun type-or (t1 t2) @@ -172,6 +175,10 @@ t1) (t `(OR ,t1 ,t2)))) + ((eq tag1 'CONS) + (type-or 'CONS t2)) + ((eq tag2 'CONS) + (type-or t1 'CONS)) ((null tag1) (cmpwarn "Unknown type ~S" t1) 'T) diff --git a/src/lsp/predlib.lsp b/src/lsp/predlib.lsp index 55bac0324..d02859b07 100644 --- a/src/lsp/predlib.lsp +++ b/src/lsp/predlib.lsp @@ -753,8 +753,9 @@ if not possible." (or (find-registered-tag type) (multiple-value-bind (tag-super tag-sub) (find-type-bounds type in-our-family-p type-<= nil) - (let ((tag (logior (new-type-tag) tag-sub))) + (let ((tag (new-type-tag))) (update-types (logandc2 tag-super tag-sub) tag) + (setf tag (logior tag tag-sub)) (push-type type tag) tag)))) @@ -1064,9 +1065,12 @@ if not possible." (defun register-cons-type (&optional (car-type '*) (cdr-type '*)) (let ((car-tag (if (eq car-type '*) -1 (canonical-type car-type))) (cdr-tag (if (eq cdr-type '*) -1 (canonical-type cdr-type)))) - (if (or (zerop car-tag) (zerop cdr-tag)) - 0 - (canonical-type 'CONS)))) + (cond ((or (zerop car-tag) (zerop cdr-tag)) + 0) + ((and (= car-tag -1) (= cdr-tag -1)) + (canonical-type 'CONS)) + (t + (throw '+canonical-type-failure+ 'CONS))))) ;;---------------------------------------------------------------------- ;; FIND-BUILT-IN-TAG From 7ae84753e8e516c589751aeafa7a080c144cec88 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sun, 30 Nov 2008 23:15:39 +0100 Subject: [PATCH 60/60] An type with an unsupported CONS type cannot be replaced by just CONS. Use T instead for type estimates in TYPE-AND/OR --- src/cmp/cmptype.lsp | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/src/cmp/cmptype.lsp b/src/cmp/cmptype.lsp index 7dfba46b7..5d6512ef4 100644 --- a/src/cmp/cmptype.lsp +++ b/src/cmp/cmptype.lsp @@ -144,9 +144,11 @@ (t `(AND ,t1 ,t2)))) ((eq tag1 'CONS) - (type-and 'CONS t2)) + (cmpwarn "Unsupported CONS type ~S. Replacing it with T." t1) + t2) ((eq tag2 'CONS) - (type-and t1 'CONS)) + (cmpwarn "Unsupported CONS type ~S. Replacing it with T." t2) + t1) ((null tag1) (cmpwarn "Unknown type ~S. Assuming it is T." t1) t2) @@ -176,15 +178,17 @@ (t `(OR ,t1 ,t2)))) ((eq tag1 'CONS) - (type-or 'CONS t2)) + (cmpwarn "Unsupported CONS type ~S. Replacing it with T." t1) + T) ((eq tag2 'CONS) - (type-or t1 'CONS)) + (cmpwarn "Unsupported CONS type ~S. Replacing it with T." t2) + T) ((null tag1) (cmpwarn "Unknown type ~S" t1) - 'T) + T) (t (cmpwarn "Unknown type ~S" t2) - 'T)))) + T)))) (defun type>= (type1 type2) (subtypep type2 type1))