Commit 007f7609 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Refactor bundle support for ECL and MKCL.

parent a2928a03
This diff is collapsed.
......@@ -35,7 +35,7 @@
#:needed-in-image-p
#:component-load-dependencies #:run-shell-command ; deprecated, do not use
#:bundle-op #:monolithic-bundle-op #:precompiled-system #:compiled-file #:bundle-system
#+ecl #:make-build
#:program-system #:make-build
#:fasl-op #:load-fasl-op #:monolithic-fasl-op #:binary-op #:monolithic-binary-op
#:basic-compile-bundle-op #:prepare-bundle-op
#:compile-bundle-op #:load-bundle-op #:monolithic-compile-bundle-op #:monolithic-load-bundle-op
......
......@@ -10,16 +10,25 @@
(asdf-test::frob-packages)
(defun make-hello-image ()
#+mkcl
(defun add-mkcl-dll (pathname)
;; make sure mkcl-X.X.X.dll is the same directory as the executable
(let* ((dll-orig (subpathname (si::self-truename)
(strcat #-windows "../lib/"
"mkcl_" (lisp-implementation-version)
"." (asdf/bundle:bundle-pathname-type :shared-library))))
(dll-dest (subpathname pathname (strcat #-windows "../lib/" (file-namestring dll-orig)))))
(ensure-directories-exist dll-dest)
(copy-file dll-orig dll-dest)))
(defun make-hello-bundle (operation)
(operate 'load-fasl-op :hello-world-example)
(operate 'image-op :hello-world-example))
(operate operation :hello-world-example)
#+mkcl (add-mkcl-dll (asdf::output-file operation :hello-world-example)))
(defun make-hello-image ()
(make-hello-bundle 'image-op))
(defun make-hello-program ()
(operate 'load-fasl-op :hello-world-example)
(operate 'program-op :hello-world-example)
#+(and mkcl windows) ;; make sure mkcl-X.X.X.dll is the same directory as the executable
(let* ((dll-orig (subpathname (si::self-truename)
(strcat "mkcl_" (lisp-implementation-version) ".dll")))
(exe (asdf::output-file 'program-op :hello-world-example))
(dll-dest (subpathname exe dll-orig)))
(copy-file dll-orig dll-dest)))
(make-hello-bundle 'program-op))
......@@ -52,6 +52,7 @@
;;; Test dll-op and monolithic-dll-op on ECL and MKCL
#+(or ecl mkcl)
(progn
#+ecl (trace c::builder)
(require 'sockets) ;; Test the pre-compiled system feature
(operate 'dll-op :test-asdf/dll-test)
(let ((dll (first (output-files 'dll-op :test-asdf/dll-test))))
......
......@@ -45,6 +45,10 @@
(when (version< version-nums "1.1.2")
(leave-test "Your old ABCL is known to fail this test script, so skipping it." 0)))
#+mkcl
(when (version<= (lisp-implementation-version) "1.1.8")
(leave-test "Your old MKCL is known to fail this test script, so skipping it." 0))
(with-encoding-test (:utf-8)
(def-test-system :test-encoding-explicit-u8
:components ((:file "lambda" :encoding :utf-8))))
......
......@@ -15,7 +15,9 @@
(DBG :logical
(logical-pathname-translations "ASDF")
(translate-logical-pathname "ASDF:test;test-logical-pathname.asd")
(truename "ASDF:test;test-logical-pathname.asd"))
(truename "ASDF:test;test-logical-pathname.asd")
(translate-logical-pathname "ASDF:test;test-logical-pathname.lisp")
(translate-logical-pathname "ASDF:test;test-logical-pathname.fasl"))
#+(or gcl xcl) (leave-test "This implementation doesn't do Logical pathnames well enough" 0)
......
;;; -*- Lisp -*-
(DBG :foo (current-lisp-file-pathname))
#+mkcl (trace perform create-image component-depends-on) ;; compiler::build-shared-library compiler::build-static-library compiler::build-bundle compiler::build-program
#+ecl (trace perform create-image c::builder component-depends-on)
(unless (or #+(or allegro clisp clozure cmu (and ecl (not ecl-bytecmp)) lispworks mkcl sbcl scl) t)
(DBG "Creating images is not supported on your CL implementation")
(leave-test "Skipping test" 0))
......
......@@ -144,7 +144,6 @@
#+sbcl uiop/lisp-build:sb-grovel-unknown-constant-condition
;; on some implementations only
asdf/bundle:bundle-system
asdf/bundle:register-pre-built-system
asdf/bundle:static-library
uiop/os:parse-file-location-info
uiop/os:parse-windows-shortcut
......
......@@ -416,18 +416,19 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows."
(error "Can't ~S ~S: UIOP doesn't support image dumping with ~A.~%"
'dump-image filename (nth-value 1 (implementation-type))))
(defun create-image (destination object-files
&key kind output-name prologue-code epilogue-code
(defun create-image (destination lisp-object-files
&key kind output-name prologue-code epilogue-code extra-object-files
(prelude () preludep) (postlude () postludep)
(entry-point () entry-point-p) build-args)
(declare (ignorable destination object-files kind output-name prologue-code epilogue-code
prelude preludep postlude postludep entry-point entry-point-p build-args))
(declare (ignorable destination lisp-object-files extra-object-files kind output-name
prologue-code epilogue-code prelude preludep postlude postludep
entry-point entry-point-p build-args))
"On ECL, create an executable at pathname DESTINATION from the specified OBJECT-FILES and options"
;; Is it meaningful to run these in the current environment?
;; only if we also track the object files that constitute the "current" image,
;; and otherwise simulate dump-image, including quitting at the end.
#-ecl (error "~S not implemented for your implementation (yet)" 'create-image)
#+ecl
#-(or ecl mkcl) (error "~S not implemented for your implementation (yet)" 'create-image)
#+(or ecl mkcl)
(let ((epilogue-forms
(append
(when epilogue-code `(,epilogue-code))
......@@ -438,19 +439,26 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows."
((:image)
(setf kind :program) ;; to ECL, it's just another program.
`((setf *image-dumped-p* t)
(si::top-level t) (quit)))
(si::top-level #+ecl t) (quit)))
((:program)
`((setf *image-dumped-p* :executable)
(shell-boolean-exit
(restore-image))))))))
(check-type kind (member :dll :lib :static-library :program :object :fasl :program))
(apply 'c::builder
kind (pathname destination)
:lisp-files object-files
:init-name (c::compute-init-name (or output-name destination) :kind kind)
:prologue-code prologue-code
:epilogue-code (when epilogue-forms `(progn ,@epilogue-forms))
build-args))))
#+ecl (check-type kind (member :dll :lib :static-library :program :object :fasl))
(apply #+ecl 'c::builder #+ecl kind
#+mkcl (ecase kind
((:dll) 'compiler::build-shared-library)
((:lib :static-library) 'compiler::build-static-library)
((:fasl) 'compiler::build-bundle)
((:program) 'compiler::build-program))
(pathname destination)
#+ecl :lisp-files #+mkcl :lisp-object-files (append lisp-object-files #+ecl extra-object-files)
#+ecl :init-name #+ecl (c::compute-init-name (or output-name destination) :kind kind)
(append
(when prologue-code `(:prologue-code ,prologue-code))
(when epilogue-forms `(:epilogue-code (progn ,@epilogue-forms)))
#+mkcl (when extra-object-files `(:object-files ,extra-object-files))
build-args)))))
;;; Some universal image restore hooks
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment