Merge branch 'windows-fixes' into 'develop'

various fixes for Windows

Closes #564

See merge request embeddable-common-lisp/ecl!189

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

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)

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'

src/c/big.d

@@ -14,6 +14,7 @@
  */
 
 #define ECL_INCLUDE_MATH_H
+#include <limits.h>
 #include <string.h>
 #include <ecl/ecl.h>
 #include <ecl/internal.h>
@@ -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)
 {

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

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

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

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

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 <stdio.h>
+#include <stdlib.h>
+#include <ecl/ecl.h>
+/* 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 <windows.h>
+#else
+# include <unistd.h>
+# include <pthread.h>
+#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))))