From 350c493cb485a0faba05db28f39b591934df9dbf Mon Sep 17 00:00:00 2001 From: Marius Gerbershagen Date: Sat, 22 Feb 2020 19:24:29 +0100 Subject: [PATCH 01/10] configure: only disable fpe but not ieee-fp for mingw Due to recent changes, it is possible to have infinity and NaN, but without floating point exceptions. --- src/aclocal.m4 | 1 - src/configure | 19 ++----------------- 2 files changed, 2 insertions(+), 18 deletions(-) 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/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 From 6729693650da6c89d049067c66f6461c9d7c6fb0 Mon Sep 17 00:00:00 2001 From: Marius Gerbershagen Date: Sun, 23 Feb 2020 13:10:24 +0100 Subject: [PATCH 02/10] fix fixint and fixnnint for apis with long smaller than cl_fixnum Concerns especially win64. These functions have been broken since commit 0102aed9f57f69b8cb75d518fc8c701cb437b1d8. --- src/c/big.d | 113 +++++++++++++++++++++++++++++++++++----------------- 1 file changed, 76 insertions(+), 37 deletions(-) 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) { From a3eebf1ba34b940a5a004f4a63b57bc9dc80150d Mon Sep 17 00:00:00 2001 From: Marius Gerbershagen Date: Wed, 26 Feb 2020 19:39:11 +0100 Subject: [PATCH 03/10] Revert "ieee-fp: remove _fpreset from si_trap_fpe" This reverts commit bd9c590810a33d2843467fcefbb4f7d82784b8b6. Apparently, _fpreset is not just equivalent to feclearexcept and really needed when doing a longjmp out of a signal handler. On top of that, with MSVC 2019, I now observe segmentation faults without _fpreset, but not with _fpreset in si_trap_fpe! --- src/c/unixint.d | 3 +++ 1 file changed, 3 insertions(+) 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); From 6dce405b2ab2c9e0c366d81883165b3fdc77f5eb Mon Sep 17 00:00:00 2001 From: Marius Gerbershagen Date: Wed, 26 Feb 2020 19:51:01 +0100 Subject: [PATCH 04/10] tests: stop compilers from complaining about division by zero in emb.0003.with-lisp-fpe --- src/tests/normal-tests/embedding.lsp | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/tests/normal-tests/embedding.lsp b/src/tests/normal-tests/embedding.lsp index 8b5e9ea0a..e79e60b77 100644 --- a/src/tests/normal-tests/embedding.lsp +++ b/src/tests/normal-tests/embedding.lsp @@ -141,7 +141,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 +162,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 */ From 2155e354e4cb29523df7aad54114c5059388ea4b Mon Sep 17 00:00:00 2001 From: Marius Gerbershagen Date: Wed, 26 Feb 2020 21:51:01 +0100 Subject: [PATCH 05/10] doc: more detailed build instructions for MSVC --- INSTALL | 11 ++++++----- src/doc/manual/user-guide/building.txi | 11 ++++++++--- 2 files changed, 14 insertions(+), 8 deletions(-) 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/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 From 14fa51f172fbbec009025ca8a8ac6bd92ddd150e Mon Sep 17 00:00:00 2001 From: Marius Gerbershagen Date: Wed, 26 Feb 2020 22:14:20 +0100 Subject: [PATCH 06/10] fix config.h for MSVC win64 --- msvc/ecl/config.h.msvc6 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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) From fd7b4c6f85e9fc91bd5f0160ef3cf47c3e8161dd Mon Sep 17 00:00:00 2001 From: Marius Gerbershagen Date: Sat, 29 Feb 2020 20:11:05 +0100 Subject: [PATCH 07/10] tests: add test for ecl_import_current_thread --- src/tests/normal-tests/embedding.lsp | 108 +++++++++++++++++++++++++++ 1 file changed, 108 insertions(+) diff --git a/src/tests/normal-tests/embedding.lsp b/src/tests/normal-tests/embedding.lsp index e79e60b77..bcc1a7c2f 100644 --- a/src/tests/normal-tests/embedding.lsp +++ b/src/tests/normal-tests/embedding.lsp @@ -185,3 +185,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)))) From 313d55391877c5039228fdaedec0975dd54dc177 Mon Sep 17 00:00:00 2001 From: Marius Gerbershagen Date: Sat, 29 Feb 2020 20:11:54 +0100 Subject: [PATCH 08/10] tests: fix embedding tests on cygwin --- src/tests/normal-tests/embedding.lsp | 65 ++++++++++++++++------------ 1 file changed, 37 insertions(+), 28 deletions(-) diff --git a/src/tests/normal-tests/embedding.lsp b/src/tests/normal-tests/embedding.lsp index bcc1a7c2f..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) From 05778027189fc39d316f9f59f7d7420a4b53367c Mon Sep 17 00:00:00 2001 From: Marius Gerbershagen Date: Sat, 29 Feb 2020 23:37:30 +0100 Subject: [PATCH 09/10] ecl_release_current_thread: don't close handle twice thread_cleanup already calls CloseHandle --- src/c/threads/process.d | 6 ------ 1 file changed, 6 deletions(-) diff --git a/src/c/threads/process.d b/src/c/threads/process.d index 375327a21..45d03692d 100755 --- a/src/c/threads/process.d +++ b/src/c/threads/process.d @@ -429,9 +429,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 +440,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)) From a7e694de0e5d0a4c9960b821697be9fe00c8859e Mon Sep 17 00:00:00 2001 From: Marius Gerbershagen Date: Sat, 29 Feb 2020 20:02:36 +0100 Subject: [PATCH 10/10] ecl_import_current_thread: fix segmentation fault Bug was introduced by the recent race condition fixes of commit cc7c0d438699cb29d7726b4a308257f6686a8c28. ecl_list_process needs to be able to allocate memory and bind special variables, which wasn't possible previously, because the environment was not yet initialized. Since we can't initialize the environment before calling ecl_list_process (that was the reason for the race condition in the first place), we use the fake environment allocated on the stack (where the gc can find its contents) until we can safely call ecl_list_process and switch over to the real environment. Fixes #564. --- src/c/threads/process.d | 35 +++++++++++++++++++---------------- 1 file changed, 19 insertions(+), 16 deletions(-) diff --git a/src/c/threads/process.d b/src/c/threads/process.d index 45d03692d..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. */