diff --git a/contrib/bytecmp/bytecmp.lsp b/contrib/bytecmp/bytecmp.lsp index 3e5064020..c124432be 100755 --- a/contrib/bytecmp/bytecmp.lsp +++ b/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 () diff --git a/src/Makefile.in b/src/Makefile.in index 6a7b93473..451d77fc4 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -201,9 +201,12 @@ install: $(INSTALL_DATA) ecl/$$i $(DESTDIR)$(includedir)/ecl/$$i; \ done $(INSTALL_SCRIPT) bin/ecl-config $(DESTDIR)$(bindir) - for i in build-stamp help.doc TAGS ; do \ + 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 \ diff --git a/src/aclocal.m4 b/src/aclocal.m4 index 28c7ffd7c..7483a07a5 100644 --- a/src/aclocal.m4 +++ b/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" diff --git a/src/cmp/cmpdefs.lsp b/src/cmp/cmpdefs.lsp index c3d873f8a..738cb6bc5 100644 --- a/src/cmp/cmpdefs.lsp +++ b/src/cmp/cmpdefs.lsp @@ -10,69 +10,85 @@ (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* "") +(defconfig *cmpinclude* "") -(defvar *cc* "@ECL_CC@" -"This variable controls how the C compiler is invoked by ECL. +(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. 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@" -"This variable controls the linker which is used by ECL.") +(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" - #+msvc "@CFLAGS_OPTIMIZE@") +(defconfig *cc-optimize* #-msvc "-O2" + #+msvc "@CFLAGS_OPTIMIZE@") -(defvar *ld-format* #-msvc "~A -o ~S -L~S ~{~S ~} ~@[~S~]~{ '~A'~} ~A" - #+msvc "~A -Fe~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*) - "~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'~}"))) +(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@" - #+msvc "ecl.lib @CLIBS@") +(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* - (let ((x "@ECL_LDRPATH@")) - (and (plusp (length x)) - (format nil x *ecl-library-directory*)))) +(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@") diff --git a/src/cmp/cmpenv-api.lsp b/src/cmp/cmpenv-api.lsp index b2addba0c..3041678c4 100644 --- a/src/cmp/cmpenv-api.lsp +++ b/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))) diff --git a/src/cmp/cmpenv-declare.lsp b/src/cmp/cmpenv-declare.lsp index fb26a0fda..f8e4f8c70 100644 --- a/src/cmp/cmpenv-declare.lsp +++ b/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))) diff --git a/src/cmp/cmpglobals.lsp b/src/cmp/cmpglobals.lsp index de1a0f49b..278d0221d 100644 --- a/src/cmp/cmpglobals.lsp +++ b/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. ;;; diff --git a/src/cmp/cmpmain.lsp b/src/cmp/cmpmain.lsp index 80f85616e..42e41dc56 100644 --- a/src/cmp/cmpmain.lsp +++ b/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) diff --git a/src/cmp/cmpopt.lsp b/src/cmp/cmpopt.lsp index 76210ec57..56e01b2cd 100644 --- a/src/cmp/cmpopt.lsp +++ b/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*) diff --git a/src/cmp/cmppackage.lsp b/src/cmp/cmppackage.lsp index 62ef2bc16..a4ccaaaaa 100644 --- a/src/cmp/cmppackage.lsp +++ b/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")) diff --git a/src/cmp/cmputil.lsp b/src/cmp/cmputil.lsp index be7465493..db86891e6 100644 --- a/src/cmp/cmputil.lsp +++ b/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*)))))) diff --git a/src/cmp/load.lsp.in b/src/cmp/load.lsp.in index c91d8fa7b..c8f88282c 100644 --- a/src/cmp/load.lsp.in +++ b/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" diff --git a/src/compile.lsp.in b/src/compile.lsp.in index f833ad1e8..72bd4a074 100755 --- a/src/compile.lsp.in +++ b/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 ;;; diff --git a/src/configure b/src/configure index 57834b92b..9400cb607 100755 --- a/src/configure +++ b/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 + diff --git a/src/lsp/autoload.lsp b/src/lsp/autoload.lsp index 60fed9682..1f3b82344 100644 --- a/src/lsp/autoload.lsp +++ b/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. diff --git a/src/lsp/predlib.lsp b/src/lsp/predlib.lsp index 946a84618..c605e9a7c 100644 --- a/src/lsp/predlib.lsp +++ b/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)