From db355ead88d40ef371a828648a476ad6d8cce663 Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau Date: Thu, 4 May 2017 17:26:29 -0400 Subject: [PATCH] Make static linking command more robust Ensure symbols are printed and read from package asdf, instead of printed from package common-lisp and read from what is probably common-lisp-user but without 100% guarantee. This also makes the printed output easy to copyable and pastable into any syntactic context that will let you use require and in-package. Finally symbols in sub-packages of ASDF won't be printed as being of their particular subpackage, which works better if there are package discrepancies between the implementation-provided ASDF and the configured ASDF to which it will be upgraded at the first command. Add some comments and reformat some code. --- toolchain/static-link.lisp | 30 ++++++++++++++++-------------- 1 file changed, 16 insertions(+), 14 deletions(-) diff --git a/toolchain/static-link.lisp b/toolchain/static-link.lisp index 59de8f1..ac87679 100644 --- a/toolchain/static-link.lisp +++ b/toolchain/static-link.lisp @@ -55,30 +55,32 @@ #+clisp "-M" #+sbcl "--core" image `(#+clisp ,@'("--silent" "-ansi" "-norc" "-x") #+sbcl ,@'("--noinform" "--non-interactive" "--no-sysinit" "--no-userinit" "--eval") - ,(with-safe-io-syntax () + ,(with-safe-io-syntax (:package :asdf) (let ((*print-pretty* nil) (*print-case* :downcase)) (format ;; This clever staging allows to put things in a single form, ;; as required for CLISP not to print output for the first form, ;; yet allow subsequent forms to rely on packages defined by former forms. - nil "'(#.~S #.~S)" + nil "'(~@{#.~S~^ ~})" '(require "asdf") + '(in-package :asdf) `(progn - ,@(if-let (ql-home (symbol-value - (find-symbol* '*quicklisp-home* 'ql-setup nil))) - `((load ,(subpathname ql-home "setup.lisp")))) - (setf *central-registry* ',*central-registry*) - (initialize-source-registry - ',asdf/source-registry:*source-registry-parameter*) - (initialize-output-translations - ',asdf/output-translations:*output-translations-parameter*) + ,@(if-let (ql-home (find-symbol* :*quicklisp-home* :ql-setup nil)) + `((load ,(subpathname (symbol-value ql-home) "setup.lisp")))) + (setf asdf:*central-registry* ',asdf:*central-registry*) + (initialize-source-registry ',asdf::*source-registry-parameter*) + (initialize-output-translations ',asdf::*output-translations-parameter*) (load-system "cffi-grovel") - (defmethod operation-done-p ((operation ,child-op) - (system (eql (find-system ,name)))) + ;; We force the operation to take place + (defmethod operation-done-p + ((operation ,child-op) (system (eql (find-system ,name)))) nil) - (defmethod output-files ((operation ,child-op) - (system (eql (find-system ,name)))) + ;; Some implementations (notably SBCL) die as part of dumping an image, + ;; so redirect output-files to desired destination, for this processs might + ;; never otherwise get a chance to move the file to destination. + (defmethod output-files + ((operation ,child-op) (system (eql (find-system ,name)))) (values (list ,tmp) t)) (operate ',child-op ,name) (quit)))))))))) -- 2.11.4.GIT