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

1.0.1: better handle LispWorks, which now depends on ASDF 3.1.0.118

parent 0001d3f2
No related branches found
No related tags found
No related merge requests found
...@@ -17,6 +17,6 @@ ...@@ -17,6 +17,6 @@
:long-description "lisp-invocation allows you to portably execute Lisp code :long-description "lisp-invocation allows you to portably execute Lisp code
as subprocesses of a current Lisp process. as subprocesses of a current Lisp process.
All known command-line accessible Common Lisp implementations are supported." All known command-line accessible Common Lisp implementations are supported."
:version "1.0.0" :version "1.0.1"
:depends-on (#-asdf3 :uiop) :depends-on (#-asdf3 :uiop)
:components ((:file "lisp-invocation"))) :components ((:file "lisp-invocation")))
...@@ -19,8 +19,10 @@ ...@@ -19,8 +19,10 @@
#:lisp-implementation-argument-control #:lisp-implementation-argument-control
#:lisp-implementation-disable-debugger #:lisp-implementation-disable-debugger
#:lisp-implementation-directory-variable #:lisp-implementation-directory-variable
#:lisp-implementation-invoker
#:lisp-environment-variable-name #:lisp-environment-variable-name
#:lisp-invocation-arglist #:lisp-invocation-arglist
#:invoke-lisp
#:quit-form #:quit-form
#:save-image-form)) #:save-image-form))
...@@ -45,6 +47,7 @@ ...@@ -45,6 +47,7 @@
disable-debugger disable-debugger
directory-variable directory-variable
;; fasl-type cfasl-type ;; fasl-type cfasl-type
invoker
quit-format quit-format
dump-format) dump-format)
...@@ -186,13 +189,14 @@ ...@@ -186,13 +189,14 @@
:feature :lispworks :feature :lispworks
:flags ("-site-init" "-" "-init" "-") :flags ("-site-init" "-" "-init" "-")
:eval-flag "-eval" :eval-flag "-eval"
:load-flag "-load" ;; Is this what we want? See also -build as magic load. :load-flag "-build" ;; Is -load what we want? See also -build as magic load.
:arguments-end nil ; What's the deal with THIS? "--" :arguments-end nil ; What's the deal with THIS? "--"
:image-flag nil :image-flag nil
:image-executable-p t :image-executable-p t
:standalone-executable t :standalone-executable t
:argument-control t :argument-control t
:disable-debugger () :disable-debugger ()
:invoker invoke-lisp-via-script
:quit-format "(lispworks:quit :status ~A :confirm nil :return nil :ignore-errors-p t)" :quit-format "(lispworks:quit :status ~A :confirm nil :return nil :ignore-errors-p t)"
;; when you dump, you may also have to (system::copy-file ".../lwlicense" (make-pathname :name "lwlicense" :type nil :defaults filename)) ;; when you dump, you may also have to (system::copy-file ".../lwlicense" (make-pathname :name "lwlicense" :type nil :defaults filename))
:dump-format "(lispworks:deliver 'xcvb-driver:resume ~A 0 :interface nil)") ; "(hcl:save-image ~A :environment nil)" :dump-format "(lispworks:deliver 'xcvb-driver:resume ~A 0 :interface nil)") ; "(hcl:save-image ~A :environment nil)"
...@@ -316,7 +320,7 @@ ...@@ -316,7 +320,7 @@
(mapcan (if load-flag (mapcan (if load-flag
(lambda (x) (list load-flag (native-namestring x))) (lambda (x) (list load-flag (native-namestring x)))
(lambda (x) (list eval-flag (format nil "(load ~S)" (native-namestring x))))) (lambda (x) (list eval-flag (format nil "(load ~S)" (native-namestring x)))))
(if (listp load) load (list load))) (ensure-list load))
(when eval (when eval
(list eval-flag eval)) (list eval-flag eval))
(when arguments (when arguments
...@@ -324,6 +328,75 @@ ...@@ -324,6 +328,75 @@
(error "Can't reliably pass arguments to Lisp implementation ~A" implementation-type)) (error "Can't reliably pass arguments to Lisp implementation ~A" implementation-type))
(cons arguments-end arguments))))) (cons arguments-end arguments)))))
(defun lisp-invoker (&optional (implementation-type (implementation-type)))
(or (lisp-implementation-invoker (get-lisp-implementation implementation-type))
'invoke-lisp-directly))
(defun invoke-lisp
(&rest keys
&key (implementation-type (implementation-type))
lisp-path
(lisp-flags :default)
image-path
load
eval
arguments
debugger
cross-compile
(run-program 'run-program)
run-program-args)
(declare (ignore lisp-path lisp-flags image-path load eval arguments debugger cross-compile
run-program run-program-args))
(apply (lisp-invoker implementation-type)
keys))
(defun invoke-lisp-directly
(&rest keys
&key (implementation-type (implementation-type))
lisp-path
(lisp-flags :default)
image-path
load
eval
arguments
debugger
cross-compile
(run-program 'run-program)
run-program-args)
(declare (ignore implementation-type lisp-path lisp-flags image-path
load eval arguments debugger cross-compile))
(apply run-program
(apply 'lisp-invocation-arglist (remove-plist-keys '(:run-program :run-program-args) keys))
run-program-args))
(defun invoke-lisp-via-script
(&rest keys
&key implementation-type
lisp-path
lisp-flags
image-path
load
eval
arguments
debugger
cross-compile
(run-program 'run-program)
run-program-args)
(declare (ignore implementation-type lisp-path lisp-flags image-path debugger cross-compile
run-program run-program-args))
(with-temporary-file (:stream s :pathname p :type "lisp")
(when arguments
(format s "(unless (find-package :uiop/image) (defpackage :uiop/image (:use :cl)))~%~
(defparameter uiop/image::*command-line-arguments* '~S)~%"
arguments))
(loop :for l :in (ensure-list load) :do (format s "(cl:load ~S)~%" l))
(format s "~@[~A~]~%" eval)
:close-stream
(apply 'invoke-lisp-directly
:load (native-namestring p)
(remove-plist-keys '(:load :eval) keys))))
;;; Avoiding use of a compiled-in driver in the build process ;;; Avoiding use of a compiled-in driver in the build process
(defun quit-form (&key code (implementation-type (implementation-type))) (defun quit-form (&key code (implementation-type (implementation-type)))
......
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