Commit c52a4f83 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Fixes and refactoring of asdf/bundle and uiop/image for ECL.

Testing the latest cl-launch with ECL showed massive bitrot in the bundle support for ECL.
* Make better use of ASDF3's class hierarchy in redefining asdf/bundle,
  by removing and adding the mixins: goodbye bundle-compile-op and monolithic-,
  hello link-op and gather-op. Also, reinstate bundle-system as a class
  to hold prologue and epilogue (but do we need these, now with portable ASDF3 image support?)
* rename binary-op to deliver-asd-op, same for monolithic-
* Introduce image-op as a superclass of program-op,
  for dumping an executable image with the regular top-level.
* Redo the way operation flags are or aren't propagated:
  gather-op explicitly does not pass the flags,
  so toplevel options are for the toplevel build only
  -- though they belong to the system, not the operation.
  Therefore get rid of no-ld-flags-op -- if there are flags to pass,
  they should be passed explicitly in gather-op;
  or more likely, they might be slots in the system, or the plan,
  or special variables for the current session.
  OPERATE tries harder to preserve the original-initargs,
  which are not clobbered by asdf/bundle's initialize-instance anymore.
* Punt for command-line-arguments on LispWorks,
  so the user has a slight chance of setting them.
parent df7d114c
":" ; exec cl-launch "$0" "$@"
#| -*- Lisp -*-
Usage: cl-launch -l lispworks install-asdf-as-module
Usage: make && cl-launch -l lispworks bin/install-asdf-as-module
This script will install the current version of ASDF
as a module pre-compiled for your implementation,
......
This diff is collapsed.
......@@ -40,8 +40,8 @@
#:bundle-op #:monolithic-bundle-op #:precompiled-system #:compiled-file #:bundle-system
#+ecl #:make-build
#:basic-fasl-op #:prepare-fasl-op #:fasl-op #:load-fasl-op #:monolithic-fasl-op
#:lib-op #:dll-op #:binary-op #:program-op
#:monolithic-lib-op #:monolithic-dll-op #:monolithic-binary-op
#:lib-op #:dll-op #:deliver-asd-op #:program-op #:image-op
#:monolithic-lib-op #:monolithic-dll-op #:monolithic-deliver-asd-op
#:concatenate-source-op
#:load-concatenated-source-op
#:compile-concatenated-source-op
......
......@@ -58,6 +58,7 @@ The :FORCE or :FORCE-NOT argument to OPERATE can be:
(operation-name (reify-symbol (etypecase operation
(operation (type-of operation))
(symbol operation))))
(operation-initargs (operation-original-initargs operation))
(component-path (typecase component
(component (component-find-path component))
(t component))))
......@@ -69,7 +70,9 @@ The :FORCE or :FORCE-NOT argument to OPERATE can be:
;; its function may have been redefined, its symbol uninterned, its package deleted.
(return-from operate
(apply (find-symbol* 'operate :asdf)
(unreify-symbol operation-name)
(apply (find-symbol* 'make-operation :asdf)
(unreify-symbol operation-name)
:original-initargs operation-initargs operation-initargs)
component-path keys))))
;; Setup proper bindings around any operate call.
(with-system-definitions ()
......
......@@ -7,7 +7,9 @@
(defun main (&rest arguments)
(format t "hello, world~%")
(when arguments
(format t "You passed ~D arguments:~%~{ ~S~%~}" (length arguments) arguments)))
(format t "You passed ~D arguments:~%~{ ~S~%~}" (length arguments) arguments))
;; Return success!
t)
(defun entry-point ()
(apply 'main *command-line-arguments*))
......@@ -29,7 +29,6 @@
(when (version< version-nums "1.2.0")
(leave-test "Your old ABCL is known to fail this test script, so skipping it." 0)))
(defparameter *bundle-1* (output-file 'fasl-op :test-asdf/bundle-1))
(defparameter *bundle-2* (output-file 'fasl-op :test-asdf/bundle-2))
(defparameter *mono-bundle-2* (output-file 'monolithic-fasl-op :test-asdf/bundle-2))
......
......@@ -11,31 +11,32 @@
(defparameter *good-classes*
'(build-op
prepare-source-op
prepare-op
prepare-fasl-op
load-op
monolithic-load-compiled-concatenated-source-op
prepare-fasl-op
load-source-op
compile-concatenated-source-op
compile-op
concatenate-source-op
deliver-asd-op
dll-op
fasl-op
image-op
lib-op
load-compiled-concatenated-source-op
monolithic-load-concatenated-source-op
load-concatenated-source-op
load-fasl-op
compile-op
compile-concatenated-source-op
test-op
fasl-op
program-op
load-op
load-source-op
monolithic-compile-concatenated-source-op
monolithic-concatenate-source-op
monolithic-deliver-asd-op
monolithic-dll-op
monolithic-binary-op
monolithic-fasl-op
dll-op
concatenate-source-op
monolithic-lib-op
monolithic-concatenate-source-op
lib-op)
monolithic-load-compiled-concatenated-source-op
monolithic-load-concatenated-source-op
prepare-fasl-op
prepare-op
prepare-source-op
program-op
test-op)
"All of these classes should be instantiable without error.")
(defclass my-unupdated-operation (operation)
......
......@@ -243,7 +243,10 @@ depending on whether *LISP-INTERACTION* is set, enter debugger or die"
Assume the calling conventions of a generated script that uses --
if we are not called from a directly executable image."
#+abcl arguments
#-abcl
;; LispWorks command-line processing isn't transparent to the user, and
;; we need to rely on cl-launch or some other script to set it for us.
#+lispworks *command-line-arguments*
#-(or abcl lispworks)
(let* (#-(or sbcl allegro)
(arguments
(if (eq *image-dumped-p* :executable)
......@@ -377,21 +380,29 @@ by setting appropriate variables, running various hooks, and calling any specifi
;; and otherwise simulate dump-image, including quitting at the end.
#-ecl (error "~S not implemented for your implementation (yet)" 'create-image)
#+ecl
(progn
(check-type kind (member :binary :dll :lib :static-library :program :object :fasl :program))
(let ((epilogue-forms
(append
(when epilogue-code `(,epilogue-code))
(when postludep `((setf *image-postlude* ',postlude)))
(when preludep `((setf *image-prelude* ',prelude)))
(when entry-point-p `((setf *image-entry-point* ',entry-point)))
(case kind
((:image)
(setf kind :program) ;; to ECL, it's just another program.
`((setf *image-dumped-p* t)
;; fall through should be equivalent to: (si::top-level 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
`(progn
,epilogue-code
,@(when (eq kind :program)
`((setf *image-dumped-p* :executable)
(restore-image ;; default behavior would be (si::top-level)
,@(when preludep `(:prelude ',prelude))
,@(when entry-point-p `(:entry-point ',entry-point))))))
:epilogue-code (when epilogue-forms `(progn ,@epilogue-forms))
build-args))))
......
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