diff --git a/INSTALL b/INSTALL index d0766915e..7e216bb29 100644 --- a/INSTALL +++ b/INSTALL @@ -12,14 +12,15 @@ If you do not have access to the online version, follow the following recipies. 3. Use "make" followed by "make install" to build and install ECL. * Windows with Visual Studio C++ 2008 -1. Enter the msvc directory -2. Read the file Makefile to find the configuration options. They +1. Open the Visual Studio x86 or x64 native tools command prompt +2. Enter the msvc directory +3. Read the file Makefile to find the configuration options. They typically have the form ECL_UNICODE=1, ECL_THREADS=1, etc -3. Enter +4. Enter nmake ... followed by zero or more of those options -4. Use "nmake install" to create a directory called "package" with ECL in it. -5. Move that directory wherever you need. +5. Use "nmake install" to create a directory called "package" with ECL in it. +6. Move that directory wherever you need. * Cross-compile for the android platform (from the UNIX machine) 1. Build the host ECL diff --git a/msvc/ecl/config.h.msvc6 b/msvc/ecl/config.h.msvc6 index 23b8d3e4f..3919e2514 100755 --- a/msvc/ecl/config.h.msvc6 +++ b/msvc/ecl/config.h.msvc6 @@ -129,7 +129,7 @@ * use autoconf to guess the following values. */ #ifdef _M_X64 -#define ECL_INT_BITS 64 +#define ECL_INT_BITS 32 #define ECL_LONG_BITS 32 #define ECL_FIXNUM_BITS 64 #define MOST_POSITIVE_FIXNUM ((cl_fixnum)2305843009213693951LL) diff --git a/src/aclocal.m4 b/src/aclocal.m4 index dae305572..3f905e473 100644 --- a/src/aclocal.m4 +++ b/src/aclocal.m4 @@ -399,7 +399,6 @@ case "${host_os}" in mingw*) thehost='mingw32' dnl We disable fpe because ECL/MinGW has problems with FE_INEXACT - with_ieee_fp='no' with_fpe='no' clibs='' shared='yes' diff --git a/src/c/big.d b/src/c/big.d index 8967602a3..273f62019 100644 --- a/src/c/big.d +++ b/src/c/big.d @@ -14,6 +14,7 @@ */ #define ECL_INCLUDE_MATH_H +#include #include #include #include @@ -334,36 +335,6 @@ mp_realloc(void *ptr, size_t osize, size_t nsize) return p; } -cl_fixnum -fixint(cl_object x) -{ - if (ECL_FIXNUMP(x)) - return ecl_fixnum(x); - if (ECL_BIGNUMP(x)) { - if (mpz_fits_slong_p(x->big.big_num)) { - return mpz_get_si(x->big.big_num); - } - } - FEwrong_type_argument(@[fixnum], x); -} - -cl_index -fixnnint(cl_object x) -{ - if (ECL_FIXNUMP(x)) { - cl_fixnum i = ecl_fixnum(x); - if (i >= 0) - return i; - } else if (ECL_BIGNUMP(x)) { - if (mpz_fits_ulong_p(x->big.big_num)) { - return mpz_get_ui(x->big.big_num); - } - } - FEwrong_type_argument(cl_list(3, @'integer', ecl_make_fixnum(0), - ecl_make_fixnum(MOST_POSITIVE_FIXNUM)), - x); -} - #undef _ecl_big_set_fixnum #undef _ecl_big_set_index #if ECL_LONG_BITS >= ECL_FIXNUM_BITS @@ -405,6 +376,7 @@ _ecl_big_set_fixnum(cl_object x, cl_fixnum f) ECL_BIGNUM_SIZE(x) = -1; ECL_BIGNUM_LIMBS(x)[0] = -f; } + return x; } cl_object @@ -416,6 +388,7 @@ _ecl_big_set_index(cl_object x, cl_index f) ECL_BIGNUM_SIZE(x) = 1; ECL_BIGNUM_LIMBS(x)[0] = f; } + return x; } cl_fixnum @@ -433,17 +406,83 @@ _ecl_big_get_index(cl_object x) cl_index output = ECL_BIGNUM_LIMBS(x)[0]; return (ECL_BIGNUM_SIZE(x) > 0)? output : ~(output - 1); } - -bool -_ecl_big_fits_in_index(cl_object x) -{ - /* INV: x is a bignum and thus size != 0 */ - return (ECL_BIGNUM_SIZE(x) ^ 1) == 0; -} #else # error "ECL cannot build with GMP when both long and mp_limb_t are smaller than cl_fixnum" #endif /* ECL_FIXNUM_BITS > GMP_LIMB_BITS, ECL_LONG_BITS */ +#if ECL_FIXNUM_BITS == ECL_INT_BITS +static inline bool +_ecl_big_fits_in_fixnum(cl_object x) +{ + return mpz_fits_sint_p(x->big.big_num); +} + +static inline bool +_ecl_big_fits_in_index(cl_object x) +{ + return mpz_fits_uint_p(x->big.big_num); +} +#elif ECL_FIXNUM_BITS == ECL_LONG_BITS +static inline bool +_ecl_big_fits_in_fixnum(cl_object x) +{ + return mpz_fits_slong_p(x->big.big_num); +} + +static inline bool +_ecl_big_fits_in_index(cl_object x) +{ + return mpz_fits_ulong_p(x->big.big_num); +} +#elif ECL_FIXNUM_BITS == ECL_LONG_LONG_BITS && GMP_LIMB_BITS >= ECL_FIXNUM_BITS +static inline bool +_ecl_big_fits_in_fixnum(cl_object x) +{ + /* INV: x is a bignum and thus size != 0 */ + return (ECL_BIGNUM_SIZE(x) == 1 && ECL_BIGNUM_LIMBS(x)[0] <= LLONG_MAX) + || (ECL_BIGNUM_SIZE(x) == -1 && -(ECL_BIGNUM_LIMBS(x)[0]) >= LLONG_MIN); +} + +static inline bool +_ecl_big_fits_in_index(cl_object x) +{ + /* INV: x is a bignum and thus size != 0 */ + return ECL_BIGNUM_SIZE(x) == 1 && ECL_BIGNUM_LIMBS(x)[0] <= ULLONG_MAX; +} +#else +# error "ECL cannot build with GMP when both long and mp_limb_t are smaller than cl_fixnum" +#endif + +cl_fixnum +fixint(cl_object x) +{ + if (ECL_FIXNUMP(x)) + return ecl_fixnum(x); + if (ECL_BIGNUMP(x)) { + if (_ecl_big_fits_in_fixnum(x)) { + return _ecl_big_get_fixnum(x); + } + } + FEwrong_type_argument(@[fixnum], x); +} + +cl_index +fixnnint(cl_object x) +{ + if (ECL_FIXNUMP(x)) { + cl_fixnum i = ecl_fixnum(x); + if (i >= 0) + return i; + } else if (ECL_BIGNUMP(x)) { + if (_ecl_big_fits_in_index(x)) { + return _ecl_big_get_index(x); + } + } + FEwrong_type_argument(cl_list(3, @'integer', ecl_make_fixnum(0), + ecl_make_fixnum(MOST_POSITIVE_FIXNUM)), + x); +} + long double _ecl_big_to_long_double(cl_object o) { diff --git a/src/c/threads/process.d b/src/c/threads/process.d index 375327a21..5f5831d95 100755 --- a/src/c/threads/process.d +++ b/src/c/threads/process.d @@ -391,30 +391,33 @@ ecl_import_current_thread(cl_object name, cl_object bindings) return 0; } } - /* We need a fake env to allow for interrupts blocking. */ + /* We need a fake env to allow for interrupts blocking and to set up + * frame stacks or other stuff which may be needed by alloc_process + * and ecl_list_process. Since the fake env is allocated on the stack, + * we can safely store pointers to memory allocated by the gc there. */ + memset(env_aux, 0, sizeof(*env_aux)); env_aux->disable_interrupts = 1; ecl_set_process_env(env_aux); - env = _ecl_alloc_env(0); - ecl_set_process_env(env); + ecl_init_env(env_aux); - /* Link environment and process together */ - env->own_process = process = alloc_process(name, bindings); + /* Allocate real environment, link it together with process */ + env = _ecl_alloc_env(0); + process = alloc_process(name, bindings); process->process.env = env; process->process.phase = ECL_PROCESS_BOOTING; process->process.thread = current; - /* Immediately list the process such that its environment is - * marked by the gc when its contents are allocated */ + /* Copy initial bindings from process to the fake environment */ + env_aux->cleanup = registered; + env_aux->bindings_array = process->process.initial_bindings; + env_aux->thread_local_bindings_size = env_aux->bindings_array->vector.dim; + env_aux->thread_local_bindings = env_aux->bindings_array->vector.self.t; + + /* Switch over to the real environment */ + memcpy(env, env_aux, sizeof(*env)); + env->own_process = process; + ecl_set_process_env(env); ecl_list_process(process); - - /* Now we can safely allocate memory for the environment contents - * and store pointers to it in the environment */ - ecl_init_env(env); - - env->cleanup = registered; - env->bindings_array = process->process.initial_bindings; - env->thread_local_bindings_size = env->bindings_array->vector.dim; - env->thread_local_bindings = env->bindings_array->vector.self.t; ecl_enable_interrupts_env(env); /* Activate the barrier so that processes can immediately start waiting. */ @@ -429,9 +432,6 @@ void ecl_release_current_thread(void) { cl_env_ptr env = ecl_process_env(); -#ifdef ECL_WINDOWS_THREADS - HANDLE to_close = env->own_process->process.thread; -#endif int cleanup = env->cleanup; cl_object own_process = env->own_process; @@ -443,9 +443,6 @@ ecl_release_current_thread(void) GC_unregister_my_thread(); } #endif -#ifdef ECL_WINDOWS_THREADS - CloseHandle(to_close); -#endif } @(defun mp::make-process (&key name ((:initial-bindings initial_bindings) ECL_T)) diff --git a/src/c/unixint.d b/src/c/unixint.d index db45a92d6..5b1af53e4 100644 --- a/src/c/unixint.d +++ b/src/c/unixint.d @@ -1236,6 +1236,9 @@ si_trap_fpe(cl_object condition, cl_object flag) # ifdef HAVE_FENV_H feclearexcept(all); # endif +# if defined(ECL_MS_WINDOWS_HOST) + _fpreset(); +# endif # ifdef HAVE_FEENABLEEXCEPT fedisableexcept(all & ~bits); feenableexcept(all & bits); diff --git a/src/configure b/src/configure index 6cfa5b772..ac9a4d83f 100755 --- a/src/configure +++ b/src/configure @@ -741,7 +741,6 @@ infodir docdir oldincludedir includedir -runstatedir localstatedir sharedstatedir sysconfdir @@ -867,7 +866,6 @@ datadir='${datarootdir}' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' -runstatedir='${localstatedir}/run' includedir='${prefix}/include' oldincludedir='/usr/include' docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' @@ -1120,15 +1118,6 @@ do | -silent | --silent | --silen | --sile | --sil) silent=yes ;; - -runstatedir | --runstatedir | --runstatedi | --runstated \ - | --runstate | --runstat | --runsta | --runst | --runs \ - | --run | --ru | --r) - ac_prev=runstatedir ;; - -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \ - | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \ - | --run=* | --ru=* | --r=*) - runstatedir=$ac_optarg ;; - -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ @@ -1266,7 +1255,7 @@ fi 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 runstatedir + libdir localedir mandir do eval ac_val=\$$ac_var # Remove trailing slashes. @@ -1419,7 +1408,6 @@ Fine tuning of the installation directories: --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] - --runstatedir=DIR modifiable per-process data [LOCALSTATEDIR/run] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] @@ -5100,8 +5088,7 @@ LSP_FEATURES="(cons :android ${LSP_FEATURES})" ;; mingw*) thehost='mingw32' - with_ieee_fp='no' - with_fpe='no' + with_fpe='no' clibs='' shared='yes' enable_threads='yes' @@ -9007,8 +8994,6 @@ main () if (*(data + i) != *(data3 + i)) return 14; close (fd); - free (data); - free (data3); return 0; } _ACEOF diff --git a/src/doc/manual/user-guide/building.txi b/src/doc/manual/user-guide/building.txi index 40fb6c2c1..93b44d5a8 100644 --- a/src/doc/manual/user-guide/building.txi +++ b/src/doc/manual/user-guide/building.txi @@ -75,9 +75,14 @@ You also need @uref{http://yasm.tortall.net,yasm} optionally to build gmp, fetch yasm-1.3.0-win64.exe and yasm-1.3.0-win32.exe, and put them in your system PATH directory. -In the Visual Studio's startup menu, -click @uref{https://docs.microsoft.com/en-us/dotnet/framework/tools/developer-command-prompt-for-vs,Developer Command Prompt for Visual Studio} -to open the console window. +In the Visual Studio's startup menu, click +@uref{https://docs.microsoft.com/en-us/dotnet/framework/tools/developer-command-prompt-for-vs,Developer +Command Prompt for Visual Studio} to open the console +window. Alternatively, open the developer console from the start menu +through "Visual Studio 20xx" -> "Visual Studio Tools" -> "VC" and +select "x64 Native Tools Command Prompt for VS 20xx" or "x86 Native +Tools Command Prompt for VS 20xx", depending on whether you want to +build 32 or 64bit versions of ECL. @enumerate @item diff --git a/src/tests/normal-tests/embedding.lsp b/src/tests/normal-tests/embedding.lsp index 8b5e9ea0a..43df6ea27 100644 --- a/src/tests/normal-tests/embedding.lsp +++ b/src/tests/normal-tests/embedding.lsp @@ -16,34 +16,43 @@ (princ c-code s)) (c::compiler-cc "tmp/ecl-aux.c" "tmp/ecl-aux.o") (c::linker-cc "tmp/ecl-aux.exe" '("tmp/ecl-aux.o")) - (ecase capture-output - ((nil) - (return-from test-C-program (zerop (si::system #+windows (format nil "PATH=%PATH%;~a tmp\\ecl-aux.exe" c::*ecl-library-directory*) - #-windows "tmp/ecl-aux.exe")))) - ((string :string) - (with-output-to-string (s) - (let ((in (si::run-program "tmp/ecl-aux.exe" '() :output :stream - :environ (append #+windows (list (format nil "PATH=~a;~a" - (ext:getenv "PATH") - c::*ecl-library-directory*)) - (ext:environ)))) - line) - (loop - (setf line (read-line in nil)) - (unless line (return)) - (write-line line s))))) - ((t forms :forms) - (do* ((all '()) - (x t) - (in (si::run-program "tmp/ecl-aux.exe" '() :output :stream - :environ (append #+windows (list (format nil "PATH=~a;~a" - (ext:getenv "PATH") - c::*ecl-library-directory*)) - (ext:environ))))) - ((null in) all) - (setf x (ignore-errors (read in nil nil))) - (unless x (return all)) - (push x all))))) + (let ((environment + (append #+windows (list (format nil "PATH=~a;~a" + (ext:getenv "PATH") + c::*ecl-library-directory*)) + #+cygwin (list (format nil "PATH=~a:~a" + (ext:getenv "PATH") + c::*ecl-library-directory*)) + #-(or windows cygwin) (list (format nil "LD_LIBRARY_PATH=~a:~a" + (ext:getenv "LD_LIBRARY_PATH") + c::*ecl-library-directory*)) + (ext:environ)))) + (ecase capture-output + ((nil) + (multiple-value-bind (stream return-code) + (si::run-program "tmp/ecl-aux.exe" '() + :output t :error t + :environ environment) + (declare (ignore stream)) + (zerop return-code))) + ((string :string) + (with-output-to-string (s) + (let ((in (si::run-program "tmp/ecl-aux.exe" '() :output :stream + :environ environment)) + line) + (loop + (setf line (read-line in nil)) + (unless line (return)) + (write-line line s))))) + ((t forms :forms) + (do* ((all '()) + (x t) + (in (si::run-program "tmp/ecl-aux.exe" '() :output :stream + :environ environment))) + ((null in) all) + (setf x (ignore-errors (read in nil nil))) + (unless x (return all)) + (push x all)))))) ;;; Date: 21/06/2006 (goffioul) ;;; Fixed: 23/06/2006 (juanjo) @@ -141,7 +150,8 @@ int main(int argc, char **argv) { env = ecl_process_env(); conditions = ecl_list1(ecl_make_symbol(\"ARITHMETIC-ERROR\", \"CL\")); ECL_HANDLER_CASE_BEGIN(env, conditions) { - a = 1.0 / 0.0; + a = 1.0 / (double) (argc - 1); /* equivalent of 1.0/0.0 but without + compilers complaining about it */ } ECL_HANDLER_CASE(1, condition) { ret = 2; goto out; @@ -161,7 +171,7 @@ int main(int argc, char **argv) { ECL_WITH_LISP_FPE_BEGIN { ECL_HANDLER_CASE_BEGIN(env, conditions) { - b = ecl_to_double(cl_N(2, ecl_make_double_float(1.0), ecl_make_double_float(0.0))); + b = ecl_to_double(cl_N(2, ecl_make_double_float(1.0), ecl_make_double_float((double) (argc - 1)))); } ECL_HANDLER_CASE(1, condition) { b = 0.0; /* ... but dividing by a zero float should definitely do so */ @@ -184,3 +194,111 @@ out: } ")) (test-C-program c-code)))) + + +;;; Date: 2020-02-29 (Marius Gerbershagen) +;;; Description: +;;; +;;; Verify that ecl_import_current_thread works correctly +;;; +#+threads +(test emb.0004.import-current-thread + (is-true + (let* ((c-code " +#define NUM_THREADS 50 +#define BUFSIZE 1024 + +#include +#include +#include +/* Force use of ordinary thread creation functions instead of gc defines like + * GC_CreateThread, GC_pthread_create. */ +#undef CreateThread +#undef pthread_create +#undef pthread_join +#ifdef _WIN32 +# include +#else +# include +# include +#endif + +#ifdef ECL_WINDOWS_THREADS +static DWORD WINAPI +#else +static void * +#endif +thread_entry_point(void *data) +{ + cl_object form = (cl_object)data; + + if (!ecl_import_current_thread(ECL_NIL, ECL_NIL)) { + exit(3); + } + + cl_eval(form); + + ecl_release_current_thread(); +#ifdef ECL_WINDOWS_THREADS + return 1; +#else + return NULL; +#endif +} + + +int main(int narg, char **argv) +{ +#ifdef ECL_WINDOWS_THREADS + HANDLE child_thread[NUM_THREADS]; + DWORD thread_id[NUM_THREADS]; +#else + pthread_t child_thread[NUM_THREADS]; +#endif + int i, code; + char buffer[BUFSIZE]; + volatile cl_object forms[NUM_THREADS]; + + cl_boot(narg, argv); + snprintf(buffer, BUFSIZE, \"(defparameter *test-results* (make-array %d :initial-element nil))\", NUM_THREADS); + cl_eval(c_string_to_object(buffer)); + + for (i = 0; i < NUM_THREADS; i++) { + snprintf(buffer, BUFSIZE, \"(setf (elt *test-results* %d) %d)\", i, i); + forms[i] = c_string_to_object(buffer); +#ifdef ECL_WINDOWS_THREADS + child_thread[i] = (HANDLE)CreateThread(NULL, 0, thread_entry_point, + (void*)forms[i], 0, &thread_id[i]); + if (child_thread[i] == NULL) { + exit(1); + } +#else + code = pthread_create(&child_thread[i], NULL, thread_entry_point, + (void*)forms[i]); + if (code) { + exit(1); + } +#endif + } + + for (i = 0; i < NUM_THREADS; i++) { +#ifdef ECL_WINDOWS_THREADS + WaitForSingleObject(child_thread[i], INFINITE); + CloseHandle(child_thread[i]); +#else + pthread_join(child_thread[i], NULL); +#endif + } + + for (i = 0; i < NUM_THREADS; i++) { + snprintf(buffer, BUFSIZE, \"(elt *test-results* %d)\", i); + cl_object result = cl_eval(c_string_to_object(buffer)); + if (!ecl_eql(result, ecl_make_fixnum(i))) { + exit(2); + } + } + + cl_shutdown(); + return 0; +}")) + (test-C-program c-code))))