Skip to content
Snippets Groups Projects
Commit 1dfd01f0 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

2.26.135: fix argument passing to ECL executables

Have asdf/defsystem's bundle use asdf/driver's image.
parent 2a9ea6f2
No related branches found
No related tags found
No related merge requests found
* 2.6.134: fix u (abcl, ccl, clisp, cmucl)
* Learn to use cl-grid-test, to make sure ASDF changes don't break stuff, * Learn to use cl-grid-test, to make sure ASDF changes don't break stuff,
and that breakage gets fixed quickly. and that breakage gets fixed quickly.
* Test stassats's thing: * Test stassats's thing:
......
...@@ -15,7 +15,7 @@ ...@@ -15,7 +15,7 @@
:licence "MIT" :licence "MIT"
:description "Another System Definition Facility" :description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems." :long-description "ASDF builds Common Lisp software organized into defined systems."
:version "2.26.134" ;; to be automatically updated by make bump-version :version "2.26.135" ;; to be automatically updated by make bump-version
:depends-on () :depends-on ()
:components ((:module "build" :components ((:file "asdf")))) :components ((:module "build" :components ((:file "asdf"))))
:in-order-to (#+asdf2.27 (compile-op (monolithic-load-concatenated-source-op asdf/defsystem)))) :in-order-to (#+asdf2.27 (compile-op (monolithic-load-concatenated-source-op asdf/defsystem))))
......
...@@ -455,21 +455,18 @@ ...@@ -455,21 +455,18 @@
(let* ((object-files (input-files o c)) (let* ((object-files (input-files o c))
(output (output-files o c)) (output (output-files o c))
(bundle (first output)) (bundle (first output))
(kind (bundle-type o)) (kind (bundle-type o)))
(init-name (c::compute-init-name bundle :kind kind))) (create-image
(apply #'c::builder kind (first output) bundle (append object-files (bundle-op-lisp-files o))
:init-name init-name :kind kind
:lisp-files (append object-files (bundle-op-lisp-files o)) :entry-point (component-entry-point c)
(append (bundle-op-build-args o) :prologue-code
(when (and (typep o 'monolithic-bundle-op) (when (typep o 'monolithic-bundle-op)
(monolithic-op-prologue-code o)) (monolithic-op-prologue-code o))
`(:prologue-code ,(monolithic-op-prologue-code o))) :epilogue-code
(when (typep o 'program-op) (when (typep o 'monolithic-bundle-op)
`(:epilogue-code (monolithic-op-epilogue-code o))
(restore-image :entry-point ,(component-entry-point c)))) :build-args (bundle-op-build-args o))))
(when (and (typep o 'monolithic-bundle-op)
(monolithic-op-epilogue-code o))
`(:epilogue-code ,(monolithic-op-epilogue-code o)))))))
#+mkcl #+mkcl
(progn (progn
......
;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*- ;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*-
;;; This is ASDF 2.26.134: Another System Definition Facility. ;;; This is ASDF 2.26.135: Another System Definition Facility.
;;; ;;;
;;; Feedback, bug reports, and patches are all welcome: ;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>. ;;; please mail to <asdf-devel@common-lisp.net>.
......
...@@ -202,8 +202,8 @@ This is designed to abstract away the implementation specific quit forms." ...@@ -202,8 +202,8 @@ This is designed to abstract away the implementation specific quit forms."
(defun* command-line-arguments (&optional (arguments (raw-command-line-arguments))) (defun* command-line-arguments (&optional (arguments (raw-command-line-arguments)))
"Extract user arguments from command-line invocation of current process. "Extract user arguments from command-line invocation of current process.
Assume the calling conventions of an XCVB-generated script Assume the calling conventions of a generated script that uses --
if we are not called from a directly executable image dumped by XCVB." if we are not called from a directly executable image."
#+abcl arguments #+abcl arguments
#-abcl #-abcl
(let* (#-(or sbcl allegro) (let* (#-(or sbcl allegro)
...@@ -292,22 +292,27 @@ if we are not called from a directly executable image dumped by XCVB." ...@@ -292,22 +292,27 @@ if we are not called from a directly executable image dumped by XCVB."
#+ecl #+ecl
(defun create-image (destination object-files (defun create-image (destination object-files
&key kind output-name &key kind output-name prologue-code epilogue-code
(prelude () preludep) (entry-point () entry-point-p)) (prelude () preludep) (entry-point () entry-point-p) build-args)
;; Is it meaningful to run these in the current environment? ;; Is it meaningful to run these in the current environment?
;; only if we also track the object files that constitute the "current" image, ;; only if we also track the object files that constitute the "current" image,
;; and otherwise simulate dump-image, including quitting at the end. ;; and otherwise simulate dump-image, including quitting at the end.
;; (standard-eval-thunk *image-postlude*) (call-image-dump-hook) ;; (standard-eval-thunk *image-postlude*) (call-image-dump-hook)
(check-type kind (member :program :shared-library)) (check-type kind (member :binary :dll :lib :static-library :program :object :fasl :program))
(c::builder (apply 'c::builder
kind (pathname destination) kind (pathname destination)
:lisp-files object-files :lisp-files object-files
:init-name (c::compute-init-name (or output-name destination) :kind kind) :init-name (c::compute-init-name (or output-name destination) :kind kind)
:epilogue-code :prologue-code prologue-code
(when (eq kind :program) :epilogue-code
`(restore-image ;; default behavior would be (si::top-level) `(progn
,@(when preludep `(:prelude ',prelude)) ,epilogue-code
,@(when entry-point-p `(:entry-point ',entry-point)))))) ,@(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))))))
build-args))
;;; Some universal image restore hooks ;;; Some universal image restore hooks
......
...@@ -35,7 +35,7 @@ ...@@ -35,7 +35,7 @@
;; "2.345.6" would be a development version in the official upstream ;; "2.345.6" would be a development version in the official upstream
;; "2.345.0.7" would be your seventh local modification of official release 2.345 ;; "2.345.0.7" would be your seventh local modification of official release 2.345
;; "2.345.6.7" would be your seventh local modification of development version 2.345.6 ;; "2.345.6.7" would be your seventh local modification of development version 2.345.6
(asdf-version "2.26.134") (asdf-version "2.26.135")
(existing-asdf (find-class (find-symbol* :component :asdf nil) nil)) (existing-asdf (find-class (find-symbol* :component :asdf nil) nil))
(existing-version *asdf-version*) (existing-version *asdf-version*)
(already-there (equal asdf-version existing-version)) (already-there (equal asdf-version existing-version))
......
"2.26.134" "2.26.135"
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment