cmp: easier cross-compilation of user code

The procedure works as follows. First, cross compile ECL itself. In
this step, we dump the configuration of the compiler. This
configuration can then be later restored to put the host compiler into
cross compilation mode using a new option to WITH-COMPILATION-UNIT.

The following changes to the public interface are introduced:

- WITH-COMPILATION-UNIT now takes a new :target keyword
- New functions C:WRITE-TARGET-INFO, C:READ-TARGET-INFO to dump and
  restore the config
- The environment parameters to TYPEP and SUBTYPEP are no longer
  unused. User macros can query type relationships in the target
  environment using these parameters.

Internal changes in the compiler include:

- Target dependent variables in the compiler are defined using a new
  DEFCONFIG macro. C:WRITE-TARGET-INFO simply writes the value of
  these variables to a file.
- The distinction between target types and host types already exists
  in the compiler. In this commit, we just register the target types in
  the compiler environment when we change the compiler configuration.

contrib/bytecmp/bytecmp.lsp

@@ -125,13 +125,18 @@
     (si::load-bytecodes output-file *compile-verbose* *load-print* :default))
   (values (truename output-file) nil nil))
 
+(defun bc-do-compilation-unit (closure &key override)
+  (declare (ignore override))
+  (funcall closure))
+
 (defun install-bytecodes-compiler ()
   (ext::package-lock (find-package :cl) nil)
   (pushnew :ecl-bytecmp *features*)
   (setf (fdefinition 'disassemble) #'bc-disassemble
         (fdefinition 'compile) #'bc-compile
         (fdefinition 'compile-file) #'bc-compile-file
-        (fdefinition 'compile-file-pathname) #'bc-compile-file-pathname)
+        (fdefinition 'compile-file-pathname) #'bc-compile-file-pathname
+        (fdefinition 'si::do-compilation-unit) #'bc-do-compilation-unit)
   (ext::package-lock (find-package :cl) t))
 
 (defun install-c-compiler ()

src/Makefile.in

@@ -204,6 +204,9 @@ install:
 	for i in build-stamp help.doc TAGS; do \
 	  $(INSTALL_DATA) $$i $(DESTDIR)$(ecldir); \
 	done
+	if [ -f target-info.lsp ]; then \
+	  $(INSTALL_DATA) target-info.lsp $(DESTDIR)$(ecldir); \
+	fi
 	for i in $(LSP_LIBRARIES) $(LIBRARIES); do \
 	  if test -s $$i ; then \
 	   if echo $$i | grep dll; then \

src/aclocal.m4

@@ -252,6 +252,7 @@ AC_SUBST(ARCHITECTURE)dnl Type of processor for which this is compiled
 AC_SUBST(SOFTWARE_TYPE)dnl Type of operating system
 AC_SUBST(SOFTWARE_VERSION)dnl	 Version number of operating system
 AC_SUBST(MACHINE_VERSION)dnl	 Version of the machine
+AC_SUBST(TARGET_IDENTIFIER)dnl Target identifier for cross compilation
 
 AC_SUBST(ECL_LDRPATH)dnl Sometimes the path for finding DLLs must be hardcoded.
 AC_SUBST(LIBPREFIX)dnl	Name components of a statically linked library
@@ -611,6 +612,7 @@ AC_MSG_CHECKING(for required libraries)
 AC_MSG_RESULT([${clibs}])
 AC_MSG_CHECKING(for architecture)
 ARCHITECTURE=`echo "${host_cpu}" | tr a-z A-Z` # i386 -> I386
+TARGET_IDENTIFIER="${host}"
 AC_MSG_RESULT([${ARCHITECTURE}])
 AC_MSG_CHECKING(for software type)
 SOFTWARE_TYPE="$thehost"

src/cmp/cmpdefs.lsp

@@ -10,12 +10,23 @@
 
 (in-package "COMPILER")
 
+(defvar *config-options* '(*features*))
+
+(defmacro defconfig (name value &optional docstring)
+  "Define a configuration option. Like DEFVAR, but records the variable
+for cross-compilation."
+  `(progn
+     ,(if docstring
+          `(defvar ,name ,value ,docstring)
+          `(defvar ,name ,value))
+     (pushnew ',name *config-options*)))
+
 ;;; This is copied into each .h file generated, EXCEPT for system-p calls.
 ;;; The constant string *include-string* is the content of file "ecl.h".
 ;;; Here we use just a placeholder: it will be replaced with sed.
-(defvar *cmpinclude* "<ecl/ecl-cmp.h>")
+(defconfig *cmpinclude* "<ecl/ecl-cmp.h>")
 
-(defvar *cc* "@ECL_CC@"
+(defconfig *cc* "@ECL_CC@"
   "This variable controls how the C compiler is invoked by ECL.
 The default value is \"cc -I. -I/usr/local/include/\".
 The second -I option names the directory where the file ECL.h has been installed.
@@ -23,56 +34,61 @@ One can set the variable appropriately adding for instance flags which the
 C compiler may need to exploit special hardware features (e.g. a floating point
 coprocessor).")
 
-(defvar *ld* "@ECL_CC@"
+(defconfig *ld* "@ECL_CC@"
   "This variable controls the linker which is used by ECL.")
 
-(defvar *ranlib* "@RANLIB@"
+(defconfig *ranlib* "@RANLIB@"
   "Name of the `ranlib' program on the hosting platform.")
 
-(defvar *ar* "@AR@"
+(defconfig *ar* "@AR@"
   "Name of the `AR' program on the hosting platform.")
 
-(defvar *cc-flags* "@CPPFLAGS@ @CFLAGS@ @ECL_CFLAGS@")
+(defconfig *cc-flags* "@CPPFLAGS@ @CFLAGS@ @ECL_CFLAGS@")
 
-(defvar *cc-optimize* #-msvc "-O2"
+(defconfig *cc-optimize* #-msvc "-O2"
            #+msvc "@CFLAGS_OPTIMIZE@")
 
-(defvar *ld-format* #-msvc "~A -o ~S -L~S ~{~S ~} ~@[~S~]~{ '~A'~} ~A"
+(defconfig *ld-format* #-msvc "~A -o ~S -L~S ~{~S ~} ~@[~S~]~{ '~A'~} ~A"
            #+msvc "~A -Fe~S~* ~{~S ~} ~@[~S~]~{ '~A'~} ~A")
 
-(defvar *cc-format* (cond ((member :msvc *features*)
+(defconfig *cc-format* (cond ((member :msvc *features*)
 			                     "~A -I. \"-I~A\" ~A ~:[~*~;~A~] -w -c \"~A\" -o \"~A\"~{ '~A'~}")
 			                    ((member :nacl *features*) ;; pnacl-clang doesn't support -w
 			                     "~A -I. \"-I~A\" ~A ~:[~*~;~A~] -c \"~A\" -o \"~A\"~{ '~A'~}")
 			                    (t
 			                     "~A -I. \"-I~A\" ~A ~:[~*~;~A~] -w -c \"~A\" -o \"~A\"~{ '~A'~}")))
 
-(defvar *ld-flags* "@LDFLAGS@")
+(defconfig *ld-flags* "@LDFLAGS@")
 #-dlopen
-(defvar *ld-libs* "-lecl @CORE_LIBS@ @FASL_LIBS@ @LIBS@")
+(defconfig *ld-libs* "-lecl @CORE_LIBS@ @FASL_LIBS@ @LIBS@")
 #+dlopen
-(defvar *ld-libs* #-msvc "-lecl @FASL_LIBS@ @LIBS@"
+(defconfig *ld-libs* #-msvc "-lecl @FASL_LIBS@ @LIBS@"
            #+msvc "ecl.lib @CLIBS@")
 #+dlopen
-(defvar *ld-shared-flags* "@SHARED_LDFLAGS@ @LDFLAGS@")
+(defconfig *ld-shared-flags* "@SHARED_LDFLAGS@ @LDFLAGS@")
 #+dlopen
-(defvar *ld-bundle-flags* "@BUNDLE_LDFLAGS@ @LDFLAGS@")
-(defvar *ld-program-flags* "@PROGRAM_LDFLAGS@ @LDFLAGS@")
+(defconfig *ld-bundle-flags* "@BUNDLE_LDFLAGS@ @LDFLAGS@")
+(defconfig *ld-program-flags* "@PROGRAM_LDFLAGS@ @LDFLAGS@")
 
-(defvar +shared-library-prefix+ "@SHAREDPREFIX@")
-(defvar +shared-library-extension+ "@SHAREDEXT@")
-(defvar +shared-library-format+ "@SHAREDPREFIX@~a.@SHAREDEXT@")
-(defvar +static-library-prefix+ "@LIBPREFIX@")
-(defvar +static-library-extension+ "@LIBEXT@")
-(defvar +static-library-format+ "@LIBPREFIX@~a.@LIBEXT@")
-(defvar +object-file-extension+ "@OBJEXT@")
-(defvar +executable-file-format+ "~a@EXEEXT@")
+(defconfig +shared-library-prefix+ "@SHAREDPREFIX@")
+(defconfig +shared-library-extension+ "@SHAREDEXT@")
+(defconfig +shared-library-format+ "@SHAREDPREFIX@~a.@SHAREDEXT@")
+(defconfig +static-library-prefix+ "@LIBPREFIX@")
+(defconfig +static-library-extension+ "@LIBEXT@")
+(defconfig +static-library-format+ "@LIBPREFIX@~a.@LIBEXT@")
+(defconfig +object-file-extension+ "@OBJEXT@")
+(defconfig +executable-file-format+ "~a@EXEEXT@")
 
-(defvar *ecl-include-directory* "@includedir\@/")
-(defvar *ecl-library-directory* "@libdir\@/")
-(defvar *ecl-data-directory* "@ecldir\@/")
+(defconfig *ecl-include-directory* "@includedir\@/")
+(defconfig *ecl-library-directory* "@libdir\@/")
+(defconfig *ecl-data-directory* "@ecldir\@/")
 
-(defvar *ld-rpath*
+(defconfig *ld-rpath*
     (let ((x "@ECL_LDRPATH@"))
       (and (plusp (length x))
            (format nil x *ecl-library-directory*))))
+
+(defconfig *target-architecture* "@ARCHITECTURE@")
+(defconfig *target-software-type* "@SOFTWARE_TYPE@")
+(defconfig *target-lisp-implementation-version* "@PACKAGE_VERSION@")
+(defconfig *target-identifier* "@TARGET_IDENTIFIER@")

src/cmp/cmpenv-api.lsp

@@ -104,6 +104,18 @@ that are susceptible to be changed by PROCLAIM."
     (setf env (cmp-env-register-type (car def) (cdr def) env)))
   env)
 
+(defun register-all-known-types (&optional (env *cmp-env*))
+  ;; Used during cross-compilation in compile.lsp.in to populate the
+  ;; lexical environment with type definitions
+  (do-all-symbols (type)
+    (ext:when-let ((deftype-form (si:get-sysprop type 'SI::DEFTYPE-FORM)))
+      (unless (cmp-env-search-type type env)
+        (let ((type-definition (eval (destructuring-bind (name lambda-list &rest body)
+                                         (rest deftype-form)
+                                       (si::expand-defmacro name lambda-list body 'DEFTYPE)))))
+          (setf env (cmp-env-register-type type type-definition env))))))
+  env)
+
 (defun cmp-env-search-function (name &optional (env *cmp-env*))
   (let ((cfb nil)
         (unw nil)
@@ -213,11 +225,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))
+(defun cmp-env-search-type (name &optional (env *cmp-env*))
   (loop for i in (car env)
         when (and (consp i)
                   (eq (first i) :type)
                   (eq (second i) name))
           return (third i)
-        finally (return default)))
+        finally (return nil)))
 

src/cmp/cmpenv-declare.lsp

@@ -22,7 +22,7 @@
            (every test x))))
 
 (defun type-name-p (name)
-  (or (cmp-env-search-type name *cmp-env* nil)
+  (or (cmp-env-search-type name *cmp-env*)
       (si:get-sysprop name 'SI::DEFTYPE-DEFINITION)
       (find-class name nil)
       (si:get-sysprop name 'SI::STRUCTURE-TYPE)))

src/cmp/cmpglobals.lsp

@@ -66,7 +66,7 @@ running the compiler. It may be updated by running ")
 (defvar *functions* nil)
 
 ;;; --cmpc-machine.lsp, cmpffi.lsp ---
-(defvar *machine* nil)
+(defconfig *machine* nil)
 
 ;;; --cmpcall.lsp--
 (defvar *compiler-declared-globals*)
@@ -112,8 +112,8 @@ by the C compiler and they denote function and unwind-protect boundaries. Note
 that compared with the bytecodes compiler, these records contain an additional
 variable, block, tag or function object at the end.")
 
-(defvar *cmp-env-root*
-  (cons nil (list (list '#:no-macro 'si:macro (constantly nil))))
+(defconfig *cmp-env-root*
+  (cons nil (list (list '#:no-macro 'si:macro 'si::constantly-nil)))
 "This is the common environment shared by all toplevel forms. It can
 only be altered by DECLAIM forms and it is used to initialize the
 value of *CMP-ENV*.")
@@ -153,6 +153,9 @@ slashes before special characters.")
 (defvar *precompiled-header-flags* nil)
 (defvar *precompiled-header-cc-config* nil)
 
+(defvar *cross-compiling* nil
+  "Are we cross compiling?")
+
 ;;;
 ;;; Compiler program and flags.
 ;;;

src/cmp/cmpmain.lsp

@@ -59,6 +59,7 @@
        (load nil)
        (external-format :default)
        output-file
+       (target nil)
      &aux
        (*standard-output* *standard-output*)
        (*error-output* *error-output*)
@@ -80,6 +81,12 @@ specifies whether to load the generated fasl file after compilation.  The
 :O-FILE, :C-FILE, :H-FILE, and :DATA-FILE keyword parameters allow you to
 control the intermediate files generated by the ECL compiler.If the file was
 compiled successfully, returns the pathname of the compiled file."
+  (when target
+    (setf args (copy-list args))
+    (remf args :target)
+    (return-from compile-file
+      (compile-with-target-info #'(lambda () (apply #'compile-file input-pathname args))
+                                target)))
   #-dlopen
   (unless system-p
     (format t "~%;;;~
@@ -97,7 +104,10 @@ compiled successfully, returns the pathname of the compiled file."
             (return)))))
   (when (and system-p load)
     (error "Cannot load system files."))
-  (cmpprogress "~&;;;~%;;; Compiling ~a." (namestring input-pathname))
+  (cmpprogress "~&;;;~%;;; Compiling ~a~:[~; for target ~a~]."
+               (namestring input-pathname)
+               *cross-compiling*
+               *target-identifier*)
   (let* ((input-file (truename *compile-file-pathname*))
          (*compile-file-truename* input-file)
          (*compiler-in-use* *compiler-in-use*)
@@ -119,7 +129,9 @@ compiled successfully, returns the pathname of the compiled file."
           (cmpprogress "~&;;; Finished compiling ~a.~%;;;~%" (namestring input-pathname))
           (cmperr "The C compiler failed to compile the intermediate file."))
       (when load
-        (load true-output-file :verbose *compile-verbose*))) ; with-compiler-env
+        (if *cross-compiling*
+            (load input-file :verbose *compile-verbose*)
+            (load true-output-file :verbose *compile-verbose*)))) ; with-compiler-env
     (compiler-output-values true-output-file compiler-conditions)))
 
 (defun compiler-output-values (main-value conditions)
@@ -334,9 +346,39 @@ from the C language code.  NIL means \"do not create the file\"."
   (cmpprogress "~&;;; OPTIMIZE levels: Safety=~d, Space=~d, Speed=~d, Debug=~d~%;;;~%"
                *safety* *space* *speed* *debug*))
 
-(defmacro with-compilation-unit (options &rest body)
-  (declare (ignore options))
-  `(progn ,@body))
+(defun compile-with-target-info (closure target-info)
+  (check-type target-info (or list pathname-designator))
+  (when (typep target-info 'pathname-designator)
+    (setf target-info (read-target-info target-info)))
+  (progv (mapcar #'car target-info) (mapcar #'cdr target-info)
+    (unless (string= *target-lisp-implementation-version* (lisp-implementation-version))
+      (error "Cannot cross compile as the target ECL version ~a does not match the host ECL version ~a"
+             *target-lisp-implementation-version* (lisp-implementation-version)))
+    (multiple-value-prog1 (let ((*cross-compiling* t))
+                            (funcall closure))
+      (let ((features (find '*features* target-info :key #'car)))
+        ;; Remember newly added keywords in *features* for future
+        ;; compilations
+        (setf (cdr features) *features*)))))
+
+;;; This function is located in the si package because the bytecodes
+;;; compiler will override it when calling
+;;; (install-bytecodes-compiler) since it supports fewer options than
+;;; the C compiler.
+(defun si::do-compilation-unit (closure &key override target)
+  (cond (override
+         (let* ((*active-protection* nil))
+           (si::do-compilation-unit closure :target target)))
+        ((null *active-protection*)
+         (let* ((*active-protection* t)
+                (*pending-actions* nil))
+           (unwind-protect (si::do-compilation-unit closure :target target)
+             (loop for action in *pending-actions*
+                   do (funcall action)))))
+        (target
+         (compile-with-target-info closure target))
+        (t
+         (funcall closure))))
 
 (ext:package-lock "CL" t)
 
@@ -345,14 +387,16 @@ from the C language code.  NIL means \"do not create the file\"."
 (let* ((compile #'compile)
        (disassemble #'disassemble)
        (compile-file #'compile-file)
-       (compile-file-pathname #'compile-file-pathname))
+       (compile-file-pathname #'compile-file-pathname)
+       (do-compilation-unit #'si::do-compilation-unit))
   (defun ext:install-c-compiler ()
     (ext:package-lock (find-package :cl) nil)
     (setf *features* (delete :ecl-bytecmp *features*))
     (setf (fdefinition 'disassemble) disassemble
           (fdefinition 'compile) compile
           (fdefinition 'compile-file) compile-file
-          (fdefinition 'compile-file-pathname) compile-file-pathname)
+          (fdefinition 'compile-file-pathname) compile-file-pathname
+          (fdefinition 'si::do-compilation-unit) do-compilation-unit)
     (ext:package-lock (find-package :cl) t)))
 
 (provide 'cmp)

src/cmp/cmpopt.lsp

@@ -53,7 +53,7 @@
          first rest function)
     ;; Type must be constant to optimize
     (if (constantp type env)
-        (setf type (cmp-env-search-type (ext:constant-form-value type env) env))
+        (setf type (si::search-type-in-env (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)
@@ -261,7 +261,7 @@
          first rest)
     ;; Type must be constant to optimize
     (if (constantp type env)
-        (setf type (cmp-env-search-type (ext:constant-form-value type env) env))
+        (setf type (si::search-type-in-env (ext:constant-form-value type env) env))
         (return-from expand-coerce form))
     (cond ;; Trivial case
           ((subtypep 't type *cmp-env*)

src/cmp/cmppackage.lsp

@@ -48,7 +48,10 @@
    "COMPILER-MESSAGE-FORM"
    ;; Other operators.
    "INSTALL-C-COMPILER"
-   "UPDATE-COMPILER-FEATURES"))
+   "UPDATE-COMPILER-FEATURES"
+   ;; Target information for cross compilation.
+   "READ-TARGET-INFO"
+   "WRITE-TARGET-INFO"))
 
 
 

src/cmp/cmputil.lsp

@@ -43,22 +43,6 @@
                  (setf output f)))
        finally (return output))))
 
-(defun do-compilation-unit (closure &key override)
-  (cond (override
-         (let* ((*active-protection* nil))
-           (do-compilation-unit closure)))
-        ((null *active-protection*)
-         (let* ((*active-protection* t)
-                (*pending-actions* nil))
-           (unwind-protect (do-compilation-unit closure)
-             (loop for action in *pending-actions*
-                do (funcall action)))))
-        (t
-         (funcall closure))))
-
-(defmacro with-compilation-unit ((&rest options) &body body)
- `(do-compilation-unit #'(lambda () ,@body) ,@options))
-
 (defmacro with-compiler-env ((compiler-conditions) &body body)
   `(let ((*compiler-conditions* nil))
      (declare (special *compiler-conditions*))
@@ -490,3 +474,26 @@ comparing circular objects."
     (list (null item))
     (vector (zerop (length item)))
     (hash-table (zerop (hash-table-count item)))))
+
+(defun read-target-info (filename)
+  (unless (pathname-name filename)
+    (let* ((path1 (merge-pathnames "target-info.lsp" filename)) ; flat install
+           (path2 (merge-pathnames "*/*/target-info.lsp" filename)) ; file in lib/ecl-x.x.x/
+           (files-found (nconc (directory path1) (directory path2))))
+      (when (null files-found)
+        (cmperror "Can't find the target information for cross compilation at ~s or ~s." path1 path2))
+      (setf filename (first files-found))))
+  (with-open-file (s filename)
+    (with-standard-io-syntax
+      (read s))))
+
+(defun write-target-info (filename)
+  (with-open-file (s filename
+                     :direction :output
+                     :if-exists :supersede
+                     :if-does-not-exist :create)
+    (with-standard-io-syntax
+      (let ((*print-circle* t))
+        (format s "~S~%"
+                (mapcar #'(lambda (option) (cons option (symbol-value option)))
+                        c::*config-options*))))))

src/cmp/load.lsp.in

@@ -3,8 +3,8 @@
 
 (defconstant +cmp-module-files+
   '("src:cmp;cmppackage.lsp"
-    "src:cmp;cmpglobals.lsp"
     "build:cmp;cmpdefs.lsp"
+    "src:cmp;cmpglobals.lsp"
     "src:cmp;cmputil.lsp"
     "src:cmp;cmpcond.lsp"
     "src:cmp;cmptype-arith.lsp"

src/compile.lsp.in

@@ -76,6 +76,14 @@
   (load "@true_srcdir@/doc/help.lsp")
   (si::dump-documentation "@true_builddir@/help.doc"))
 
+;;;
+;;; * Dump compiler configuration (for cross compilation)
+;;;
+#+cross
+(let ((*features* '(:cross @LSP_FEATURES@)))
+  (setf c::*cmp-env-root* (c::register-all-known-types c::*cmp-env-root*))
+  (c::write-target-info #P"build:target-info.lsp"))
+
 ;;;
 ;;; * Trick to make names shorter in C files
 ;;;

src/configure

@@ -697,6 +697,7 @@ SHAREDEXT
 LIBEXT
 LIBPREFIX
 ECL_LDRPATH
+TARGET_IDENTIFIER
 MACHINE_VERSION
 SOFTWARE_VERSION
 SOFTWARE_TYPE
@@ -6377,6 +6378,7 @@ printf "%s\n" "${clibs}" >&6; }
 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for architecture" >&5
 printf %s "checking for architecture... " >&6; }
 ARCHITECTURE=`echo "${host_cpu}" | tr a-z A-Z` # i386 -> I386
+TARGET_IDENTIFIER="${host}"
 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: ${ARCHITECTURE}" >&5
 printf "%s\n" "${ARCHITECTURE}" >&6; }
 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for software type" >&5
@@ -12834,3 +12836,4 @@ fi
 
 
 for i in $srcdir/c/*/; do mkdir -p c/`basename $i`; done
+

src/lsp/autoload.lsp

@@ -33,9 +33,12 @@ Gives a global declaration.  See DECLARE for possible DECL-SPECs."
   (when (eq (car d) 'SPECIAL) (mapc #'sys::*make-special (cdr d))))
 )
 
-(defmacro with-compilation-unit (options &rest body)
+(defun si::do-compilation-unit (closure &rest options)
   (declare (ignore options))
-  `(progn ,@body))
+  (funcall closure))
+
+(defmacro with-compilation-unit (options &rest body)
+  `(si::do-compilation-unit #'(lambda () ,@body) ,@options))
 
 ;;; Editor.
 

src/lsp/predlib.lsp

@@ -1687,6 +1687,6 @@ if not possible."
                  (eq (second record) type-name))
         (return-from search-type-in-env
           (if (typep (third record) 'function)
-              (funcall (third record) type-args)
+              (funcall (third record) (cons type-name type-args) env)
               (third record))))))
   type)