Merge branch 'cross-compilation-core' into 'develop'

Cross compilation improvements

Closes #741 and #747

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

INSTALL

@@ -23,63 +23,34 @@ If you do not have access to the online version, follow the following recipies.
 6. Move that directory wherever you need.
 
 * Cross-compile for the android platform (from the UNIX machine)
-1. Build the host ECL
+1. Configure the toolchain (requires android-ndk version 22 or higher, known to work with version 28b)
-   #+BEGIN_SRC shell-script
-     # C99 complex numbers are not fully supported on Android
-     ./configure ABI=32 CFLAGS="-m32 -g -O2" LDFLAGS="-m32 -g -O2"\
-                 --prefix=`pwd`/ecl-android-host --disable-c99complex
-     make -j9
-     make install
-     rm -r build
-     export ECL_TO_RUN=`pwd`/ecl-android-host/bin/ecl
-   #+END_SRC
-2. Configure the toolchain (requires android-ndk version 15 or higher, known to work with version 17c)
    and export the necessary paths:
    #+BEGIN_SRC shell-script
      export NDK_PATH=/opt/android-ndk
      export ANDROID_API=23
-     export TOOLCHAIN_PATH=`pwd`/android-toolchain
+     export TOOLCHAIN_PATH=${NDK_PATH}/toolchains/llvm/prebuilt/linux-x86_64 # use darwin instead of linux if compiling on Mac OS host
-     ${NDK_PATH}/build/tools/make_standalone_toolchain.py --arch arm --install-dir ${TOOLCHAIN_PATH} --api ${ANDROID_API}
+	  export TARGET=armv7a-linux-androideabi
-     export SYSROOT=${TOOLCHAIN_PATH}/sysroot
-     export PATH=${TOOLCHAIN_PATH}/bin:$PATH
   #+END_SRC
-3. Build and install the target library
+2. Build and install the target library
    #+BEGIN_SRC shell-script
-     # boehm GC is not compatible with ld.gold linker, force use of ld.bfd
+	  export CC="${TOOLCHAIN_PATH}/bin/clang --target=${TARGET}${ANDROID_API}"
-     export LDFLAGS="--sysroot=${SYSROOT} -D__ANDROID_API__=${ANDROID_API} -fuse-ld=bfd"
+	  export LD=${TOOLCHAIN_PATH}/bin/ld
-     export CPPFLAGS="--sysroot=${SYSROOT} -D__ANDROID_API__=${ANDROID_API} -isystem ${SYSROOT}/usr/include/arm-linux-androideabi"
+	  export AR=${TOOLCHAIN_PATH}/bin/llvm-ar
-     export CC=arm-linux-androideabi-clang
+	  export RANLIB=${TOOLCHAIN_PATH}/bin/llvm-ranlib
-     ./configure --host=arm-linux-androideabi \
+     export ECL_TO_RUN=/usr/local/bin/ecl
+    ./configure --host=${TARGET} \
                  --prefix=`pwd`/ecl-android \
                  --disable-c99complex \
                  --with-cross-config=`pwd`/src/util/android-arm.cross_config
      make -j9
      make install
    #+END_SRC
-4. Library and assets in the ecl-android directory are ready to run on
+3. Library and assets in the ecl-android directory are ready to run on
    the Android system.
 
-** Building ecl-android on Darwin (OSX)
-If your host platform is darwin, then the host compiler should be
-built with the Apple's GCC (not the GCC from Macports). Using the
-MacPort command:
-#+BEGIN_SRC shell-script
-  sudo port select --set gcc none
-#+END_SRC
-
-Hint provided by Pascal J. Bourguignon.
-
 
 * Cross-compile for the iOS platform (needs Xcode 11 or higher)
-1. Build the host ECL
+1. Configure the toolchain
-   #+BEGIN_SRC shell-script
-     ./configure CFLAGS="-DECL_C_COMPATIBLE_VARIADIC_DISPATCH" --prefix=`pwd`/ecl-iOS-host --disable-c99complex
-     make -j9
-     make install
-     rm -r build
-     export ECL_TO_RUN=`pwd`/ecl-iOS-host/bin/ecl
-   #+END_SRC
-2. Configure the toolchain
    #+BEGIN_SRC shell-script
      export IOS_VERSION_MIN="8.0"
      export IOS_SDK_DIR="`xcode-select --print-path`/Platforms/iPhoneOS.platform/Developer/SDKs/iPhoneOS.sdk/"
@@ -96,10 +67,11 @@ Hint provided by Pascal J. Bourguignon.
      export LDFLAGS="-arch arm64 -pipe -std=c99 -gdwarf-2 -isysroot ${IOS_SDK_DIR}"
      export LIBS="-framework Foundation"
    #+END_SRC
-3. Build and install the target library
+2. Build and install the target library
    #+BEGIN_SRC shell-script
      export CFLAGS="$CFLAGS -DGC_DISABLE_INCREMENTAL -DECL_RWLOCK"
      export CXXFLAGS="$CFLAGS"
+     export ECL_TO_RUN=/usr/local/bin/ecl
      ./configure --host=aarch64-apple-darwin \
                  --prefix=`pwd`/ecl-iOS \
                  --disable-c99complex \
@@ -108,7 +80,7 @@ Hint provided by Pascal J. Bourguignon.
      make -j9
      make install
    #+END_SRC
-4. Library and assets in the ecl-iOS directory are ready to run on
+3. Library and assets in the ecl-iOS directory are ready to run on
    the iOS system.
 
 * Cross-compile for the WASM platform (via emscripten)
@@ -139,17 +111,7 @@ Emscripten target is a little fickle so keep in mind that:
   garbage collector to work correctly and tend slow down the program
   (might be worth experimenting with the optimization options)
 
-1. Build the host ECL
+1. Configure the toolchain
-
-#+begin_src shell-script
-  ./configure ABI=32 CFLAGS="-m32 -g -O2 -DECL_C_COMPATIBLE_VARIADIC_DISPATCH" LDFLAGS="-m32 -g -O2" \
-              --prefix=`pwd`/ecl-emscripten-host --disable-threads
-
-  make -j16 && make install
-  rm -rf build/
-#+end_src
-
-2. Configure the toolchain
 
 Install the Emscripten SDK using the official instructions:
 
@@ -162,14 +124,14 @@ After that activate the toolchain and configure build flags:
 
 #+begin_src shell-script
   source ${EMSDK_PATH}/emsdk_env.sh
-  export ECL_TO_RUN=`pwd`/ecl-emscripten-host/bin/ecl
   # You may customize various emscripten flags here, i.e:
   # export LDFLAGS="-sASYNCIFY=1"
 #+end_src
 
-3. Build the core environment and install it
+2. Build the core environment and install it
 
 #+begin_src shell-script
+  export ECL_TO_RUN=/usr/local/bin/ecl
   emconfigure ./configure \
               --host=wasm32-unknown-emscripten \
               --build=x86_64-pc-linux-gnu \
@@ -185,7 +147,7 @@ After that activate the toolchain and configure build flags:
   cp build/bin/ecl.js build/bin/ecl.wasm ecl-emscripten/
 #+end_src
 
-4. ECL may be hosted on a web page. Assuming that you have quicklisp installed:
+3. ECL may be hosted on a web page. Assuming that you have quicklisp installed:
 
 #+begin_src shell-script
   export WEBSERVER=`pwd`/src/util/webserver.lisp
@@ -199,7 +161,7 @@ After that activate the toolchain and configure build flags:
 If the output does not show on the webpage then open the javascript console.
 This is a default html website produced by emscripten.
 
-5. Build an external program linked against libecl.a
+4. Build an external program linked against libecl.a
 
 The default stack size proposed by emscripten is 64KB. This is too little for
 ECL, so when you build a program that is linked against libecl.a, then it is
@@ -234,7 +196,7 @@ For example:
 2. Build ECL
 
 #+begin_src sh
-  ./configure --disable-shared --prefix=/tmp/cosmo-cl
+  LSP_FEATURES=":cosmo" ./configure --disable-shared --prefix=/tmp/cosmo-cl
   make -j15
   make install
   # make check

msvc/Makefile

@@ -17,6 +17,9 @@ SOFTWARE_TYPE     = NT
 SOFTWARE_VERSION  = 5.0
 THEHOST           = win32
 
+# Symbols to add to *FEATURES* in the final executable
+LSP_FEATURES = :ecl :common :common-lisp :ansi-cl :ffi :prefixed-api :cdr-14 :package-local-nicknames :clos :ecl-pde :long-float :ieee-floating-point :floating-point-exceptions :boehm-gc :dlopen :msvc :windows :win32 :cmu-format :clos-streams :uint8-t :uint16-t :uint32-t :uint64-t :long-long :little-endian :ecl-weak-hash
+
 # Size of the C stack in bytes
 ECL_DEFAULT_C_STACK_SIZE = 1048576
 
@@ -180,43 +183,62 @@ LIBRARIES     =
 TARGETS       = ecl2$(EXE)
 DEF           = ecl.def
 
+# Set features
+#
+LSP_FEATURES = :$(ARCHITECTURE) $(LSP_FEATURES)
+!if "$(ECL_WIN64)" != ""
+LSP_FEATURES = :win64 $(LSP_FEATURES)
+!endif
+!if "$(ECL_THREADS)" != ""
+LSP_FEATURES = :threads :ecl-read-write-lock $(LSP_FEATURES)
+!endif
+!if "$(ECL_UNICODE)" != ""
+LSP_FEATURES = :unicode $(LSP_FEATURES)
+!endif
+!if "$(ECL_SSE)" != ""
+LSP_FEATURES = :sse2 $(LSP_FEATURES)
+!endif
+!ifdef ECL_SOCKETS
+LSP_FEATURES = :wsock $(LSP_FEATURES)
+!endif
+
 # Additional modules
 # 
 ECL_MODULES  =
-ECL_FEATURES = (cons :wants-dlopen *features*)
+COMPILATION_FEATURES = :wants-dlopen
 !ifdef ECL_CMP
 ECL_MODULES  = $(ECL_MODULES) cmp
-ECL_FEATURES = (cons :wants-cmp $(ECL_FEATURES))
+COMPILATION_FEATURES = :wants-cmp $(COMPILATION_FEATURES)
 !endif
 !ifdef ECL_ASDF
 ECL_MODULES  = $(ECL_MODULES) asdf
-ECL_FEATURES = (cons :wants-asdf $(ECL_FEATURES))
+COMPILATION_FEATURES = :wants-asdf $(COMPILATION_FEATURES)
 !endif
 !ifdef ECL_SOCKETS
 ECL_MODULES  = $(ECL_MODULES) sockets
-ECL_FEATURES = (cons :wants-sockets $(ECL_FEATURES))
+COMPILATION_FEATURES = :wants-sockets $(COMPILATION_FEATURES)
 !endif
 !ifdef ECL_RT
 ECL_MODULES  = $(ECL_MODULES) rt
-ECL_FEATURES = (cons :wants-rt $(ECL_FEATURES))
+COMPILATION_FEATURES = :wants-rt $(COMPILATION_FEATURES)
 !endif
 !ifdef ECL_DEFSYS
 ECL_MODULES  = $(ECL_MODULES) defsystem
-ECL_FEATURES = (cons :wants-defsystem $(ECL_FEATURES))
+COMPILATION_FEATURES = :wants-defsystem $(COMPILATION_FEATURES)
 !endif
 !ifdef ECL_PROFILE
 ECL_MODULES  = $(ECL_MODULES) profile
-ECL_FEATURES = (cons :wants-profile $(ECL_FEATURES))
+COMPILATION_FEATURES = :wants-profile $(COMPILATION_FEATURES)
 !endif
 ECL_MODULES  = $(ECL_MODULES) bytecmp
-ECL_FEATURES = (list* :builtin-bytecmp :wants-bytecmp $(ECL_FEATURES))
+COMPILATION_FEATURES = :builtin-bytecmp :wants-bytecmp $(COMPILATION_FEATURES)
 ECL_MODULES  = $(ECL_MODULES) ecl-curl
-ECL_FEATURES = (cons :wants-ecl-curl $(ECL_FEATURES))
+COMPILATION_FEATURES = :wants-ecl-curl $(COMPILATION_FEATURES)
 ECL_MODULES  = $(ECL_MODULES) deflate
-ECL_FEATURES = (cons :wants-deflate $(ECL_FEATURES))
+COMPILATION_FEATURES = :wants-deflate $(COMPILATION_FEATURES)
 
 !MESSAGE ECL Modules: $(ECL_MODULES)
-!MESSAGE ECL Features: $(ECL_FEATURES)
+!MESSAGE ECL Features: $(COMPILATION_FEATURES)
 
 # Build rules
 # 
@@ -289,7 +311,8 @@ compile.lsp: bare.lsp $(srcdir)/compile.lsp.in Makefile
 	    "@LDINSTALLNAME@" "" \
 	    "@DEF@" "$(DEF)" \
             "@RANLIB@" "ranlib" \
-	    "@LSP_FEATURES@" "$(ECL_FEATURES)" \
+	    "@LSP_FEATURES@" "$(LSP_FEATURES)" \
+	    "@COMPILATION_FEATURES@" "$(COMPILATION_FEATURES)" \
 	    "@ECL_CMPDIR@" "cmp" \
 	    "@ECL_EXTRA_LISP_FILES@" "" \
 	    "@ECL_INIT_FORM@" "(si::top-level t)" \
@@ -329,6 +352,9 @@ cmp/cmpdefs.lsp: $(srcdir)/cmp/cmpdefs.lsp Makefile
 	    "@ecldir\@" "NIL" \
 	    "@libdir\@" "NIL" \
 	    "@includedir\@" "NIL" \
+	    "@ARCHITECTURE@" "$(ARCHITECTURE)"\
+	    "@SOFTWARE_TYPE@" "$(SOFTWARE_TYPE)"\
+	    "@PACKAGE_VERSION@" "$(PACKAGE_VERSION)"\
 	    < $(srcdir)\cmp\cmpdefs.lsp > cmp\cmpdefs.lsp
 ecl-config.bat: util\ecl-config.bat Makefile
 	c\cut "~A" "$(libdir:\=/)"\
@@ -346,9 +372,12 @@ ecl-cc.bat: util\ecl-cc.bat Makefile
 	      "@libdir@" "$(prefix:\=/)" \
 	      "@includedir@" "$(prefix:\=/)/ecl" \
 	      < util\ecl-cc.bat > ecl-cc.bat
+c/ecl_features.h: $(srcdir)/c/ecl_features.h.in Makefile
+	c\cut "@LSP_FEATURES@" "$(LSP_FEATURES)" \
+	      < $(srcdir)\c\ecl_features.h.in > c\ecl_features.h
 
 
-eclmin.lib: eclgmp.lib eclgc.lib lsp/config.lsp
+eclmin.lib: eclgmp.lib eclgc.lib lsp/config.lsp c/ecl_features.h
 	cd c
 	$(MAKE) /nologo ECL_VERSION_NUMBER=$(ECL_VERSION_NUMBER) \
                 ECL_DEFAULT_C_STACK_SIZE=$(ECL_DEFAULT_C_STACK_SIZE) \

src/aclocal.m4

@@ -24,6 +24,7 @@ AC_DEFUN([ECL_COMPLEX_C99],[
   fi
   if test "$enable_c99complex" != "no" ; then
     AC_DEFINE([ECL_COMPLEX_FLOAT], [], [ECL_COMPLEX_FLOAT])
+    ECL_ADD_FEATURE(complex-float)
     AC_MSG_RESULT("C99 Complex Float support is available")
   else
     AC_MSG_RESULT("C99 Complex Float support is not available")
@@ -73,13 +74,20 @@ else
   AC_DEFINE([ecl_long_long_t], [long long], [compiler understands long long])
   AC_DEFINE([ecl_ulong_long_t], [unsigned long long], [compiler understands long long])
   AC_DEFINE_UNQUOTED([ECL_LONG_LONG_BITS],[$ECL_LONG_LONG_BITS], [ECL_LONG_LONG_BITS])
+  AC_SUBST(ECL_LONG_LONG_BITS)
+  ECL_ADD_FEATURE(long-long)
 fi
 ])
 
 dnl --------------------------------------------------------------
-dnl Add *feature* for conditional compilation.
+dnl Add *feature* for the target executable.
 AC_DEFUN([ECL_ADD_FEATURE], [
-LSP_FEATURES="(cons :$1 ${LSP_FEATURES})"
+LSP_FEATURES="${LSP_FEATURES} :$1"
+])
+dnl --------------------------------------------------------------
+dnl Add *feature* for conditional compilation.
+AC_DEFUN([ECL_ADD_COMPILATION_FEATURE], [
+COMPILATION_FEATURES=":$1 ${COMPILATION_FEATURES}"
 ])
 
 dnl --------------------------------------------------------------
@@ -88,14 +96,14 @@ dnl compile module into Lisp library if we don't support shared
 dnl libraries.
 dnl
 AC_DEFUN([ECL_ADD_LISP_MODULE], [
-  ECL_ADD_FEATURE([wants-$1])
+  ECL_ADD_COMPILATION_FEATURE([wants-$1])
 ])
 
 dnl --------------------------------------------------------------
 dnl Add lisp module and build it into the compiler.
 dnl
 AC_DEFUN([ECL_ADD_BUILTIN_MODULE], [
-  ECL_ADD_FEATURE([builtin-$1])
+  ECL_ADD_COMPILATION_FEATURE([builtin-$1])
 ])
 
 dnl --------------------------------------------------------------
@@ -131,6 +139,7 @@ CL_FIXNUM_TYPE=int
 CL_FIXNUM_BITS=32
 CL_FIXNUM_MAX=536870911L
 CL_FIXNUM_MIN=-536870912L
+CL_SHORT_BITS=32
 CL_INT_BITS=32
 CL_LONG_BITS=32
 
@@ -197,7 +206,7 @@ EOF
   (echo '#!/bin/sh'; echo exec ${ECL_MIN_TO_RUN} '$''*') > CROSS-COMPILER
   (echo '#!/bin/sh'; echo exec ${DPP_TO_RUN} '$''*') > CROSS-DPP
   chmod +x CROSS-COMPILER CROSS-DPP
-  ECL_ADD_FEATURE([cross])
+  ECL_ADD_COMPILATION_FEATURE([cross])
 fi
 ])
 
@@ -273,18 +282,17 @@ SONAME=''
 SONAME_LDFLAGS=''
 case "${host_os}" in
         linux-android*)
-                thehost='android'
+                thehost='ANDROID'
                 THREAD_CFLAGS='-D_THREAD_SAFE'
-#               THREAD_LIBS='-lpthread'
                 SHARED_LDFLAGS="-shared ${LDFLAGS}"
                 BUNDLE_LDFLAGS="-shared ${LDFLAGS}"
                 ECL_LDRPATH='-Wl,--rpath,~A'
                 clibs="-ldl ${clibs}"
-                # Maybe CFLAGS="-D_ISOC99_SOURCE ${CFLAGS}" ???
                 CFLAGS="-D_GNU_SOURCE -DPLATFORM_ANDROID -DUSE_GET_STACKBASE_FOR_MAIN -DIGNORE_DYNAMIC_LOADING ${CFLAGS}"
-                ECL_ADD_FEATURE([android])
                 SONAME="${SHAREDPREFIX}ecl.${SHAREDEXT}"
                 SONAME_LDFLAGS="-Wl,-soname,SONAME"
+                ECL_ADD_FEATURE([android])
+                ECL_ADD_FEATURE([unix])
                 ;;
 
         # libdir may have a dollar expression inside
@@ -300,6 +308,7 @@ case "${host_os}" in
                 CFLAGS="-D_GNU_SOURCE -D_FILE_OFFSET_BITS=64 ${CFLAGS}"
                 SONAME="${SHAREDPREFIX}ecl.${SHAREDEXT}.SOVERSION"
                 SONAME_LDFLAGS="-Wl,-soname,SONAME"
+                ECL_ADD_FEATURE([unix])
                 ;;
         gnu*)
                 thehost='gnu'
@@ -312,6 +321,7 @@ case "${host_os}" in
                 CFLAGS="-D_GNU_SOURCE ${CFLAGS}"
                 SONAME="${SHAREDPREFIX}ecl.${SHAREDEXT}.SOVERSION"
                 SONAME_LDFLAGS="-Wl,-soname,SONAME"
+                ECL_ADD_FEATURE([unix])
                 ;;
         kfreebsd*-gnu)
                 thehost='kfreebsd'
@@ -324,6 +334,8 @@ case "${host_os}" in
                 CFLAGS="-D_GNU_SOURCE ${CFLAGS}"
                 SONAME="${SHAREDPREFIX}ecl.${SHAREDEXT}.SOVERSION"
                 SONAME_LDFLAGS="-Wl,-soname,SONAME"
+                ECL_ADD_FEATURE([unix])
+                ECL_ADD_FEATURE([bsd])
                 ;;
         dragonfly*)
                 thehost='dragonfly'
@@ -334,6 +346,8 @@ case "${host_os}" in
                 clibs="${clibs}"
                 SONAME="${SHAREDPREFIX}ecl.${SHAREDEXT}.SOVERSION"
                 SONAME_LDFLAGS="-Wl,-soname,SONAME"
+                ECL_ADD_FEATURE([unix])
+                ECL_ADD_FEATURE([bsd])
                 ;;
         freebsd*)
                 thehost='freebsd'
@@ -344,6 +358,8 @@ case "${host_os}" in
                 clibs="${clibs}"
                 SONAME="${SHAREDPREFIX}ecl.${SHAREDEXT}.SOVERSION"
                 SONAME_LDFLAGS="-Wl,-soname,SONAME"
+                ECL_ADD_FEATURE([unix])
+                ECL_ADD_FEATURE([bsd])
                 ;;
         netbsd*)
                 thehost='netbsd'
@@ -354,6 +370,8 @@ case "${host_os}" in
                 clibs="${clibs}"
                 SONAME="${SHAREDPREFIX}ecl.${SHAREDEXT}.SOVERSION"
                 SONAME_LDFLAGS="-Wl,-soname,SONAME"
+                ECL_ADD_FEATURE([unix])
+                ECL_ADD_FEATURE([bsd])
                 ;;
         openbsd*)
                 thehost='openbsd'
@@ -365,6 +383,8 @@ case "${host_os}" in
                 clibs="-lpthread ${clibs}"
                 SONAME="${SHAREDPREFIX}ecl.${SHAREDEXT}.SOVERSION"
                 SONAME_LDFLAGS="-Wl,-soname,SONAME"
+                ECL_ADD_FEATURE([unix])
+                ECL_ADD_FEATURE([bsd])
                 ;;
         solaris*)
                 thehost='sun4sol2'
@@ -381,6 +401,7 @@ case "${host_os}" in
                   SHARED_LDFLAGS="-shared $SHARED_LDFLAGS"
                   BUNDLE_LDFLAGS="-shared $BUNDLE_LDFLAGS"
                 fi
+                ECL_ADD_FEATURE([unix])
                 ;;
         cygwin*)
                 thehost='cygwin'
@@ -398,6 +419,8 @@ case "${host_os}" in
                    # Windows64 calling conventions.
                    with_c_gmp=yes
                 fi
+                ECL_ADD_FEATURE([cygwin])
+                ECL_ADD_FEATURE([unix])
                 ;;
         mingw*)
                 thehost='mingw32'
@@ -415,6 +438,15 @@ case "${host_os}" in
                 PICFLAG=''
                 INSTALL_TARGET='flatinstall'
                 TCPLIBS='-lws2_32'
+                if test "${with_tcp}" = "yes"; then
+                  ECL_ADD_FEATURE(wsock)
+                fi
+                ECL_ADD_FEATURE([mingw32])
+                ECL_ADD_FEATURE([win32])
+                ECL_ADD_FEATURE([windows])
+                if test "x$host_cpu" = "xx86_64" ; then
+		   ECL_ADD_FEATURE([win64])
+                fi
                 ;;
         darwin*)
                 thehost='darwin'
@@ -451,6 +483,11 @@ case "${host_os}" in
                 fi
                 SONAME="${SHAREDPREFIX}ecl.SOVERSION.${SHAREDEXT}"
                 SONAME_LDFLAGS="-Wl,-install_name,@rpath/SONAME -Wl,-compatibility_version,${PACKAGE_VERSION}"
+                if test "`uname -m`" = arm64; then
+                  AC_DEFINE([ECL_C_COMPATIBLE_VARIADIC_DISPATCH], [], [Do the fixed and optional arguments of a variadic function use a different calling convention?])
+                  ECL_ADD_FEATURE(c-compatible-variadic-dispatch)
+                fi
+                ECL_ADD_FEATURE(unix)
                 ;;
         nsk*)
                 # HP Non-Stop platform
@@ -472,6 +509,7 @@ case "${host_os}" in
                 clibs="-lnetwork"
                 SONAME="${SHAREDPREFIX}ecl.${SHAREDEXT}.SOVERSION"
                 SONAME_LDFLAGS="-Wl,-soname,SONAME"
+                ECL_ADD_FEATURE(haiku)
                 ;;
 	aix*)
 		PICFLAG='-DPIC'
@@ -486,6 +524,7 @@ case "${host_os}" in
         *)
                 thehost="$host_os"
                 shared="no"
+                ECL_ADD_FEATURE(unix)
                 ;;
 esac
 
@@ -519,6 +558,7 @@ case "${host}" in
                 THREAD_LIBS=''
                 CFLAGS="-D_GNU_SOURCE -D_FILE_OFFSET_BITS=64 -DANDROID -DPLATFORM_ANDROID -DUSE_GET_STACKBASE_FOR_MAIN -DIGNORE_DYNAMIC_LOADING -DNO_GETCONTEXT -DHAVE_GETTIMEOFDAY -DHAVE_SIGPROCMASK ${CFLAGS}"
                 ECL_ADD_FEATURE([android])
+                ECL_ADD_FEATURE(unix)
                 ;;
         wasm32-unknown-emscripten)
                 # Non-zero optimization levels seem to be slower in
@@ -538,6 +578,9 @@ case "${host}" in
                 BUNDLE_LDFLAGS="-shared -sSIDE_MODULE ${LDFLAGS}"
                 PROGRAM_LDFLAGS="-sMAIN_MODULE -sERROR_ON_UNDEFINED_SYMBOLS=0 ${LDFLAGS}"
                 INSTALL_TARGET='flatinstall'
+                AC_DEFINE([ECL_C_COMPATIBLE_VARIADIC_DISPATCH], [], [Do the fixed and optional arguments of a variadic function use a different calling convention?])
+                ECL_ADD_FEATURE(c-compatible-variadic-dispatch)
+                ECL_ADD_FEATURE(emscripten)
                 ;;
 esac
 
@@ -603,7 +646,7 @@ fi
 
 dnl ---------------------------------------------------------------------
 dnl Check availability of standard sized integer types of a given width.  
-dnl On success, define the global variables ECL_INTx_T and ECL_UNITx_T to 
+dnl On success, define the global variables ECL_INTx_T and ECL_UINTx_T to
 dnl hold the names of the corresponding standard C integer types.
 AC_DEFUN(ECL_CHECK_SIZED_INTEGER_TYPE,[
 AC_TYPE_INT$1_T
@@ -613,6 +656,7 @@ if test "x$ac_cv_c_int$1_t" = xyes; then
   eval ECL_UINT$1_T="uint$1_t"
   AC_DEFINE_UNQUOTED([ecl_int$1_t], [int$1_t], [ecl_int$1_t])
   AC_DEFINE_UNQUOTED([ecl_uint$1_t], [uint$1_t], [ecl_uint$1_t])
+  ECL_ADD_FEATURE(uint$1-t)
 fi])
 
 dnl
@@ -731,6 +775,7 @@ AC_SUBST(CL_FIXNUM_TYPE)
 AC_SUBST(CL_FIXNUM_BITS)
 AC_SUBST(CL_FIXNUM_MAX)
 AC_SUBST(CL_FIXNUM_MIN)
+AC_SUBST(CL_SHORT_BITS)
 AC_SUBST(CL_INT_BITS)
 AC_SUBST(CL_LONG_BITS)
 AC_MSG_CHECKING(appropriate type for fixnums)
@@ -792,6 +837,13 @@ int main() {
   }
   fprintf(f,"CL_FIXNUM_TYPE='%s';",int_type);
   fprintf(f,"CL_FIXNUM_BITS='%d';",bits);
+  {
+    unsigned short x = 1;
+    for (bits = 0; x; bits++) {
+      x <<= 1;
+    }
+    fprintf(f,"CL_SHORT_BITS='%d';",bits);
+  }
   {
     unsigned int x = 1;
     for (bits = 0; x; bits++) {
@@ -947,6 +999,7 @@ _mm_getcsr();]])],[sse_included=yes],[sse_included=no])
  fi
  if test "x$with_sse" = xyes; then
   AC_DEFINE([ECL_SSE2], [], [ECL_SSE2])
+  ECL_ADD_FEATURE(sse2)
   AC_MSG_RESULT([yes])
  else
   AC_MSG_RESULT([no])
@@ -1184,6 +1237,7 @@ else
 fi
 if test "${enable_serialization}" != "no" ; then
   AC_DEFINE([ECL_EXTERNALIZABLE], [], [Use the serialization framework])
+  ECL_ADD_FEATURE(externalizable)
 fi
 ])
 
@@ -1248,6 +1302,7 @@ if test -z "${ECL_LIBFFI_HEADER}"; then
   AC_MSG_WARN([Unable to configure or find libffi library; disabling dynamic FFI])
 else
   AC_DEFINE([HAVE_LIBFFI], [], [HAVE_LIBFFI])
+  ECL_ADD_FEATURE(dffi)  
 fi
 ])
 

src/bare.lsp.in

@@ -42,6 +42,30 @@
 
 (setq si::+commit-id+ "UNKNOWN")
 
+;;;
+;;; * Setup cross compilation
+;;;
+
+(when (member "CROSS" *features* :test #'string-equal)
+  (sys:*make-constant 'most-negative-fixnum (parse-integer "@CL_FIXNUM_MIN@" :junk-allowed t))
+  (sys:*make-constant 'most-positive-fixnum (parse-integer "@CL_FIXNUM_MAX@" :junk-allowed t))
+  (sys:*make-constant 'cl-fixnum-bits @CL_FIXNUM_BITS@)
+  (sys:*make-constant 'array-dimension-limit most-positive-fixnum)
+  (sys:*make-constant 'array-total-size-limit most-positive-fixnum)
+  (sys:*make-constant 'ffi:c-short-min (- (ash 1 (1- @CL_SHORT_BITS@))))
+  (sys:*make-constant 'ffi:c-short-max (1- (ash 1 (1- @CL_SHORT_BITS@))))
+  (sys:*make-constant 'ffi:c-ushort-max (1- (ash 1 @CL_SHORT_BITS@)))
+  (sys:*make-constant 'ffi:c-int-min (- (ash 1 (1- @CL_INT_BITS@))))
+  (sys:*make-constant 'ffi:c-int-max (1- (ash 1 (1- @CL_INT_BITS@))))
+  (sys:*make-constant 'ffi:c-uint-max (1- (ash 1 @CL_INT_BITS@)))
+  (sys:*make-constant 'ffi:c-long-min (- (ash 1 (1- @CL_LONG_BITS@))))
+  (sys:*make-constant 'ffi:c-long-max (1- (ash 1 (1- @CL_LONG_BITS@))))
+  (sys:*make-constant 'ffi:c-ulong-max (1- (ash 1 @CL_LONG_BITS@)))
+  (when (member "LONG-LONG" *features* :test #'string-equal)
+    (sys:*make-constant 'ffi:c-long-long-min (- (ash 1 (1- @ECL_LONG_LONG_BITS@))))
+    (sys:*make-constant 'ffi:c-long-long-max (1- (ash 1 (1- @ECL_LONG_LONG_BITS@))))
+    (sys:*make-constant 'ffi:c-ulong-long-max (1- (ash 1 @ECL_LONG_LONG_BITS@)))))
+
 ;;;
 ;;; * Load Common-Lisp base library
 ;;;

src/c/clos/instance.d

@@ -327,7 +327,7 @@ ecl_slot_value_set(cl_object x, const char *slot, cl_object value)
 }
 
 /**********************************************************************
- * IMPORTANT: THE FOLLOWING LIST IS LINKED TO src/clos/builtin.lsp
+ * IMPORTANT: THE FOLLOWING LIST IS LINKED TO src/clos/hierarchy.lsp
  **********************************************************************/
 enum ecl_built_in_classes {
   ECL_BUILTIN_T = 0,
@@ -337,9 +337,7 @@ enum ecl_built_in_classes {
   ECL_BUILTIN_ARRAY,
   ECL_BUILTIN_VECTOR,
   ECL_BUILTIN_STRING,
-#ifdef ECL_UNICODE
   ECL_BUILTIN_BASE_STRING,
-#endif
   ECL_BUILTIN_BIT_VECTOR,
   ECL_BUILTIN_STREAM,
   ECL_BUILTIN_ANSI_STREAM,
@@ -364,12 +362,10 @@ enum ecl_built_in_classes {
   ECL_BUILTIN_DOUBLE_FLOAT,
   ECL_BUILTIN_LONG_FLOAT,
   ECL_BUILTIN_COMPLEX,
-#ifdef ECL_COMPLEX_FLOAT
   ECL_BUILTIN_COMPLEX_FLOAT,
   ECL_BUILTIN_COMPLEX_SINGLE_FLOAT,
   ECL_BUILTIN_COMPLEX_DOUBLE_FLOAT,
   ECL_BUILTIN_COMPLEX_LONG_FLOAT,
-#endif
   ECL_BUILTIN_SYMBOL,
   ECL_BUILTIN_NULL,
   ECL_BUILTIN_KEYWORD,
@@ -383,20 +379,15 @@ enum ecl_built_in_classes {
   ECL_BUILTIN_CODE_BLOCK,
   ECL_BUILTIN_FOREIGN_DATA,
   ECL_BUILTIN_FRAME,
-  ECL_BUILTIN_WEAK_POINTER
+  ECL_BUILTIN_WEAK_POINTER,
-#ifdef ECL_THREADS
-  ,
   ECL_BUILTIN_PROCESS,
   ECL_BUILTIN_LOCK,
   ECL_BUILTIN_RWLOCK,
   ECL_BUILTIN_CONDITION_VARIABLE,
   ECL_BUILTIN_SEMAPHORE,
   ECL_BUILTIN_BARRIER,
-  ECL_BUILTIN_MAILBOX
+  ECL_BUILTIN_MAILBOX,
-#endif
+  ECL_BUILTIN_SSE_PACK
-#ifdef ECL_SSE2
-  , ECL_BUILTIN_SSE_PACK
-#endif
 };
 
 cl_object

src/c/compiler.d

@@ -421,6 +421,7 @@ c_register_captured(cl_env_ptr env, cl_object c)
  *     SI:FUNCTION-BOUNDARY |
  *     SI:UNWIND-PROTECT-BOUNDARY
  *     (:declare declaration-arguments*)
+ *     (:type type-name [type-definition | expansion-function])
  * macro-record =
  *     (function-name FUNCTION [| function-object]) |
  *     (macro-name si::macro macro-function) |
@@ -948,7 +949,7 @@ c_var_ref(cl_env_ptr env, cl_object var, bool allow_sym_mac, bool ensure_def)
     type = pop(&reg);
     special = pop(&reg);
     if (type == @':block' || type == @':tag' || type == @':function'
-        || type == @':declare' || type != var) {
+        || type == @':declare' || type == @':type' || type != var) {
       continue;
     } else if (Null(special)) {
       if (function_boundary_crossed) {
@@ -1098,7 +1099,7 @@ c_undo_bindings(cl_env_ptr the_env, cl_object old_vars, int only_specials)
         if (!only_specials) num_lexical++;
       } else if (name == @':function' || Null(special)) {
         if (!only_specials) num_lexical++;
-      } else if (name == @':declare') {
+      } else if (name == @':declare' || name == @':type') {
         /* Ignored */
       } else if (special != @'si::symbol-macro') {
         /* If (third special) = NIL, the variable was declared

src/c/ecl_features.h

@@ -1,127 +0,0 @@
-/* -*- Mode: C; c-basic-offset: 2; indent-tabs-mode: nil -*- */
-/* vim: set filetype=c tabstop=2 shiftwidth=2 expandtab: */
-
-/*
- * ecl_features.h - names of features compiled into ECL
- *
- * Copyright (c) 1984 Taiichi Yuasa and Masami Hagiya
- * Copyright (c) 1990 Giuseppe Attardi
- * Copyright (c) 2001 Juan Jose Garcia Ripoll
- *
- * See file 'LICENSE' for the copyright details.
- *
- */
-
-ecl_def_string_array(feature_names,static,const) = {
-  ecl_def_string_array_elt("ECL"),
-  ecl_def_string_array_elt("COMMON"),
-  ecl_def_string_array_elt(ECL_ARCHITECTURE),
-  ecl_def_string_array_elt("FFI"),
-  ecl_def_string_array_elt("PREFIXED-API"),
-  ecl_def_string_array_elt("CDR-14"),
-  ecl_def_string_array_elt("PACKAGE-LOCAL-NICKNAMES"),
-#ifdef ECL_IEEE_FP
-  ecl_def_string_array_elt("IEEE-FLOATING-POINT"),
-#endif
-#if !defined(ECL_IEEE_FP) || !defined(ECL_AVOID_FPE_H)
-  ecl_def_string_array_elt("FLOATING-POINT-EXCEPTIONS"),
-#endif
-  ecl_def_string_array_elt("COMMON-LISP"),
-  ecl_def_string_array_elt("ANSI-CL"),
-#if defined(GBC_BOEHM)
-  ecl_def_string_array_elt("BOEHM-GC"),
-#endif
-#ifdef ECL_THREADS
-  ecl_def_string_array_elt("THREADS"),
-#endif
-  ecl_def_string_array_elt("CLOS"),
-#ifdef ENABLE_DLOPEN
-  ecl_def_string_array_elt("DLOPEN"),
-#endif
-  ecl_def_string_array_elt("ECL-PDE"),
-#if defined(unix) || defined(netbsd) || defined(openbsd) || defined(linux) || defined(darwin) || \
-  defined(freebsd) || defined(dragonfly) || defined(kfreebsd) || defined(gnu) || defined(nsk) || defined(aix)
-  ecl_def_string_array_elt("UNIX"),
-#endif
-#ifdef BSD
-  ecl_def_string_array_elt("BSD"),
-#endif
-#ifdef SYSV
-  ecl_def_string_array_elt("SYSTEM-V"),
-#endif
-#if defined(__MINGW32__)
-  ecl_def_string_array_elt("MINGW32"),
-  ecl_def_string_array_elt("WIN32"),
-#endif
-#if defined(__WIN64__)
-  ecl_def_string_array_elt("WIN64"),
-#endif
-#ifdef _MSC_VER
-  ecl_def_string_array_elt("MSVC"),
-#endif
-#if defined(ECL_MS_WINDOWS_HOST)
-  ecl_def_string_array_elt("WINDOWS"),
-#endif
-#if defined(__COSMOPOLITAN__)
-  ecl_def_string_array_elt("COSMO"),
-#endif
-#ifdef ECL_CMU_FORMAT
-  ecl_def_string_array_elt("CMU-FORMAT"),
-#endif
-#ifdef ECL_CLOS_STREAMS
-  ecl_def_string_array_elt("CLOS-STREAMS"),
-#endif
-#if defined(HAVE_LIBFFI)
-  ecl_def_string_array_elt("DFFI"),
-#endif
-#ifdef ECL_UNICODE
-  ecl_def_string_array_elt("UNICODE"),
-#endif
-  ecl_def_string_array_elt("LONG-FLOAT"),
-#ifdef ECL_COMPLEX_FLOAT
-  ecl_def_string_array_elt("COMPLEX-FLOAT"),
-#endif
-#ifdef ecl_uint16_t
-  ecl_def_string_array_elt("UINT16-T"),
-#endif
-#ifdef ecl_uint32_t
-  ecl_def_string_array_elt("UINT32-T"),
-#endif
-#ifdef ecl_uint64_t
-  ecl_def_string_array_elt("UINT64-T"),
-#endif
-#ifdef ecl_long_long_t
-  ecl_def_string_array_elt("LONG-LONG"),
-#endif
-#ifdef ECL_EXTERNALIZABLE
-  ecl_def_string_array_elt("EXTERNALIZABLE"),
-#endif
-#ifdef ECL_CXX_CORE
-  ecl_def_string_array_elt("CXX-CORE"),
-#endif
-#ifdef ECL_SSE2
-  ecl_def_string_array_elt("SSE2"),
-#endif
-#ifdef ECL_SEMAPHORES
-  ecl_def_string_array_elt("SEMAPHORES"),
-#endif
-#if defined(HAVE_POSIX_RWLOCK) || defined(ECL_WINDOWS_THREADS)
-  ecl_def_string_array_elt("ECL-READ-WRITE-LOCK"),
-#endif
-#ifdef WORDS_BIGENDIAN
-  ecl_def_string_array_elt("BIG-ENDIAN"),
-#else
-  ecl_def_string_array_elt("LITTLE-ENDIAN"),
-#endif
-#ifdef ECL_WEAK_HASH
-  ecl_def_string_array_elt("ECL-WEAK-HASH"),
-#endif
-#ifdef ECL_WSOCK
-  ecl_def_string_array_elt("WSOCK"),
-#endif
-#ifdef ECL_C_COMPATIBLE_VARIADIC_DISPATCH
-  ecl_def_string_array_elt("C-COMPATIBLE-VARIADIC-DISPATCH"),
-#endif
-  ecl_def_string_array_elt(0)
-};
-

src/c/ecl_features.h.in

@@ -0,0 +1,17 @@
+/* -*- Mode: C; c-basic-offset: 2; indent-tabs-mode: nil -*- */
+/* vim: set filetype=c tabstop=2 shiftwidth=2 expandtab: */
+
+/*
+ * ecl_features.h - names of features compiled into ECL
+ *
+ * Copyright (c) 1984 Taiichi Yuasa and Masami Hagiya
+ * Copyright (c) 1990 Giuseppe Attardi
+ * Copyright (c) 2001 Juan Jose Garcia Ripoll
+ *
+ * See file 'LICENSE' for the copyright details.
+ *
+ */
+
+#define FEATURE_NAMES "(@LSP_FEATURES@)"
+ecl_def_ct_base_string(feature_names, FEATURE_NAMES, sizeof(FEATURE_NAMES)-1, static, const);
+

src/c/main.d

@@ -479,7 +479,6 @@ int
 cl_boot(int argc, char **argv)
 {
   cl_object aux;
-  cl_object features;
   int i;
   cl_env_ptr env;
 
@@ -687,6 +686,7 @@ cl_boot(int argc, char **argv)
   ECL_SET(@'ffi::c-uint-max', ecl_make_unsigned_integer(UINT_MAX));
   ECL_SET(@'ffi::c-ulong-max', ecl_make_unsigned_integer(ULONG_MAX));
 #ifdef ecl_long_long_t
+  ECL_SET(@'ffi::c-long-long-min', ecl_make_long_long(LLONG_MIN));
   ECL_SET(@'ffi::c-long-long-max', ecl_make_long_long(LLONG_MAX));
   ECL_SET(@'ffi::c-ulong-long-max', ecl_make_ulong_long(ULLONG_MAX));
 #endif
@@ -752,14 +752,7 @@ cl_boot(int argc, char **argv)
           cl_list(8, @'&optional', @'&rest', @'&key', @'&allow-other-keys',
                   @'&aux', @'&whole', @'&environment', @'&body'));
 
-  for (i = 0, features = ECL_NIL; feature_names[i].elt.self; i++) {
+  ECL_SET(@'*features*', cl_read(1, cl_make_string_input_stream(1, feature_names)));
-    int flag;
-    cl_object name = (cl_object)(feature_names + i);
-    cl_object key = ecl_intern(name, cl_core.keyword_package, &flag);
-    features = CONS(key, features);
-  }
-
-  ECL_SET(@'*features*', features);
 
   ECL_SET(@'*package*', cl_core.lisp_package);
 

src/c/symbols_list.h

@@ -2378,6 +2378,7 @@ cl_symbols[] = {
 {FFI_ "C-SHORT-MIN" ECL_FUN(NULL, NULL, -1) ECL_VAR(FFI_CONSTANT, ecl_make_fixnum(SHRT_MIN))},
 {FFI_ "C-LONG-MAX" ECL_FUN(NULL, NULL, -1) ECL_VAR(FFI_CONSTANT, OBJNULL)},
 {FFI_ "C-LONG-MIN" ECL_FUN(NULL, NULL, -1) ECL_VAR(FFI_CONSTANT, OBJNULL)},
+{FFI_ "C-LONG-LONG-MIN" ECL_FUN(NULL, NULL, -1) ECL_VAR(FFI_CONSTANT, OBJNULL)},
 {FFI_ "C-LONG-LONG-MAX" ECL_FUN(NULL, NULL, -1) ECL_VAR(FFI_CONSTANT, OBJNULL)},
 {FFI_ "C-UCHAR-MAX" ECL_FUN(NULL, NULL, -1) ECL_VAR(FFI_CONSTANT, ecl_make_fixnum(UCHAR_MAX))},
 {FFI_ "C-UINT-MAX" ECL_FUN(NULL, NULL, -1) ECL_VAR(FFI_CONSTANT, OBJNULL)},

src/clos/hierarchy.lsp

@@ -186,8 +186,7 @@
             (array)
               (vector array sequence)
                 (string vector)
-                #+unicode
+                (:unicode base-string string vector)
-                (base-string string vector)
                 (bit-vector vector)
             (stream)
               (ext:ansi-stream stream)
@@ -212,10 +211,10 @@
                   (double-float float)
                   (long-float float)
             (complex number)
-              #+complex-float (si:complex-float complex)
+              (:complex-float si:complex-float complex)
-              #+complex-float (si:complex-single-float si:complex-float)
+              (:complex-float si:complex-single-float si:complex-float)
-              #+complex-float (si:complex-double-float si:complex-float)
+              (:complex-float si:complex-double-float si:complex-float)
-              #+complex-float (si:complex-long-float   si:complex-float)
+              (:complex-float si:complex-long-float   si:complex-float)
            (symbol)
               (null symbol list)
               (keyword symbol)
@@ -230,14 +229,14 @@
             (si::foreign-data)
             (si::frame)
             (si::weak-pointer)
-            #+threads (mp::process)
+            (:threads mp::process)
-            #+threads (mp::lock)
+            (:threads mp::lock)
-            #+threads (mp::rwlock)
+            (:threads mp::rwlock)
-            #+threads (mp::condition-variable)
+            (:threads mp::condition-variable)
-            #+threads (mp::semaphore)
+            (:threads mp::semaphore)
-            #+threads (mp::barrier)
+            (:threads mp::barrier)
-            #+threads (mp::mailbox)
+            (:threads mp::mailbox)
-            #+sse2 (ext::sse-pack))))
+            (:sse2 ext::sse-pack))))
 
 ;;; FROM AMOP:
 ;;;
@@ -335,6 +334,11 @@
        :direct-slots #1#)
       ,@(loop for (name . rest) in +builtin-classes-list+
            for index from 1
+           for feature-flag = (if (keywordp name)
+                                  (prog1 name
+                                    (setf name (first rest) rest (rest rest)))
+                                  nil)
+           when (or (not feature-flag) (member feature-flag *features*))
               collect (list name :metaclass 'built-in-class
                             :index index
                             :direct-superclasses (or rest '(t))))

src/cmp/cmparray.lsp

@@ -17,7 +17,7 @@
 (defun guess-array-element-type (element-type)
   (if (and (setf element-type (extract-constant-value element-type))
            (known-type-p element-type))
-      (upgraded-array-element-type element-type)
+      (upgraded-array-element-type element-type *cmp-env*)
       '*))
 
 (defun guess-array-dimensions-type (orig-dimensions &aux dimensions)
@@ -30,13 +30,13 @@
   (let ((dimensions (extract-constant-value orig-dimensions :failed)))
     (cond ((eq dimensions ':failed)
            '*)
-          ((typep dimensions 'ext:array-index)
+          ((typep dimensions 'ext:array-index *cmp-env*)
            (list dimensions))
           ((and (listp dimensions)
                 (let ((rank (list-length dimensions)))
                   (and (numberp rank)
                        (< -1 rank array-rank-limit)
-                       (every #'(lambda (x) (typep x 'ext:array-index)) dimensions)
+                       (every #'(lambda (x) (typep x 'ext:array-index *cmp-env*)) dimensions)
                        (< (apply '* dimensions) array-total-size-limit))))
            dimensions)
           (t
@@ -255,7 +255,7 @@
     `(ffi:c-inline (,array) ,@(aref tails n))))
 
 (defmacro array-dimension-fast (array n)
-  (if (typep n '(integer 0 #.(1- array-rank-limit)))
+  (if (typep n '(integer 0 #.(1- array-rank-limit)) *cmp-env*)
       (array-dimension-accessor array n)
       (error "In macro ARRAY-DIMENSION-FAST, the index is not a constant integer: ~A"
              n)))

src/cmp/cmpbackend-cxx/cmpc-fun-inl.lsp

@@ -83,7 +83,9 @@
     ((equal (inline-info-arg-types ia) (inline-info-arg-types ib))
      ia)
     ;; More specific?
-    ((every #'type>= (inline-info-arg-types ia) (inline-info-arg-types ib))
+    ((every #'(lambda (t1 t2) (type>= t1 t2 *cmp-env*))
+            (inline-info-arg-types ia)
+            (inline-info-arg-types ib))
      ib)
     ;; Keep the first one, which is typically the least safe but fastest. 
     (t
@@ -103,7 +105,7 @@
 
 (defun to-fixnum-float-type (type)
   (dolist (i '(CL:FIXNUM CL:DOUBLE-FLOAT CL:SINGLE-FLOAT CL:LONG-FLOAT) nil)
-    (when (type>= i type)
+    (when (type>= i type *cmp-env*)
       (return i))))
 
 (defun maximum-float-type (t1 t2)
@@ -140,10 +142,10 @@
                  (setq number-max (maximum-float-type number-max new-type))))
               #+sse2
               ;; Allow implicit casts between SSE subtypes to kick in
-              ((and (type>= 'ext:sse-pack type)
+              ((and (type>= 'ext:sse-pack type *cmp-env*)
-                    (type>= 'ext:sse-pack arg-type))
+                    (type>= 'ext:sse-pack arg-type *cmp-env*))
                (push type rts))
-              ((type>= type arg-type)
+              ((type>= type arg-type *cmp-env*)
                (push type rts))
               (t (return-from inline-type-matches nil)))))
     ;;
@@ -163,10 +165,10 @@
                          (and (setf number-max (if (eq number-max 'fixnum)
                                                    'integer
                                                    number-max))
-                              (type>= inline-return-type number-max)
+                              (type>= inline-return-type number-max *cmp-env*)
-                              (type>= number-max return-type))
+                              (type>= number-max return-type *cmp-env*))
                          ;; no contravariance
-                         (type>= inline-return-type return-type)))))
+                         (type>= inline-return-type return-type *cmp-env*)))))
       (let ((inline-info (copy-structure inline-info)))
         (setf (inline-info-arg-types inline-info)
               (nreverse rts))

src/cmp/cmpbackend-cxx/cmpc-mach.lsp

@@ -30,7 +30,7 @@
   (from-lisp-unsafe nil))
 
 (defun lisp-type-p (type)
-  (subtypep type 'T))
+  (subtypep type 'T *cmp-env*))
 
 (defun host-type-record-unsafe (host-type)
   (gethash host-type (machine-host-type-hash *machine*)))
@@ -57,7 +57,7 @@
     (t
      ;; Find the most specific type that fits
      (dolist (record (machine-sorted-types *machine*) :object)
-       (when (subtypep type (host-type-lisp-type record))
+       (when (subtypep type (host-type-lisp-type record) *cmp-env*)
          (return-from lisp-type->host-type (host-type-name record)))))))
 
 (defun c-number-host-type-p (host-type)
@@ -191,8 +191,8 @@
        :name name
        :lisp-type lisp-type
        :bits bits
-       :numberp (subtypep lisp-type 'number)
+       :numberp (subtypep lisp-type 'number *cmp-env*)
-       :integerp (subtypep lisp-type 'integer)
+       :integerp (subtypep lisp-type 'integer *cmp-env*)
        :c-name c-name
        :to-lisp to-lisp
        :from-lisp from-lisp
@@ -218,7 +218,7 @@
        with fixnum-lisp-type = (host-type-lisp-type fixnum-host-type)
        for (name . rest) in +host-types+
        for r = (gethash name table)
-       when (and r (subtypep (host-type-lisp-type r) fixnum-lisp-type))
+       when (and r (subtypep (host-type-lisp-type r) fixnum-lisp-type *cmp-env*))
        do (setf (host-type-from-lisp-unsafe r) "ecl_fixnum"))
     ;; Create machine object
     (make-machine :c-types all-c-types
@@ -228,7 +228,4 @@
 (defun machine-c-type-p (name)
   (gethash name (machine-host-type-hash *machine*)))
 
-(defun machine-fixnump (number)
-  (typep number (host-type-lisp-type (gethash :fixnum number))))
-
 (defvar *default-machine* (setf *machine* (default-machine)))

src/cmp/cmpbackend-cxx/cmpc-opt-printer.lsp

@@ -22,7 +22,7 @@
        (produce-inline-loc (list expression stream)
                            '(:wchar :object) '(:wchar)
                            "ecl_princ_char(#0,#1)" t t))
-      ((and foundp (typep value 'base-string) (< (length value) 80))
+      ((and foundp (typep value 'base-string *cmp-env*) (< (length value) 80))
        (produce-inline-loc (list expression stream)
                            '(:object :object) '(:object)
                            (concatenate 'string "(ecl_princ_str("

src/cmp/cmpbackend-cxx/cmppass2-call.lsp

@@ -110,7 +110,7 @@
 (defun c2call-unknown (c1form form args)
   (declare (ignore c1form))
   (let* ((form-type (c1form-primary-type form))
-         (function-p (and (subtypep form-type 'function)
+         (function-p (and (subtypep form-type 'function *cmp-env*)
                           (policy-assume-right-type)))
          (loc (emit-inline-form form args))
          (args (inline-args args)))

src/cmp/cmpbackend-cxx/cmppass2-data.lsp

@@ -243,7 +243,7 @@
               si:*compiler-constants*
               (and (not *use-static-constants-p*)
                    #+sse2
-                   (not (typep object 'ext:sse-pack)))
+                   (not (typep object 'ext:sse-pack *cmp-env*)))
               (not (listp *static-constants*)))
     (ext:if-let ((record (find object *static-constants* :key #'first :test #'equal)))
       (second record)
@@ -263,7 +263,7 @@
 
 (defun try-value-c-inliner (value)
   (ext:when-let ((x (assoc value *optimizable-constants*)))
-    (when (typep value '(or float (complex float)))
+    (when (typep value '(or float (complex float)) *cmp-env*)
       (pushnew "#include <float.h>" *clines-string-list*)
       (pushnew "#include <complex.h>" *clines-string-list*))
     (cdr x)))
@@ -285,13 +285,13 @@
 (defun try-immediate-value (value)
   ;; FIXME we could inline here also (COMPLEX FLOAT). That requires adding an
   ;; emmiter of C complex floats in the function WT1.
-  (typecase value
+  (cond
-    ((or fixnum character float #|#+complex-float (complex float)|#)
+    ((typep value '(or fixnum character float #|#+complex-float (complex float)|#) *cmp-env*)
      (make-vv :value value
               :location nil
               :host-type (lisp-type->host-type (type-of value))))
     #+sse2
-    (ext:sse-pack
+    ((typep value 'ext:sse-pack *cmp-env*)
      (let* ((bytes (ext:sse-pack-to-vector value '(unsigned-byte 8)))
             (elt-type (ext:sse-pack-element-type value)))
        (multiple-value-bind (wrapper rtype)
@@ -303,7 +303,7 @@
                   :location (format nil "~A(_mm_setr_epi8(~{~A~^,~}))"
                                     wrapper (coerce bytes 'list))
                   :host-type rtype))))
-    (otherwise
+    (t
      nil)))
 
 
@@ -394,13 +394,14 @@
          (wt "VVtemp[" index "]"))))
 
 (defun wt-vv-value (vv value)
-  (etypecase value
+  (cond
-    ((eql CL:T)      (wt "ECL_T"))
+    ((eql value CL:T)                      (wt "ECL_T"))
-    ((eql CL:NIL)    (wt "ECL_NIL"))
+    ((eql value CL:NIL)                    (wt "ECL_NIL"))
-    (fixnum          (wt-fixnum value vv))
+    ((typep value 'fixnum *cmp-env*)          (wt-fixnum value vv))
-    (character       (wt-character value vv))
+    ((typep value 'character *cmp-env*)       (wt-character value vv))
-    (float           (wt-number value vv))
+    ((typep value 'float *cmp-env*)           (wt-number value vv))
-    ((complex float) (wt-number value vv))))
+    ((typep value '(complex float) *cmp-env*) (wt-number value vv))
+    (t (baboon "wt-vv-value: ~s is not an immediate value, but has no VV index~%" value))))
 
 (defun wt-vv (vv-loc)
   (setf (vv-used-p vv-loc) t)

src/cmp/cmpbackend-cxx/cmppass2-eval.lsp

@@ -46,13 +46,13 @@
 
 (defun c2if (c1form fmla form1 form2)
   ;; FIXME! Optimize when FORM1 or FORM2 are constants
-  (cond ((type-true-p (c1form-primary-type fmla))
+  (cond ((type-true-p (c1form-primary-type fmla) *cmp-env*)
          ;; The true branch is always taken
          (warn-dead-code form2 c1form "the test ~S always evaluates to true" fmla)
          (let ((*destination* 'TRASH))
            (c2expr* fmla))
          (c2expr form1))
-        ((type-false-p (c1form-primary-type fmla))
+        ((type-false-p (c1form-primary-type fmla) *cmp-env*)
          ;; The false branch is always taken
          (warn-dead-code form1 c1form "the test ~S always evaluates to false" fmla)
          (let ((*destination* 'TRASH))
@@ -90,11 +90,11 @@
 (defun c2fmla-not (c1form arg)
   (declare (ignore c1form))
   (let ((dest *destination*))
-    (cond ((type-true-p (c1form-primary-type arg))
+    (cond ((type-true-p (c1form-primary-type arg) *cmp-env*)
            (let ((*destination* 'TRASH))
              (c2expr* arg))
            (c2expr (c1nil)))
-          ((type-false-p (c1form-primary-type arg))
+          ((type-false-p (c1form-primary-type arg) *cmp-env*)
            (let ((*destination* 'TRASH))
              (c2expr* arg))
            (c2expr (c1t)))
@@ -114,13 +114,13 @@
                  for expr in butlast
                  for remaining-exprs on butlast
                  for type = (c1form-primary-type expr)
-                 do (cond ((type-false-p type)
+                 do (cond ((type-false-p type *cmp-env*)
                            (warn-dead-code (append (rest remaining-exprs) (list last)) c1form
                                            "the test ~S always evaluates to false" expr)
                            (let ((*destination* exit-dest))
                              (c2expr* expr))
                            (return-from c2expr-and-arguments))
-                          ((type-true-p type)
+                          ((type-true-p type *cmp-env*)
                            (let ((*destination* 'TRASH))
                              (c2expr* expr)))
                           (t
@@ -141,13 +141,13 @@
                  for expr in butlast
                  for remaining-exprs on butlast
                  for type = (c1form-primary-type expr)
-                 do (cond ((type-true-p type)
+                 do (cond ((type-true-p type *cmp-env*)
                            (warn-dead-code (append (rest remaining-exprs) (list last)) c1form
                                            "the test ~S always evaluates to true" expr)
                            (let ((*destination* 'VALUE0))
                              (c2expr* expr))
                            (return-from c2expr-or-arguments))
-                          ((type-false-p type)
+                          ((type-false-p type *cmp-env*)
                            (let ((*destination* 'TRASH))
                              (c2expr* expr)))
                           (t

src/cmp/cmpbackend-cxx/cmppass2-loc.lsp

@@ -48,8 +48,8 @@
   ;; overflow if we use a smaller integer type (overflows in long long
   ;; computations are taken care of by the compiler before we get to
   ;; this point).
-  #+msvc (princ (cond ((typep value (host-type->lisp-type :long-long)) "LL")
+  #+msvc (princ (cond ((typep value (host-type->lisp-type :long-long) *cmp-env*) "LL")
-                      ((typep value (host-type->lisp-type :unsigned-long-long)) "ULL")
+                      ((typep value (host-type->lisp-type :unsigned-long-long) *cmp-env*) "ULL")
                       (t (baboon :format-control
                                  "wt-fixnum: The number ~A doesn't fit any integer type."
                                  value)))
@@ -225,7 +225,7 @@
     (unless coercer
       (cmperr "Cannot coerce lisp object to C type ~A" host-type))
     (wt (if (or (policy-assume-no-errors)
-                (subtypep loc-type dest-type))
+                (subtypep loc-type dest-type *cmp-env*))
             (host-type-from-lisp-unsafe record)
             coercer)
         "(" loc ")")))
@@ -249,7 +249,7 @@
                  ;; the latter case.
                  (wt "(ecl_miscompilation_error(),0)")))
              (ensure-valid-object-type (a-lisp-type)
-               (when (subtypep `(AND ,loc-type ,a-lisp-type) NIL)
+               (when (subtypep `(AND ,loc-type ,a-lisp-type) NIL *cmp-env*)
                  (coercion-error nil))))
       (when (eq dest-host-type loc-host-type)
         (wt loc)

src/cmp/cmpclos.lsp

@@ -17,7 +17,7 @@
 (defun maybe-optimize-generic-function (fname args)
   (when (fboundp fname)
     (let ((gf (fdefinition fname)))
-      (when (typep gf 'standard-generic-function)
+      (when (typep gf 'standard-generic-function *cmp-env*)
         ;;(check-generic-function-args gf args)
         (when (policy-inline-slot-access)
           (maybe-optimize-slot-accessor fname gf args))))))
@@ -36,9 +36,11 @@
            (loop for specializer in (clos:method-specializers m)
               for arg in c-args
               always (let ((arg-type (c1form-type arg)))
-                       (subtypep arg-type (if (consp specializer)
+                       (subtypep arg-type
+                                 (if (consp specializer)
                                      `(member ,(second specializer))
-                                              specializer))))))
+                                     specializer)
+                                 *cmp-env*)))))
     (delete-if-not #'applicable-method-p methods)))
 
 ;;;
@@ -93,10 +95,10 @@
     ;(format t "~%;;; Found ~D really applicable reader" (length readers))
     (when (= (length readers) 1)
       (let ((reader (first readers)))
-        (when (typep reader 'clos:standard-reader-method)
+        (when (typep reader 'clos:standard-reader-method *cmp-env*)
           (let* ((slotd (clos:accessor-method-slot-definition reader))
                  (index (clos::safe-slot-definition-location slotd)))
-            (when (ext:fixnump index)
+            (when (typep index 'fixnum *cmp-env*)
               `(clos::safe-instance-ref ,object ,index))))))))
 
 (defun try-optimize-slot-writer (orig-writers args)
@@ -105,10 +107,10 @@
     ;(format t "~%;;; Found ~D really applicable writer" (length writers))
     (when (= (length writers) 1)
       (let ((writer (first writers)))
-        (when (typep writer 'clos:standard-writer-method)
+        (when (typep writer 'clos:standard-writer-method *cmp-env*)
           (let* ((slotd (clos:accessor-method-slot-definition writer))
                  (index (clos::safe-slot-definition-location slotd)))
-            (when (ext:fixnump index)
+            (when (typep index 'fixnum *cmp-env*)
               `(si::instance-set ,(second args) ,index ,(first args)))))))))
 
 #+(or)

src/cmp/cmpenv-api.lsp

@@ -94,6 +94,16 @@ that are susceptible to be changed by PROCLAIM."
         (cmp-env-functions *cmp-env-root*))
   (values))
 
+(defun cmp-env-register-type (name definition &optional (env *cmp-env*))
+  (push (list :type name definition)
+        (cmp-env-variables env))
+  env)
+
+(defun cmp-env-register-types (definitions &optional (env *cmp-env*))
+  (dolist (def definitions)
+    (setf env (cmp-env-register-type (car def) (cdr def) env)))
+  env)
+
 (defun cmp-env-search-function (name &optional (env *cmp-env*))
   (let ((cfb nil)
         (unw nil)
@@ -203,3 +213,11 @@ that are susceptible to be changed by PROCLAIM."
      return (cddr i)
      finally (return default)))
 
+(defun cmp-env-search-type (name &optional (env *cmp-env*) (default name))
+  (loop for i in (car env)
+        when (and (consp i)
+                  (eq (first i) :type)
+                  (eq (second i) name))
+          return (third i)
+        finally (return default)))
+

src/cmp/cmpenv-declare.lsp

@@ -22,7 +22,8 @@
            (every test x))))
 
 (defun type-name-p (name)
-  (or (si:get-sysprop name 'SI::DEFTYPE-DEFINITION)
+  (or (cmp-env-search-type name *cmp-env* nil)
+      (si:get-sysprop name 'SI::DEFTYPE-DEFINITION)
       (find-class name nil)
       (si:get-sysprop name 'SI::STRUCTURE-TYPE)))
 
@@ -114,7 +115,7 @@ and a possible documentation string (only accepted when DOC-P is true)."
                          (valid-type-specifier decl-name))
                    (if (null ok)
                        (cmpwarn "Unknown declaration specifier ~s." decl-name)
-                       (setf types (collect-declared type decl-args types)))                   ))))
+                       (setf types (collect-declared type decl-args types)))))))
        finally (return (values body specials types ignored
                                (nreverse others) doc all-declarations)))))
 

src/cmp/cmplocs.lsp

@@ -157,7 +157,7 @@
 
 (defun precise-loc-lisp-type (loc new-type)
   (let ((loc-type (loc-lisp-type loc)))
-    (if (subtypep loc-type new-type)
+    (if (subtypep loc-type new-type *cmp-env*)
         loc
         `(the ,(type-and loc-type new-type) ,loc))))
 

src/cmp/cmpopt-clos.lsp

@@ -14,7 +14,7 @@
   (when (and (si::valid-function-name-p fname)
              (fboundp fname))
     (let ((function (fdefinition fname)))
-      (when (typep function 'generic-function)
+      (when (typep function 'generic-function *cmp-env*)
         (generic-function-macro-expand function (list* fname args))))))
 
 (defmethod generic-function-macro-expand ((g standard-generic-function) whole)
@@ -24,7 +24,7 @@
 
 (defun optimizable-slot-reader (method whole)
   (declare (si::c-local))
-  (when (typep method 'clos:standard-reader-method)
+  (when (typep method 'clos:standard-reader-method *cmp-env*)
     (let ((class (first (clos:method-specializers method))))
       (when (clos::class-sealedp class)
         (let* ((slotd (clos:accessor-method-slot-definition method))
@@ -47,7 +47,7 @@
 
 (defun optimizable-slot-writer (method whole)
   (declare (si::c-local))
-  (when (typep method 'clos:standard-writer-method)
+  (when (typep method 'clos:standard-writer-method *cmp-env*)
     (let ((class (second (clos:method-specializers method))))
       (when (clos::class-sealedp class)
         (let* ((slotd (clos:accessor-method-slot-definition method))

src/cmp/cmpopt-sequence.lsp

@@ -52,7 +52,7 @@
     `(let* ((%seq ,seq)
             (%iterator ,iterator))
        (declare (optimize (safety 0)))
-       (if (ext:fixnump %iterator)
+       (if (typep %iterator 'fixnum *cmp-env*)
            ;; Fixnum iterators are always fine
            (aref %seq %iterator)
            ;; Error check in case we may have been passed an improper list
@@ -64,7 +64,7 @@
     `(let* ((%seq ,seq)
             (%iterator ,iterator))
        (declare (optimize (safety 0)))
-       (if (ext:fixnump %iterator)
+       (if (typep %iterator 'fixnum *cmp-env*)
            (let ((%iterator (1+ (ext:truly-the fixnum %iterator))))
              (declare (fixnum %iterator))
              (and (< %iterator (length (ext:truly-the vector %seq)))

src/cmp/cmpopt.lsp

@@ -53,7 +53,7 @@
          first rest function)
     ;; Type must be constant to optimize
     (if (constantp type env)
-        (setf type (ext:constant-form-value type env))
+        (setf type (cmp-env-search-type (ext:constant-form-value type env) env))
         (return-from expand-typep form))
     (cond ;; compound function type specifier: signals an error
           ((contains-compound-function-type type)
@@ -62,15 +62,15 @@
           ;; Variable declared with a given type
           ((and (symbolp object)
                 (setf aux (cmp-env-search-var object env))
-                (subtypep (var-type aux) type))
+                (subtypep (var-type aux) type *cmp-env*))
            t)
           ;; Simple ones
-          ((subtypep 'T type) T)
+          ((subtypep 'T type *cmp-env*) T)
           ((eq type 'NIL) NIL)
           ;;
           ;; Detect inconsistencies in the provided type. If we run at low
           ;; safety, we will simply assume the user knows what she's doing.
-          ((subtypep type NIL)
+          ((subtypep type NIL *cmp-env*)
            (cmpwarn "TYPEP form contains an empty type ~S and cannot be optimized" type)
            form)
           ;;
@@ -95,7 +95,7 @@
           ;; Similar as before, but we assume the user did not give us
           ;; the right name, or gave us an equivalent type.
           ((loop for (a-type . function-name) in si::+known-typep-predicates+
-              when (si::type= type a-type env)
+              when (si::type= type a-type *cmp-env*)
               do (return `(,function-name ,object))))
           ;;
           ;; No optimizations that take up too much space unless requested.
@@ -144,7 +144,7 @@
              ;; Small optimization: it is easier to check for fixnum
              ;; than for integer. Use it when possible.
              (when (and (eq first 'integer)
-                        (subtypep type 'fixnum))
+                        (subtypep type 'fixnum *cmp-env*))
                (setf first 'fixnum))
              `(LET ((,var1 ,object)
                     (,var2 ,(coerce 0 first)))
@@ -261,14 +261,14 @@
          first rest)
     ;; Type must be constant to optimize
     (if (constantp type env)
-        (setf type (ext:constant-form-value type env))
+        (setf type (cmp-env-search-type (ext:constant-form-value type env) env))
         (return-from expand-coerce form))
     (cond ;; Trivial case
-          ((subtypep 't type)
+          ((subtypep 't type *cmp-env*)
            value)
           ;;
           ;; Detect inconsistencies in the type form.
-          ((subtypep type 'nil)
+          ((subtypep type 'nil *cmp-env*)
            (cmperror "Cannot COERCE an expression to an empty type."))
           ;;
           ;; No optimizations that take up too much space unless requested.
@@ -293,18 +293,18 @@
           ;; Search for a simple template above, but now assuming the user
           ;; provided a more complex form of the same value.
           ((loop for (a-type . template) in +coercion-table+
-              when (si::type= type a-type env)
+              when (si::type= type a-type *cmp-env*)
               do (return (subst value 'x template))))
           ;;
           ;; SEQUENCE types
-          ((subtypep type 'sequence)
+          ((subtypep type 'sequence *cmp-env*)
            (multiple-value-bind (elt-type length)
                (si::closest-sequence-type type)
              (if (or (eq length '*) (policy-assume-right-type))
                  (if (eq elt-type 'list)
                      `(si::coerce-to-list ,value)
                      `(si::coerce-to-vector ,value ',elt-type ',length
-                                            ,(and (subtypep type 'simple-array) t)))
+                                            ,(and (subtypep type 'simple-array *cmp-env*) t)))
                  form)))
           ;;
           ;; There are no other atomic types to optimize

src/cmp/cmpprop-num.lsp

@@ -20,7 +20,7 @@
           (if args
               (dolist (int-type '((UNSIGNED-BYTE 8) FIXNUM) 'integer)
                 (when (loop for value in args
-                         always (subtypep value int-type))
+                         always (subtypep value int-type *cmp-env*))
                   (return int-type)))
               'fixnum)))
 
@@ -51,11 +51,11 @@
     (when (and only-real (or complex-t1 complex-t2))
       (return-from maximum-number-type (values default default default)))
     (loop for i across number-types
-          do (when (and (null t1-eq) (type>= i t1))
+          do (when (and (null t1-eq) (type>= i t1 *cmp-env*))
                (when (equalp t1 t2)
                  (setf t2-eq i))
                (setf t1-eq i output i))
-             (when (and (null t2-eq) (type>= i t2))
+             (when (and (null t2-eq) (type>= i t2 *cmp-env*))
                (setf t2-eq i output i)))
     (unless (and t1-eq t2-eq output)
       (setf output default))
@@ -134,10 +134,10 @@
   (let ((exponent (ensure-real-type exponent)))
     (values (list base exponent)
             (cond ((eql exponent 'integer)
-                   (if (subtypep base 'fixnum)
+                   (if (subtypep base 'fixnum *cmp-env*)
                        'integer
                        base))
-                  ((type>= '(real 0 *) base)
+                  ((type>= '(real 0 *) base *cmp-env*)
                    (let* ((exponent (ensure-nonrational-type exponent)))
                      (maximum-number-type exponent base)))
                   (t
@@ -148,7 +148,7 @@
       (ensure-number-type arg)
     (values (list arg)
             (or (cdr (assoc output
-                            '((FIXNUM . (INTEGER 0 #.MOST-POSITIVE-FIXNUM))
+                            '((FIXNUM . (AND FIXNUM (INTEGER 0 *)))
                               (INTEGER . (INTEGER 0 *))
                               (RATIONAL . (RATIONAL 0 *))
                               (SHORT-FLOAT . (SHORT-FLOAT 0 *))
@@ -163,10 +163,10 @@
   (multiple-value-bind (output arg)
       (ensure-nonrational-type arg)
     (values (list arg)
-            (if (type>= '(REAL 0 *) arg) output 'NUMBER))))
+            (if (type>= '(REAL 0 *) arg *cmp-env*) output 'NUMBER))))
 
 (def-type-propagator isqrt (fname arg)
-  (if (type>= '(integer 0 #.MOST-POSITIVE-FIXNUM) arg)
+  (if (type>= 'ext:non-negative-fixnum arg *cmp-env*)
-      (values '((integer 0 #.MOST-POSITIVE-FIXNUM))
+      (values '(ext:non-negative-fixnum)
-              '(integer 0 #.MOST-POSITIVE-FIXNUM))
+              'ext:non-negative-fixnum)
       (values '((integer 0 *)) '(integer 0 *))))

src/cmp/cmpprop.lsp

@@ -138,9 +138,9 @@
 (defun p1if (c1form fmla true-branch false-branch)
   (declare (ignore c1form))
   (let ((t0 (values-type-primary-type (p1propagate fmla))))
-    (cond ((type-true-p t0)
+    (cond ((type-true-p t0 *cmp-env*)
            (p1propagate true-branch))
-          ((type-false-p t0)
+          ((type-false-p t0 *cmp-env*)
            (p1propagate false-branch))
           (t (let ((t1 (p1propagate true-branch))
                    (t2 (p1propagate false-branch)))
@@ -149,9 +149,9 @@
 (defun p1fmla-not (c1form form)
   (declare (ignore c1form))
   (let ((t0 (values-type-primary-type (p1propagate form))))
-    (cond ((type-true-p t0)
+    (cond ((type-true-p t0 *cmp-env*)
            '(eql nil))
-          ((type-false-p t0)
+          ((type-false-p t0 *cmp-env*)
            '(eql t))
           (t
            '(member t nil)))))
@@ -162,15 +162,15 @@
         for form in butlast
         for type = (p1propagate form)
         for primary-type = (values-type-primary-type type)
-        do (when (type-false-p primary-type)
+        do (when (type-false-p primary-type *cmp-env*)
              (return-from p1fmla-and primary-type))
-           (unless (type-true-p primary-type)
+           (unless (type-true-p primary-type *cmp-env*)
              (setf all-true nil))
         finally
            (setf type (p1propagate last)
                  primary-type (values-type-primary-type type))
-           (return (if (or (type-false-p primary-type)
+           (return (if (or (type-false-p primary-type *cmp-env*)
-                           (and (type-true-p primary-type) all-true))
+                           (and (type-true-p primary-type *cmp-env*) all-true))
                        type
                        (values-type-or 'null type)))))
 
@@ -180,13 +180,13 @@
         for type = (p1propagate form)
         for primary-type = (values-type-primary-type type)
         for output-type = primary-type then (type-or primary-type output-type)
-        do (when (type-true-p primary-type)
+        do (when (type-true-p primary-type *cmp-env*)
              (return-from p1fmla-or (type-and output-type '(not null))))
         finally
            (setf type (p1propagate last)
                  primary-type (values-type-primary-type type)
                  output-type (values-type-or type output-type))
-           (return (if (type-true-p primary-type)
+           (return (if (type-true-p primary-type *cmp-env*)
                        (values-type-and output-type '(not null))
                        output-type))))
 
@@ -245,7 +245,7 @@
           for (a-type c1form) in expressions
           for c1form-type = (p1propagate c1form)
           when (or (member a-type '(t otherwise))
-                   (subtypep var-type a-type))
+                   (subtypep var-type a-type *cmp-env*))
             do (setf output-type c1form-type)
           finally (return output-type))))
 
@@ -254,7 +254,7 @@
   (let ((value-type (p1propagate value))
          ;;(alt-type (p1propagate let-form))
         )
-    (if (subtypep value-type type)
+    (if (subtypep value-type type *cmp-env*)
         value-type
         type)))
 

src/cmp/cmpstructures.lsp

@@ -38,7 +38,7 @@
         (unless (and (consp slot-description)
                      (setf structure-type (car slot-description)
                            slot-index (cdr slot-description))
-                     (typep slot-index 'fixnum))
+                     (typep slot-index 'fixnum *cmp-env*))
           (cmpwarn "Unable to inline access to structure slot ~A because index is corrupt: ~A"
                    fname slot-index)
           (return-from maybe-optimize-structure-access nil))

src/cmp/cmptype-arith.lsp

@@ -39,7 +39,7 @@
 (deftype any () 't)
 
 (defun member-type (type disjoint-supertypes)
-  (member type disjoint-supertypes :test #'subtypep))
+  (member type disjoint-supertypes :test #'(lambda (t1 t2) (subtypep t1 t2 *cmp-env*))))
 
 ;;; Canonicalize the object type to a type recognized by the compiler.
 ;;; Depends on the implementation of TYPECASE.
@@ -68,17 +68,17 @@
 
 (defun valid-type-specifier (type)
   (handler-case
-      (if (subtypep type 'T)
+      (if (subtypep type 'T *cmp-env*)
           (values t type)
           (values nil nil))
     (error ()
       (values nil nil))))
 
 (defun known-type-p (type)
-  (subtypep type T))
+  (subtypep type T *cmp-env*))
 
 (defun trivial-type-p (type)
-  (subtypep T type))
+  (subtypep T type *cmp-env*))
 
 (defun-cached type-and (t1 t2) type-specifier=
   ;; FIXME! Should we allow "*" as type name???
@@ -314,8 +314,8 @@
            (cmpnote "Unknown type ~S" t2)
            T))))
 
-(defun type>= (type1 type2)
+(defun type>= (type1 type2 &optional env)
-  (subtypep type2 type1))
+  (subtypep type2 type1 env))
 
-(defun type-false-p (type) (subtypep type 'null))
+(defun type-false-p (type &optional env) (subtypep type 'null env))
-(defun type-true-p (type) (subtypep type '(not null)))
+(defun type-true-p (type &optional env) (subtypep type '(not null) env))

src/cmp/cmptype-assert.lsp

@@ -16,7 +16,7 @@
         (constant-value-p form *cmp-env*)
       (when constantp
         (loop for (type . forms) in (rest args)
-           when (typep value type)
+           when (typep value type *cmp-env*)
            do (return-from c1compiler-typecase (c1progn forms))
            finally (baboon :format-control "COMPILER-TYPECASE form missing a T statement")))))
   (let* ((var-name (pop args))
@@ -25,7 +25,7 @@
     ;; If the first type, which is supposedly the most specific
     ;; already includes the form, we keep it. This optimizes
     ;; most cases of CHECKED-VALUE.
-    (if (subtypep (var-type var) (car first-case))
+    (if (subtypep (var-type var) (car first-case) *cmp-env*)
         (c1progn (cdr first-case))
         (let* ((types '())
                (expressions (loop for (type . forms) in args
@@ -42,7 +42,7 @@
   (loop with var-type = (var-type var)
      for (type form) in expressions
      when (or (member type '(t otherwise))
-              (subtypep var-type type))
+              (subtypep var-type type *cmp-env*))
      return (c2expr form)))
 
 (defconstant +simple-type-assertions+
@@ -97,7 +97,8 @@
                                   value)))
           ((and (policy-evaluate-forms) (constantp value *cmp-env*))
            (if (typep (ext:constant-form-value value *cmp-env*)
-                      (si::flatten-function-types type *cmp-env*))
+                      (si::flatten-function-types type *cmp-env*)
+                      *cmp-env*)
                value
                (progn
                  ;; warn and generate error.
@@ -135,7 +136,7 @@
 
 (defun c2checked-value (c1form type value let-form)
   (declare (ignore c1form))
-  (c2expr (if (subtypep (c1form-primary-type value) type)
+  (c2expr (if (subtypep (c1form-primary-type value) type *cmp-env*)
               value
               let-form)))
 

src/cmp/cmptype.lsp

@@ -46,7 +46,8 @@
                                      '((si:complex-single-float . #c(0.0f0 0.0f0))
                                        (si:complex-double-float . #c(0.0d0 0.0d0))
                                        (si:complex-long-float . #c(0.0l0 0.0l0)))))
-                               :test #'subtypep))))
+                               :test #'(lambda (t1 t2)
+                                         (subtypep t1 t2 *cmp-env*))))))
     (if new-value
         (c1constant-value new-value)
         (c1nil))))
@@ -60,7 +61,7 @@
   (flet ((maybe-fix-type (var init type type-iterator)
            (multiple-value-bind (constantp value)
                (c1form-constant-p init)
-             (when (and constantp (not (typep value type)))
+             (when (and constantp (not (typep value type *cmp-env*)))
                (cmpwarn-style "The init-form of the argument ~A of ~:[an anonymous function~;the function ~:*~A~] is not of the declared type ~A."
                               (var-name var)
                               (fun-name *current-function*)
@@ -191,7 +192,7 @@
 (defmacro assert-type-if-known (value type &environment env)
   "Generates a type check on an expression, ensuring that it is satisfied."
   (multiple-value-bind (trivial valid)
-      (subtypep 't type)
+      (subtypep 't type *cmp-env*)
     (cond ((and trivial valid)
            value)
           ((multiple-value-setq (valid value) (constant-value-p value env))

src/compile.lsp.in

@@ -14,7 +14,14 @@
 
 (progn
   (setq *package* (find-package "SYSTEM"))
-  (setq *features* @LSP_FEATURES@))
+  (setq *host-features* *features*)
+  (setq *features* '(@LSP_FEATURES@ @COMPILATION_FEATURES@))
+  (when (member :ecl-min *host-features*)
+    (setq *features* (cons :ecl-min *features*)))
+  (when (member :uname *host-features*)
+    (setq *features* (cons :uname *features*)))
+  (when (member :cross *host-features*)
+    (setq *features* (cons :cross *features*))))
 
 ;;;
 ;;; * Ensure that we have the whole of Common-Lisp to compile

src/configure.ac

@@ -323,7 +323,8 @@ AC_SUBST(TARGETS, ['bin/ecl$(EXE)'])dnl Versions of ECL to be built
 AC_SUBST(SUBDIRS, ['c doc'])        dnl Subdirectories that make should process
 AC_SUBST(LIBRARIES, [])         dnl GMP, Boehm's GC, etc
 AC_SUBST(LSP_LIBRARIES)         dnl Libraries produced by lisp translator
-AC_SUBST(LSP_FEATURES, ['*features*']) dnl Symbols to add to *FEATURES* for conditional compilation
+AC_SUBST(COMPILATION_FEATURES, ['']) dnl Symbols to add to *FEATURES* for conditional compilation
+AC_SUBST(LSP_FEATURES, ["${LSP_FEATURES} :ecl :common :common-lisp :ansi-cl :ffi :prefixed-api :cdr-14 :package-local-nicknames :clos :ecl-pde :long-float"]) dnl Symbols to add to *FEATURES* in the final executable
 
 
 dnl -----------------------------------------------------------------------
@@ -592,6 +593,8 @@ if test "${enable_threads}" = "yes" ; then
     AC_MSG_RESULT([${THREAD_OBJ}])
     AC_DEFINE( [ECL_THREADS], [1], [Userland threads?])
   fi
+  ECL_ADD_FEATURE(threads)
+  ECL_ADD_FEATURE(ecl-read-write-lock)
 else
   boehm_configure_flags="${boehm_configure_flags} --disable-threads"
 fi
@@ -604,6 +607,8 @@ if test ${enable_boehm} = "no" ; then
   enable_smallcons="no"
 else
   ECL_BOEHM_GC
+  ECL_ADD_FEATURE(boehm-gc)
+  ECL_ADD_FEATURE(ecl-weak-hash)
 fi
 if test ${enable_smallcons} = "yes" ; then
    AC_DEFINE([ECL_SMALL_CONS], [], [ECL_SMALL_CONS])
@@ -652,6 +657,7 @@ dnl Deactivate floating point exceptions if asked to
 if test "${with_ieee_fp}" = yes; then
    with_signed_zero="yes"
    AC_DEFINE([ECL_IEEE_FP], [], [ECL_IEEE_FP])
+   ECL_ADD_FEATURE(ieee-floating-point)
 fi
 if test "${with_fpe}" != yes; then
    AC_DEFINE([ECL_AVOID_FPE_H], [], [ECL_AVOID_FPE_H])
@@ -659,6 +665,9 @@ fi
 if test "${with_signed_zero}" = yes; then
    AC_DEFINE([ECL_SIGNED_ZERO], [], [ECL_SIGNED_ZERO])
 fi
+if test "${with_ieee_fp}" != yes -o "${with_fpe}" = yes; then
+   ECL_ADD_FEATURE(floating-point-exceptions)
+fi
 
 dnl =====================================================================
 dnl Checks for header files
@@ -706,7 +715,7 @@ dnl AC_TYPE_OFF_T	   # DEFS off_t
 dnl AC_C_CHAR_UNSIGNED     # DEFS __CHAR_UNSIGNED__ if char is unsigned
 dnl !!! end dnled
 
-AC_C_BIGENDIAN([], [],
+AC_C_BIGENDIAN([ECL_ADD_FEATURE(big-endian)], [ECL_ADD_FEATURE(little-endian)],
   [AC_DEFINE(WORDS_BIGENDIAN, [/* EDIT! - Undefine if small endian */])])
 
 dnl ----------------------------------------------------------------------
@@ -791,6 +800,7 @@ else
   AC_DEFINE([ECL_CXX_CORE], [1],
             [Do we use C or C++ compiler to compile ecl?])
   boehm_configure_flags="${boehm_configure_flags} --enable-cplusplus"
+  ECL_ADD_FEATURE(cxx-core)
 fi
 
 ECL_LIBATOMIC_OPS
@@ -801,6 +811,7 @@ if test ${enable_shared} = "yes"; then
   AC_DEFINE(ENABLE_DLOPEN, [1], [Allow loading dynamically linked code])
   LSP_LIBRARIES="${SHAREDPREFIX}ecl.${SHAREDEXT}"
   ECL_ADD_LISP_MODULE([dlopen])
+  ECL_ADD_FEATURE(dlopen)
 else
   enable_soname=no
   LSP_LIBRARIES="${LIBPREFIX}ecl.${LIBEXT}"
@@ -814,11 +825,13 @@ fi
 if test "${with_cmuformat}" = "yes"; then
   with_clos_streams="yes"
   AC_DEFINE([ECL_CMU_FORMAT], [1], [Use CMU Common-Lisp's FORMAT routine])
+  ECL_ADD_FEATURE(cmu-format)
 fi
 
 if test "${with_clos_streams}" = "yes"; then
   AC_DEFINE( ECL_CLOS_STREAMS, [1],
              [Allow STREAM operations to work on arbitrary objects])
+  ECL_ADD_FEATURE(clos-streams)
 fi
 
 if test "${with_cmp}" = "builtin"; then
@@ -910,6 +923,7 @@ if test "x${enable_unicode}" != "xno"; then
    AC_DEFINE([ECL_UNICODE_NAMES], [1], [Link in the database of Unicode names])
    EXTRA_OBJS="$EXTRA_OBJS unicode/ucd_names_char.o unicode/ucd_names_codes.o unicode/ucd_names_pair.o unicode/ucd_names_str.o"
 	AC_CHECK_HEADERS([wchar.h])
+   ECL_ADD_FEATURE(unicode)
 else
    CHAR_CODE_LIMIT=256
    ECL_CHARACTER="int"
@@ -930,6 +944,8 @@ else
   ECL_INIT_FORM="${with_init_form}"
 fi
 
+ECL_ADD_FEATURE(${ARCHITECTURE})
+
 AC_CONFIG_FILES([
   bare.lsp
   lsp/load.lsp
@@ -949,6 +965,7 @@ AC_CONFIG_FILES([
   cmp/cmpdefs.pre:cmp/cmpdefs.lsp
   tests/config.lsp
   tests/Makefile
+  c/ecl_features.h
  ])
 
 AC_CONFIG_HEADERS([ecl/config.h:ecl/configpre.h])

src/doc/manual/user-guide/building.txi

@@ -108,47 +108,40 @@ install NSIS and run nmake windows-nsi.
 
 @subsubsection Android
 
-Cross compiling ECL for Android requires first building the host ECL
+Cross compiling ECL for Android requires first configuring the cross
-program. At present this host ECL needs to have the same word size and
+compilation toolchain. This requires the Android NDK version 22 or
-same optional capabilities (e.g. threads, C99 complex floats) as
+higher.
-the target system. Therefore, to build the host ECL for a 32 bit ARM
-system, use the following commands:
-
-@example
-# C99 complex numbers are not fully supported on Android
-./configure ABI=32 CFLAGS="-m32 -g -O2" LDFLAGS="-m32 -g -O2"\
-            --prefix=`pwd`/ecl-android-host \
-            --disable-c99complex
-make -j9
-make install
-rm -r build
-export ECL_TO_RUN=`pwd`/ecl-android-host/bin/ecl
-@end example
-
-The next step is to configure the cross compilation toolchain. This
-requires the Android NDK version 15 or higher.
 
 @example
 @verbatim
 export NDK_PATH=/opt/android-ndk
 export ANDROID_API=23
-export TOOLCHAIN_PATH=`pwd`/android-toolchain
+export TOOLCHAIN_PATH=${NDK_PATH}/toolchains/llvm/prebuilt/linux-x86_64 # use darwin instead of linux if compiling on Mac OS host
-${NDK_PATH}/build/tools/make_standalone_toolchain.py --arch arm --install-dir ${TOOLCHAIN_PATH} --api ${ANDROID_API}
+export TARGET=armv7a-linux-androideabi
-export SYSROOT=${TOOLCHAIN_PATH}/sysroot
-export PATH=${TOOLCHAIN_PATH}/bin:$PATH
 @end verbatim
 @end example
 
 Here, @code{ANDROID_API} is the minimum Android API version ECL will
-run on. Finally, we can build and install the target ECL:
+run on. Moreover, an existing installation ECL is required. This installation
+has to be the same version as the one you are attempting to build.
+Assuming you have installed in "/usr/local":
 
 @example
 @verbatim
-# boehm GC is not compatible with ld.gold linker, force use of ld.bfd
+export ECL_TO_RUN=/usr/local/bin/ecl
-export LDFLAGS="--sysroot=${SYSROOT} -D__ANDROID_API__=${ANDROID_API} -fuse-ld=bfd"
+@end verbatim
-export CPPFLAGS="--sysroot=${SYSROOT} -D__ANDROID_API__=${ANDROID_API} -isystem ${SYSROOT}/usr/include/arm-linux-androideabi"
+@end example
-export CC=arm-linux-androideabi-clang
+
-./configure --host=arm-linux-androideabi \
+Finally, we can build and install the target ECL:
+
+@example
+@verbatim
+export CC="${TOOLCHAIN_PATH}/bin/clang --target=${TARGET}${ANDROID_API}"
+export LD=${TOOLCHAIN_PATH}/bin/ld
+export AR=${TOOLCHAIN_PATH}/bin/llvm-ar
+export RANLIB=${TOOLCHAIN_PATH}/bin/llvm-ranlib
+export ECL_TO_RUN=/usr/local/bin/ecl
+./configure --host=${TARGET} \
             --prefix=`pwd`/ecl-android \
             --disable-c99complex \
             --with-cross-config=`pwd`/src/util/android-arm.cross_config
@@ -164,14 +157,9 @@ and are ready to run on the Android system.
 
 The cross-compilation steps for iOS are similar to those for Android.
 
-Build the host ECL:
 @example
 @verbatim
-./configure CFLAGS="-DECL_C_COMPATIBLE_VARIADIC_DISPATCH" --prefix=`pwd`/ecl-iOS-host --disable-c99complex
+export ECL_TO_RUN=/usr/local/bin/ecl
-make -j9
-make install
-rm -r build
-export ECL_TO_RUN=`pwd`/ecl-iOS-host/bin/ecl
 @end verbatim
 @end example
 

src/ecl/configpre.h

@@ -3,7 +3,7 @@
 /* Define if building universal (internal helper macro) */
 #undef AC_APPLE_UNIVERSAL_BUILD
 
-/* Define to 1 if the 'closedir' function returns void instead of int. */
+/* Define to 1 if the `closedir' function returns void instead of int. */
 #undef CLOSEDIR_VOID
 
 /* ECL_AVOID_FPE_H */
@@ -24,6 +24,10 @@
 /* Do we use C or C++ compiler to compile ecl? */
 #undef ECL_CXX_CORE
 
+/* Do the fixed and optional arguments of a variadic function use a different
+   calling convention? */
+#undef ECL_C_COMPATIBLE_VARIADIC_DISPATCH
+
 /* Stack grows downwards */
 #undef ECL_DOWN_STACK
 
@@ -81,229 +85,229 @@
 /* GBC_BOEHM_PRECISE */
 #undef GBC_BOEHM_PRECISE
 
-/* Define to 1 if you have the 'alarm' function. */
+/* Define to 1 if you have the `alarm' function. */
 #undef HAVE_ALARM
 
-/* Define to 1 if you have the 'backtrace' function. */
+/* Define to 1 if you have the `backtrace' function. */
 #undef HAVE_BACKTRACE
 
-/* Define to 1 if you have the 'backtrace_symbols' function. */
+/* Define to 1 if you have the `backtrace_symbols' function. */
 #undef HAVE_BACKTRACE_SYMBOLS
 
-/* Define to 1 if you have the 'cabs' function. */
+/* Define to 1 if you have the `cabs' function. */
 #undef HAVE_CABS
 
-/* Define to 1 if you have the 'cabsf' function. */
+/* Define to 1 if you have the `cabsf' function. */
 #undef HAVE_CABSF
 
-/* Define to 1 if you have the 'cabsl' function. */
+/* Define to 1 if you have the `cabsl' function. */
 #undef HAVE_CABSL
 
-/* Define to 1 if you have the 'cacos' function. */
+/* Define to 1 if you have the `cacos' function. */
 #undef HAVE_CACOS
 
-/* Define to 1 if you have the 'cacosf' function. */
+/* Define to 1 if you have the `cacosf' function. */
 #undef HAVE_CACOSF
 
-/* Define to 1 if you have the 'cacosh' function. */
+/* Define to 1 if you have the `cacosh' function. */
 #undef HAVE_CACOSH
 
-/* Define to 1 if you have the 'cacoshf' function. */
+/* Define to 1 if you have the `cacoshf' function. */
 #undef HAVE_CACOSHF
 
-/* Define to 1 if you have the 'cacoshl' function. */
+/* Define to 1 if you have the `cacoshl' function. */
 #undef HAVE_CACOSHL
 
-/* Define to 1 if you have the 'cacosl' function. */
+/* Define to 1 if you have the `cacosl' function. */
 #undef HAVE_CACOSL
 
-/* Define to 1 if you have the 'casin' function. */
+/* Define to 1 if you have the `casin' function. */
 #undef HAVE_CASIN
 
-/* Define to 1 if you have the 'casinf' function. */
+/* Define to 1 if you have the `casinf' function. */
 #undef HAVE_CASINF
 
-/* Define to 1 if you have the 'casinh' function. */
+/* Define to 1 if you have the `casinh' function. */
 #undef HAVE_CASINH
 
-/* Define to 1 if you have the 'casinhf' function. */
+/* Define to 1 if you have the `casinhf' function. */
 #undef HAVE_CASINHF
 
-/* Define to 1 if you have the 'casinhl' function. */
+/* Define to 1 if you have the `casinhl' function. */
 #undef HAVE_CASINHL
 
-/* Define to 1 if you have the 'casinl' function. */
+/* Define to 1 if you have the `casinl' function. */
 #undef HAVE_CASINL
 
-/* Define to 1 if you have the 'catan' function. */
+/* Define to 1 if you have the `catan' function. */
 #undef HAVE_CATAN
 
-/* Define to 1 if you have the 'catanf' function. */
+/* Define to 1 if you have the `catanf' function. */
 #undef HAVE_CATANF
 
-/* Define to 1 if you have the 'catanh' function. */
+/* Define to 1 if you have the `catanh' function. */
 #undef HAVE_CATANH
 
-/* Define to 1 if you have the 'catanhf' function. */
+/* Define to 1 if you have the `catanhf' function. */
 #undef HAVE_CATANHF
 
-/* Define to 1 if you have the 'catanhl' function. */
+/* Define to 1 if you have the `catanhl' function. */
 #undef HAVE_CATANHL
 
-/* Define to 1 if you have the 'catanl' function. */
+/* Define to 1 if you have the `catanl' function. */
 #undef HAVE_CATANL
 
-/* Define to 1 if you have the 'ccos' function. */
+/* Define to 1 if you have the `ccos' function. */
 #undef HAVE_CCOS
 
-/* Define to 1 if you have the 'ccosf' function. */
+/* Define to 1 if you have the `ccosf' function. */
 #undef HAVE_CCOSF
 
-/* Define to 1 if you have the 'ccosh' function. */
+/* Define to 1 if you have the `ccosh' function. */
 #undef HAVE_CCOSH
 
-/* Define to 1 if you have the 'ccoshf' function. */
+/* Define to 1 if you have the `ccoshf' function. */
 #undef HAVE_CCOSHF
 
-/* Define to 1 if you have the 'ccoshl' function. */
+/* Define to 1 if you have the `ccoshl' function. */
 #undef HAVE_CCOSHL
 
-/* Define to 1 if you have the 'ccosl' function. */
+/* Define to 1 if you have the `ccosl' function. */
 #undef HAVE_CCOSL
 
-/* Define to 1 if you have the 'ceilf' function. */
+/* Define to 1 if you have the `ceilf' function. */
 #undef HAVE_CEILF
 
-/* Define to 1 if you have the 'cexp' function. */
+/* Define to 1 if you have the `cexp' function. */
 #undef HAVE_CEXP
 
-/* Define to 1 if you have the 'cexpf' function. */
+/* Define to 1 if you have the `cexpf' function. */
 #undef HAVE_CEXPF
 
-/* Define to 1 if you have the 'cexpl' function. */
+/* Define to 1 if you have the `cexpl' function. */
 #undef HAVE_CEXPL
 
-/* Define to 1 if you have the 'cimag' function. */
+/* Define to 1 if you have the `cimag' function. */
 #undef HAVE_CIMAG
 
-/* Define to 1 if you have the 'cimagf' function. */
+/* Define to 1 if you have the `cimagf' function. */
 #undef HAVE_CIMAGF
 
-/* Define to 1 if you have the 'cimagl' function. */
+/* Define to 1 if you have the `cimagl' function. */
 #undef HAVE_CIMAGL
 
-/* Define to 1 if you have the 'clock_gettime' function. */
+/* Define to 1 if you have the `clock_gettime' function. */
 #undef HAVE_CLOCK_GETTIME
 
-/* Define to 1 if you have the 'clog' function. */
+/* Define to 1 if you have the `clog' function. */
 #undef HAVE_CLOG
 
-/* Define to 1 if you have the 'clogf' function. */
+/* Define to 1 if you have the `clogf' function. */
 #undef HAVE_CLOGF
 
-/* Define to 1 if you have the 'clogl' function. */
+/* Define to 1 if you have the `clogl' function. */
 #undef HAVE_CLOGL
 
-/* Define to 1 if you have the 'conj' function. */
+/* Define to 1 if you have the `conj' function. */
 #undef HAVE_CONJ
 
-/* Define to 1 if you have the 'conjf' function. */
+/* Define to 1 if you have the `conjf' function. */
 #undef HAVE_CONJF
 
-/* Define to 1 if you have the 'conjl' function. */
+/* Define to 1 if you have the `conjl' function. */
 #undef HAVE_CONJL
 
-/* Define to 1 if you have the 'copysign' function. */
+/* Define to 1 if you have the `copysign' function. */
 #undef HAVE_COPYSIGN
 
-/* Define to 1 if you have the 'cosf' function. */
+/* Define to 1 if you have the `cosf' function. */
 #undef HAVE_COSF
 
-/* Define to 1 if you have the 'coshf' function. */
+/* Define to 1 if you have the `coshf' function. */
 #undef HAVE_COSHF
 
-/* Define to 1 if you have the 'cpow' function. */
+/* Define to 1 if you have the `cpow' function. */
 #undef HAVE_CPOW
 
-/* Define to 1 if you have the 'cpowf' function. */
+/* Define to 1 if you have the `cpowf' function. */
 #undef HAVE_CPOWF
 
-/* Define to 1 if you have the 'cpowl' function. */
+/* Define to 1 if you have the `cpowl' function. */
 #undef HAVE_CPOWL
 
-/* Define to 1 if you have the 'creal' function. */
+/* Define to 1 if you have the `creal' function. */
 #undef HAVE_CREAL
 
-/* Define to 1 if you have the 'crealf' function. */
+/* Define to 1 if you have the `crealf' function. */
 #undef HAVE_CREALF
 
-/* Define to 1 if you have the 'creall' function. */
+/* Define to 1 if you have the `creall' function. */
 #undef HAVE_CREALL
 
-/* Define to 1 if you have the 'csin' function. */
+/* Define to 1 if you have the `csin' function. */
 #undef HAVE_CSIN
 
-/* Define to 1 if you have the 'csinf' function. */
+/* Define to 1 if you have the `csinf' function. */
 #undef HAVE_CSINF
 
-/* Define to 1 if you have the 'csinh' function. */
+/* Define to 1 if you have the `csinh' function. */
 #undef HAVE_CSINH
 
-/* Define to 1 if you have the 'csinhf' function. */
+/* Define to 1 if you have the `csinhf' function. */
 #undef HAVE_CSINHF
 
-/* Define to 1 if you have the 'csinhl' function. */
+/* Define to 1 if you have the `csinhl' function. */
 #undef HAVE_CSINHL
 
-/* Define to 1 if you have the 'csinl' function. */
+/* Define to 1 if you have the `csinl' function. */
 #undef HAVE_CSINL
 
-/* Define to 1 if you have the 'csqrt' function. */
+/* Define to 1 if you have the `csqrt' function. */
 #undef HAVE_CSQRT
 
-/* Define to 1 if you have the 'csqrtf' function. */
+/* Define to 1 if you have the `csqrtf' function. */
 #undef HAVE_CSQRTF
 
-/* Define to 1 if you have the 'csqrtl' function. */
+/* Define to 1 if you have the `csqrtl' function. */
 #undef HAVE_CSQRTL
 
-/* Define to 1 if you have the 'ctan' function. */
+/* Define to 1 if you have the `ctan' function. */
 #undef HAVE_CTAN
 
-/* Define to 1 if you have the 'ctanf' function. */
+/* Define to 1 if you have the `ctanf' function. */
 #undef HAVE_CTANF
 
-/* Define to 1 if you have the 'ctanh' function. */
+/* Define to 1 if you have the `ctanh' function. */
 #undef HAVE_CTANH
 
-/* Define to 1 if you have the 'ctanhf' function. */
+/* Define to 1 if you have the `ctanhf' function. */
 #undef HAVE_CTANHF
 
-/* Define to 1 if you have the 'ctanhl' function. */
+/* Define to 1 if you have the `ctanhl' function. */
 #undef HAVE_CTANHL
 
-/* Define to 1 if you have the 'ctanl' function. */
+/* Define to 1 if you have the `ctanl' function. */
 #undef HAVE_CTANL
 
 /* Define to 1 if you have the <dirent.h> header file. */
 #undef HAVE_DIRENT_H
 
-/* Define to 1 if you have the 'dladdr' function. */
+/* Define to 1 if you have the `dladdr' function. */
 #undef HAVE_DLADDR
 
 /* Define to 1 if you have the <dlfcn.h> header file. */
 #undef HAVE_DLFCN_H
 
-/* Define to 1 if the system has the type 'double complex'. */
+/* Define to 1 if the system has the type `double complex'. */
 #undef HAVE_DOUBLE_COMPLEX
 
 /* HAVE_ENVIRON */
 #undef HAVE_ENVIRON
 
-/* Define to 1 if you have the 'expf' function. */
+/* Define to 1 if you have the `expf' function. */
 #undef HAVE_EXPF
 
-/* Define to 1 if you have the 'fabsf' function. */
+/* Define to 1 if you have the `fabsf' function. */
 #undef HAVE_FABSF
 
 /* Define to 1 if you have the <fcntl.h> header file. */
@@ -315,61 +319,61 @@
 /* Define to 1 if you have the <fenv.h> header file. */
 #undef HAVE_FENV_H
 
-/* Define to 1 if the system has the type 'float complex'. */
+/* Define to 1 if the system has the type `float complex'. */
 #undef HAVE_FLOAT_COMPLEX
 
 /* Define to 1 if you have the <float.h> header file. */
 #undef HAVE_FLOAT_H
 
-/* Define to 1 if you have the 'floor' function. */
+/* Define to 1 if you have the `floor' function. */
 #undef HAVE_FLOOR
 
-/* Define to 1 if you have the 'floorf' function. */
+/* Define to 1 if you have the `floorf' function. */
 #undef HAVE_FLOORF
 
-/* Define to 1 if you have the 'fork' function. */
+/* Define to 1 if you have the `fork' function. */
 #undef HAVE_FORK
 
-/* Define to 1 if you have the 'frexpf' function. */
+/* Define to 1 if you have the `frexpf' function. */
 #undef HAVE_FREXPF
 
-/* Define to 1 if you have the 'fseeko' function. */
+/* Define to 1 if you have the `fseeko' function. */
 #undef HAVE_FSEEKO
 
-/* Define to 1 if you have the 'getcwd' function. */
+/* Define to 1 if you have the `getcwd' function. */
 #undef HAVE_GETCWD
 
-/* Define to 1 if you have the 'gethostbyaddr' function. */
+/* Define to 1 if you have the `gethostbyaddr' function. */
 #undef HAVE_GETHOSTBYADDR
 
-/* Define to 1 if you have the 'gethostbyname' function. */
+/* Define to 1 if you have the `gethostbyname' function. */
 #undef HAVE_GETHOSTBYNAME
 
-/* Define to 1 if you have the 'getpagesize' function. */
+/* Define to 1 if you have the `getpagesize' function. */
 #undef HAVE_GETPAGESIZE
 
-/* Define to 1 if you have the 'getrusage' function. */
+/* Define to 1 if you have the `getrusage' function. */
 #undef HAVE_GETRUSAGE
 
-/* Define to 1 if you have the 'gettimeofday' function. */
+/* Define to 1 if you have the `gettimeofday' function. */
 #undef HAVE_GETTIMEOFDAY
 
 /* Define to 1 if you have the <inttypes.h> header file. */
 #undef HAVE_INTTYPES_H
 
-/* Define to 1 if you have the 'isatty' function. */
+/* Define to 1 if you have the `isatty' function. */
 #undef HAVE_ISATTY
 
-/* Define to 1 if you have the 'ldexpf' function. */
+/* Define to 1 if you have the `ldexpf' function. */
 #undef HAVE_LDEXPF
 
 /* HAVE_LIBFFI */
 #undef HAVE_LIBFFI
 
-/* Define to 1 if you have the 'gc' library (-lgc). */
+/* Define to 1 if you have the `gc' library (-lgc). */
 #undef HAVE_LIBGC
 
-/* Define to 1 if you have the 'sun' library (-lsun). */
+/* Define to 1 if you have the `sun' library (-lsun). */
 #undef HAVE_LIBSUN
 
 /* Define to 1 if you have the <limits.h> header file. */
@@ -378,50 +382,50 @@
 /* Define to 1 if you have the <link.h> header file. */
 #undef HAVE_LINK_H
 
-/* Define to 1 if you have the 'log1p' function. */
+/* Define to 1 if you have the `log1p' function. */
 #undef HAVE_LOG1P
 
-/* Define to 1 if you have the 'log1pf' function. */
+/* Define to 1 if you have the `log1pf' function. */
 #undef HAVE_LOG1PF
 
-/* Define to 1 if you have the 'log1pl' function. */
+/* Define to 1 if you have the `log1pl' function. */
 #undef HAVE_LOG1PL
 
-/* Define to 1 if you have the 'logf' function. */
+/* Define to 1 if you have the `logf' function. */
 #undef HAVE_LOGF
 
-/* Define to 1 if the system has the type 'long complex'. */
+/* Define to 1 if the system has the type `long complex'. */
 #undef HAVE_LONG_COMPLEX
 
-/* Define to 1 if you have the 'lstat' function. */
+/* Define to 1 if you have the `lstat' function. */
 #undef HAVE_LSTAT
 
 /* Define to 1 if you have the <mach-o/dyld.h> header file. */
 #undef HAVE_MACH_O_DYLD_H
 
-/* Define to 1 if your system has a GNU libc compatible 'malloc' function, and
+/* Define to 1 if your system has a GNU libc compatible `malloc' function, and
    to 0 otherwise. */
 #undef HAVE_MALLOC
 
-/* Define to 1 if you have the 'memmove' function. */
+/* Define to 1 if you have the `memmove' function. */
 #undef HAVE_MEMMOVE
 
-/* Define to 1 if you have the 'memset' function. */
+/* Define to 1 if you have the `memset' function. */
 #undef HAVE_MEMSET
 
-/* Define to 1 if you have the 'mkdir' function. */
+/* Define to 1 if you have the `mkdir' function. */
 #undef HAVE_MKDIR
 
-/* Define to 1 if you have the 'mkstemp' function. */
+/* Define to 1 if you have the `mkstemp' function. */
 #undef HAVE_MKSTEMP
 
-/* Define to 1 if you have a working 'mmap' system call. */
+/* Define to 1 if you have a working `mmap' system call. */
 #undef HAVE_MMAP
 
-/* Define to 1 if you have the 'nanosleep' function. */
+/* Define to 1 if you have the `nanosleep' function. */
 #undef HAVE_NANOSLEEP
 
-/* Define to 1 if you have the <ndir.h> header file, and it defines 'DIR'. */
+/* Define to 1 if you have the <ndir.h> header file, and it defines `DIR'. */
 #undef HAVE_NDIR_H
 
 /* Define to 1 if you have the <netdb.h> header file. */
@@ -433,62 +437,62 @@
 /* HAVE_POSIX_RWLOCK */
 #undef HAVE_POSIX_RWLOCK
 
-/* Define to 1 if you have the 'powf' function. */
+/* Define to 1 if you have the `powf' function. */
 #undef HAVE_POWF
 
-/* Define to 1 if you have the 'pthread_condattr_setclock' function. */
+/* Define to 1 if you have the `pthread_condattr_setclock' function. */
 #undef HAVE_PTHREAD_CONDATTR_SETCLOCK
 
-/* Define to 1 if you have the 'pthread_mutex_timedlock' function. */
+/* Define to 1 if you have the `pthread_mutex_timedlock' function. */
 #undef HAVE_PTHREAD_MUTEX_TIMEDLOCK
 
-/* Define to 1 if the system has the type 'pthread_rwlock_t'. */
+/* Define to 1 if the system has the type `pthread_rwlock_t'. */
 #undef HAVE_PTHREAD_RWLOCK_T
 
-/* Define to 1 if the system has the type 'ptrdiff_t'. */
+/* Define to 1 if the system has the type `ptrdiff_t'. */
 #undef HAVE_PTRDIFF_T
 
-/* Define to 1 if you have the 'putenv' function. */
+/* Define to 1 if you have the `putenv' function. */
 #undef HAVE_PUTENV
 
 /* Define to 1 if you have the <pwd.h> header file. */
 #undef HAVE_PWD_H
 
-/* Define to 1 if your system has a GNU libc compatible 'realloc' function,
+/* Define to 1 if your system has a GNU libc compatible `realloc' function,
    and to 0 otherwise. */
 #undef HAVE_REALLOC
 
 /* Define to 1 if you have the <sched.h> header file. */
 #undef HAVE_SCHED_H
 
-/* Define to 1 if you have the 'sched_yield' function. */
+/* Define to 1 if you have the `sched_yield' function. */
 #undef HAVE_SCHED_YIELD
 
-/* Define to 1 if you have the 'select' function. */
+/* Define to 1 if you have the `select' function. */
 #undef HAVE_SELECT
 
-/* Define to 1 if you have the 'setenv' function. */
+/* Define to 1 if you have the `setenv' function. */
 #undef HAVE_SETENV
 
-/* Define to 1 if you have the 'sigprocmask' function. */
+/* Define to 1 if you have the `sigprocmask' function. */
 #undef HAVE_SIGPROCMASK
 
-/* Define to 1 if you have the 'sinf' function. */
+/* Define to 1 if you have the `sinf' function. */
 #undef HAVE_SINF
 
-/* Define to 1 if you have the 'sinhf' function. */
+/* Define to 1 if you have the `sinhf' function. */
 #undef HAVE_SINHF
 
-/* Define to 1 if you have the 'socket' function. */
+/* Define to 1 if you have the `socket' function. */
 #undef HAVE_SOCKET
 
-/* Define to 1 if you have the 'sqrt' function. */
+/* Define to 1 if you have the `sqrt' function. */
 #undef HAVE_SQRT
 
-/* Define to 1 if you have the 'sqrtf' function. */
+/* Define to 1 if you have the `sqrtf' function. */
 #undef HAVE_SQRTF
 
-/* Define to 1 if 'stat' has the bug that it succeeds when given the
+/* Define to 1 if `stat' has the bug that it succeeds when given the
    zero-length file name argument. */
 #undef HAVE_STAT_EMPTY_STRING_BUG
 
@@ -507,13 +511,13 @@
 /* Define to 1 if you have the <stdlib.h> header file. */
 #undef HAVE_STDLIB_H
 
-/* Define to 1 if you have the 'strcasecmp' function. */
+/* Define to 1 if you have the `strcasecmp' function. */
 #undef HAVE_STRCASECMP
 
-/* Define to 1 if you have the 'strchr' function. */
+/* Define to 1 if you have the `strchr' function. */
 #undef HAVE_STRCHR
 
-/* Define to 1 if you have the 'strerror' function. */
+/* Define to 1 if you have the `strerror' function. */
 #undef HAVE_STRERROR
 
 /* Define to 1 if you have the <strings.h> header file. */
@@ -522,13 +526,13 @@
 /* Define to 1 if you have the <string.h> header file. */
 #undef HAVE_STRING_H
 
-/* Define to 1 if you have the 'strtol' function. */
+/* Define to 1 if you have the `strtol' function. */
 #undef HAVE_STRTOL
 
-/* Define to 1 if you have the 'system' function. */
+/* Define to 1 if you have the `system' function. */
 #undef HAVE_SYSTEM
 
-/* Define to 1 if you have the <sys/dir.h> header file, and it defines 'DIR'.
+/* Define to 1 if you have the <sys/dir.h> header file, and it defines `DIR'.
    */
 #undef HAVE_SYS_DIR_H
 
@@ -538,7 +542,7 @@
 /* HAVE_SYS_MMAN_H */
 #undef HAVE_SYS_MMAN_H
 
-/* Define to 1 if you have the <sys/ndir.h> header file, and it defines 'DIR'.
+/* Define to 1 if you have the <sys/ndir.h> header file, and it defines `DIR'.
    */
 #undef HAVE_SYS_NDIR_H
 
@@ -569,28 +573,28 @@
 /* Define to 1 if you have the <sys/wait.h> header file. */
 #undef HAVE_SYS_WAIT_H
 
-/* Define to 1 if you have the 'tanf' function. */
+/* Define to 1 if you have the `tanf' function. */
 #undef HAVE_TANF
 
-/* Define to 1 if you have the 'tanhf' function. */
+/* Define to 1 if you have the `tanhf' function. */
 #undef HAVE_TANHF
 
-/* Define to 1 if you have the 'times' function. */
+/* Define to 1 if you have the `times' function. */
 #undef HAVE_TIMES
 
-/* Define to 1 if you have the 'tzset' function. */
+/* Define to 1 if you have the `tzset' function. */
 #undef HAVE_TZSET
 
 /* Define to 1 if you have the <ulimit.h> header file. */
 #undef HAVE_ULIMIT_H
 
-/* Define to 1 if you have the 'uname' function. */
+/* Define to 1 if you have the `uname' function. */
 #undef HAVE_UNAME
 
 /* Define to 1 if you have the <unistd.h> header file. */
 #undef HAVE_UNISTD_H
 
-/* Define to 1 if you have the 'vfork' function. */
+/* Define to 1 if you have the `vfork' function. */
 #undef HAVE_VFORK
 
 /* Define to 1 if you have the <vfork.h> header file. */
@@ -599,16 +603,16 @@
 /* Define to 1 if you have the <wchar.h> header file. */
 #undef HAVE_WCHAR_H
 
-/* Define to 1 if 'fork' works. */
+/* Define to 1 if `fork' works. */
 #undef HAVE_WORKING_FORK
 
-/* Define to 1 if 'vfork' works. */
+/* Define to 1 if `vfork' works. */
 #undef HAVE_WORKING_VFORK
 
-/* Define to 1 if the system has the type '_Bool'. */
+/* Define to 1 if the system has the type `_Bool'. */
 #undef HAVE__BOOL
 
-/* Define to 1 if 'lstat' dereferences a symlink specified with a trailing
+/* Define to 1 if `lstat' dereferences a symlink specified with a trailing
    slash. */
 #undef LSTAT_FOLLOWS_SLASHED_SYMLINK
 
@@ -630,19 +634,19 @@
 /* Define to the version of this package. */
 #undef PACKAGE_VERSION
 
-/* Define as the return type of signal handlers ('int' or 'void'). */
+/* Define as the return type of signal handlers (`int' or `void'). */
 #undef RETSIGTYPE
 
-/* Define to the type of arg 1 for 'select'. */
+/* Define to the type of arg 1 for `select'. */
 #undef SELECT_TYPE_ARG1
 
-/* Define to the type of args 2, 3 and 4 for 'select'. */
+/* Define to the type of args 2, 3 and 4 for `select'. */
 #undef SELECT_TYPE_ARG234
 
-/* Define to the type of arg 5 for 'select'. */
+/* Define to the type of arg 5 for `select'. */
 #undef SELECT_TYPE_ARG5
 
-/* Define to 1 if all of the C89 standard headers exist (not just the ones
+/* Define to 1 if all of the C90 standard headers exist (not just the ones
    required in a freestanding environment). This macro is provided for
    backward compatibility; new code need not use it. */
 #undef STDC_HEADERS
@@ -651,7 +655,7 @@
    macro is obsolete. */
 #undef TIME_WITH_SYS_TIME
 
-/* Define to 1 if your <sys/time.h> declares 'struct tm'. */
+/* Define to 1 if your <sys/time.h> declares `struct tm'. */
 #undef TM_IN_SYS_TIME
 
 /* Define WORDS_BIGENDIAN to 1 if your processor stores words with the most
@@ -681,7 +685,7 @@
    #define below would cause a syntax error. */
 #undef _UINT8_T
 
-/* Define to empty if 'const' does not conform to ANSI C. */
+/* Define to empty if `const' does not conform to ANSI C. */
 #undef const
 
 /* ecl_int16_t */
@@ -714,7 +718,7 @@
 /* compiler understands long long */
 #undef ecl_ulong_long_t
 
-/* Define to '__inline__' or '__inline' if that's what the C compiler
+/* Define to `__inline__' or `__inline' if that's what the C compiler
    calls it, or to nothing if 'inline' is not supported under any name.  */
 #ifndef __cplusplus
 #undef inline
@@ -745,7 +749,7 @@
 /* Define to rpl_realloc if the replacement function should be used. */
 #undef realloc
 
-/* Define as 'unsigned int' if <stddef.h> doesn't define. */
+/* Define to `unsigned int' if <sys/types.h> does not define. */
 #undef size_t
 
 /* Define to the type of an unsigned integer type of width exactly 16 bits if
@@ -764,9 +768,9 @@
    such a type exists and the standard includes do not define it. */
 #undef uint8_t
 
-/* Define as 'fork' if 'vfork' does not work. */
+/* Define as `fork' if `vfork' does not work. */
 #undef vfork
 
-/* Define to empty if the keyword 'volatile' does not work. Warning: valid
+/* Define to empty if the keyword `volatile' does not work. Warning: valid
-   code using 'volatile' can become incorrect without. Disable with care. */
+   code using `volatile' can become incorrect without. Disable with care. */
 #undef volatile

src/h/config-internal.h.in

@@ -249,12 +249,3 @@
 #else
 #define ECL_DEFAULT_C_STACK_SIZE @ECL_DEFAULT_C_STACK_SIZE@
 #endif
-
-/* Do the fixed and optional arguments of a variadic function use a
- * different calling convention?
- * Hardcoded since there's no easy way to determine this from a
- * configure check and currently ARM64 apple is the only platform
- * known to do this. */
-#if defined(__APPLE__) && (defined(__arm64__) || defined(__aarch64__))
-#define ECL_C_COMPATIBLE_VARIADIC_DISPATCH
-#endif

src/lsp/predlib.lsp

@@ -458,7 +458,6 @@ and is not adjustable."
              '(t)))
 
 (defun upgraded-array-element-type (element-type &optional env)
-  (declare (ignore env))
   (let* ((hash (logand 127 (si:hash-eql element-type)))
          (record (aref *upgraded-array-element-type-cache* hash)))
     (declare (type (integer 0 127) hash))
@@ -468,14 +467,13 @@ and is not adjustable."
                                   :test #'eq)
                           element-type
                           (dolist (v +upgraded-array-element-types+ 'T)
-                            (when (subtypep element-type v)
+                            (when (subtypep element-type v env)
                               (return v))))))
           (setf (aref *upgraded-array-element-type-cache* hash)
                 (cons element-type answer))
           answer))))
 
 (defun upgraded-complex-part-type (real-type &optional env)
-  (declare (ignore env))
   ;; ECL does not have specialized complex types. If we had them, the
   ;; code would look as follows
   ;;   (dolist (v '(INTEGER RATIO RATIONAL SINGLE-FLOAT DOUBLE-FLOAT FLOAT REAL)
@@ -483,17 +481,17 @@ and is not adjustable."
   ;;     (when (subtypep real-type v)
   ;;       (return v))))
   #+complex-float
-  (cond ((subtypep real-type 'null)         nil)
+  (cond ((subtypep real-type 'null env)         nil)
-        ((subtypep real-type 'rational)     'rational)
+        ((subtypep real-type 'rational env)     'rational)
-        ((subtypep real-type 'single-float) 'single-float)
+        ((subtypep real-type 'single-float env) 'single-float)
-        ((subtypep real-type 'double-float) 'double-float)
+        ((subtypep real-type 'double-float env) 'double-float)
-        ((subtypep real-type 'long-float)   'long-float)
+        ((subtypep real-type 'long-float env)   'long-float)
-        ((subtypep real-type 'float)        'float)
+        ((subtypep real-type 'float env)        'float)
-        ((subtypep real-type 'real)         'real)
+        ((subtypep real-type 'real env)         'real)
         (t (error "~S is not a valid part type for a complex." real-type)))
   #-complex-float
-  (cond ((subtypep real-type 'null) nil)
+  (cond ((subtypep real-type 'null env) nil)
-        ((subtypep real-type 'real) 'real)
+        ((subtypep real-type 'real env) 'real)
         (t (error "~S is not a valid part type for a complex." real-type))))
 
 (defun in-interval-p (x interval)
@@ -536,6 +534,8 @@ and is not adjustable."
 (defun typep (object type &optional env &aux tp i c)
   "Args: (object type)
 Returns T if X belongs to TYPE; NIL otherwise."
+  (when env
+    (setf type (search-type-in-env type env)))
   (cond ((symbolp type)
          (let ((f (get-sysprop type 'TYPE-PREDICATE)))
            (if f
@@ -549,11 +549,11 @@ Returns T if X belongs to TYPE; NIL otherwise."
          (error-type-specifier type)))
   (case tp
     ((EQL MEMBER) (and (member object i) t))
-    (NOT (not (typep object (car i))))
+    (NOT (not (typep object (car i) env)))
     (OR (dolist (e i)
-          (when (typep object e) (return t))))
+          (when (typep object e env) (return t))))
     (AND (dolist (e i t)
-           (unless (typep object e) (return nil))))
+           (unless (typep object e env) (return nil))))
     (SATISFIES (funcall (car i) object))
     ((T *) t)
     ((NIL) nil)
@@ -584,17 +584,17 @@ Returns T if X belongs to TYPE; NIL otherwise."
               ;; type specifier may be i.e (complex integer) so we
               ;; should check both real and imag part (disregarding
               ;; the fact that both have the same upgraded type).
-              (and (typep (realpart object) (car i))
+              (and (typep (realpart object) (car i) env)
-                   (typep (imagpart object) (car i))))
+                   (typep (imagpart object) (car i) env)))
            ))
     (SEQUENCE (or (listp object) (vectorp object)))
     (CONS (and (consp object)
                (or (endp i)
                    (let ((car-type (first i)))
-                     (or (eq car-type '*) (typep (car object) car-type))))
+                     (or (eq car-type '*) (typep (car object) car-type env))))
                (or (endp (cdr i))
                    (let ((cdr-type (second i)))
-                     (or (eq cdr-type '*) (typep (cdr object) cdr-type))))))
+                     (or (eq cdr-type '*) (typep (cdr object) cdr-type env))))))
     (BASE-STRING
      (and (base-string-p object)
           (or (null i) (match-dimensions object i))))
@@ -1446,7 +1446,7 @@ if not possible."
         (values tag `(OR ,@out)))))
 
 ;;----------------------------------------------------------------------
-;; (CANONICAL-TYPE TYPE)
+;; (CANONICAL-TYPE TYPE ENV)
 ;;
 ;; This function registers all types mentioned in the given expression,
 ;; and outputs a code corresponding to the represented type. This
@@ -1455,6 +1455,8 @@ if not possible."
 ;;
 (defun canonical-type (type env)
   (declare (notinline clos::classp))
+  (when env
+    (setf type (search-type-in-env type env)))
   (cond ((find-registered-tag type))
         ((eq type 'T) -1)
         ((eq type 'NIL) 0)
@@ -1608,3 +1610,19 @@ if not possible."
         (*member-types* *member-types*)
         (*elementary-types* *elementary-types*))
     (fast-type= t1 t2 env)))
+
+(defun search-type-in-env (type env)
+  (let ((type-name type)
+        (type-args nil))
+    (when (consp type)
+      (setf type-name (first type)
+            type-args (rest type)))
+    (dolist (record (car env))
+      (when (and (consp record)
+                 (eq (first record) :type)
+                 (eq (second record) type-name))
+        (return-from search-type-in-env
+          (if (typep (third record) 'function)
+              (funcall (third record) type-args)
+              (third record))))))
+  type)

src/util/android-arm.cross_config

@@ -2,6 +2,7 @@ CL_FIXNUM_TYPE=int
 CL_FIXNUM_BITS=32
 CL_FIXNUM_MAX=536870911L
 CL_FIXNUM_MIN=-536870912L
+CL_SHORT_BITS=16
 CL_INT_BITS=32
 CL_LONG_BITS=32
 ECL_STACK_DIR=down

src/util/android-arm64.cross_config

@@ -2,6 +2,7 @@ CL_FIXNUM_TYPE=long
 CL_FIXNUM_BITS=64
 CL_FIXNUM_MAX=2305843009213693951L
 CL_FIXNUM_MIN=-2305843009213693952L
+CL_SHORT_BITS=16
 CL_INT_BITS=32
 CL_LONG_BITS=64
 ECL_STACK_DIR=down

src/util/iOS-arm64.cross_config

@@ -3,6 +3,7 @@ CL_FIXNUM_TYPE=long
 CL_FIXNUM_BITS=64
 CL_FIXNUM_MAX=2305843009213693951L
 CL_FIXNUM_MIN=-2305843009213693952L
+CL_SHORT_BITS=16
 CL_INT_BITS=32
 CL_LONG_BITS=64
 ECL_BIGENDIAN=no

src/util/test-android.sh

@@ -10,6 +10,8 @@
 # on the phone.
 #
 
+adb start-server
+
 export TMPDIR=/data/local/tmp/
 
 adb push ecl-android/ ${TMPDIR}

src/util/test-cross-compilation.sh

@@ -0,0 +1,21 @@
+#!/bin/bash
+#
+# This script checks if cross compiling ECL itself from x86 to x86_64
+# and vice versa works. It assumes that you are running an x86_64
+# system which can also run and compile x86 programs. You might have
+# to install additional packages for that (for example on debian, the
+# gcc-multilib package is needed).
+#
+# Four versions of ECL will be compiled:
+# - ecl-x86[_64]-native: direct (i.e. same host and target) x86[_64] build
+# - ecl-x86[_64]-native: cross build for x86[_64] target
+#
+# The results of running the test suite will be put in the files
+# test-results-x86[_64]-[native/cross]. It is recommended to also run
+# the ansi-tests for the output binaries.
+#
+set -e
+rm -rf build/; CFLAGS="-g -O2" ./configure --prefix=`pwd`/ecl-x86_64-native && make -j${JOBS} && rm -rf ecl-x86_64-native && make install && make check > test-results-x86_64-native
+rm -rf build/; ABI=32 CFLAGS="-g -O2 -m32" LDFLAGS="-m32" ./configure --prefix=`pwd`/ecl-x86-native && make -j${JOBS} && rm -rf ecl-x86-native && make install && make check > test-results-x86-native
+rm -rf build/; CFLAGS="-g -O2" ECL_TO_RUN=`pwd`/ecl-x86-native/bin/ecl ./configure --prefix=`pwd`/ecl-x86_64-cross --build=x86_64-pc-linux-gnu --host=x86-pc-linux-gnu --with-cross-config=`pwd`/src/util/x86_64-linux-gnu.cross_config && make -j${JOBS} && rm -rf ecl-x86_64-cross && make install && make check > test-results-x86_64-cross
+rm -rf build/; ABI=32 CFLAGS="-g -O2 -m32" LDFLAGS="-m32" ECL_TO_RUN=`pwd`/ecl-x86_64-native/bin/ecl ./configure --prefix=`pwd`/ecl-x86-cross --build=x86-pc-linux-gnu --host=x86_64-pc-linux-gnu --with-cross-config=`pwd`/src/util/x86-linux-gnu.cross_config && make -j${JOBS} && rm -rf ecl-x86-cross && make install && make check > test-results-x86-cross

src/util/wasm32-unknown-emscripten.cross_config

@@ -2,6 +2,7 @@ CL_FIXNUM_TYPE=int
 CL_FIXNUM_BITS=32
 CL_FIXNUM_MAX=536870911L
 CL_FIXNUM_MIN=-536870912L
+CL_SHORT_BITS=16
 CL_INT_BITS=32
 CL_LONG_BITS=32
 ECL_STACK_DIR=down

src/util/x86-linux-gnu.cross_config

@@ -0,0 +1,22 @@
+CL_FIXNUM_TYPE=int
+CL_FIXNUM_BITS=32
+CL_FIXNUM_MAX=536870911L
+CL_FIXNUM_MIN=-536870912L
+CL_SHORT_BITS=16
+CL_INT_BITS=32
+CL_LONG_BITS=32
+ECL_STACK_DIR=down
+ECL_BIGENDIAN=no
+ECL_NEWLINE=LF
+ECL_FILE_CNT=1
+ECL_STDINT_HEADER="#include <stdint.h>"
+ECL_UINT8_T=uint8_t
+ECL_UINT16_T=uint16_t
+ECL_UINT32_T=uint32_t
+ECL_UINT64_T=uint64_t
+ECL_INT8_T=int8_t
+ECL_INT16_T=int16_t
+ECL_INT32_T=int32_t
+ECL_INT64_T=int64_t
+ECL_LONG_LONG_BITS=64
+ECL_WORKING_ENVIRON=yes

src/util/x86_64-linux-gnu.cross_config

@@ -0,0 +1,22 @@
+CL_FIXNUM_TYPE=long
+CL_FIXNUM_BITS=64
+CL_FIXNUM_MAX=2305843009213693951L
+CL_FIXNUM_MIN=-2305843009213693952L
+CL_SHORT_BITS=16
+CL_INT_BITS=32
+CL_LONG_BITS=64
+ECL_STACK_DIR=down
+ECL_BIGENDIAN=no
+ECL_NEWLINE=LF
+ECL_FILE_CNT=1
+ECL_STDINT_HEADER="#include <stdint.h>"
+ECL_UINT8_T=uint8_t
+ECL_UINT16_T=uint16_t
+ECL_UINT32_T=uint32_t
+ECL_UINT64_T=uint64_t
+ECL_INT8_T=int8_t
+ECL_INT16_T=int16_t
+ECL_INT32_T=int32_t
+ECL_INT64_T=int64_t
+ECL_LONG_LONG_BITS=64
+ECL_WORKING_ENVIRON=yes