diff --git a/lisp/dump.ros b/lisp/dump.ros index a82a066..ce80762 100644 --- a/lisp/dump.ros +++ b/lisp/dump.ros @@ -49,7 +49,8 @@ exec ros -- $0 "$@" (%dump (ensure-directories-exist path) :normal)))))) #+sbcl -(defun %dump-executable (cmds out) +(defun %dump-executable (cmds out script) + (declare (ignore script)) (sb-ext:save-lisp-and-die out ;; no need to do GC because of :purify t by default @@ -66,7 +67,8 @@ exec ros -- $0 "$@" #+ccl -(defun %dump-executable (cmds out) +(defun %dump-executable (cmds out script) + (declare (ignore script)) (ccl:save-application out :toplevel-function @@ -77,7 +79,8 @@ exec ros -- $0 "$@" :prepend-kernel t)) #+clisp -(defun %dump-executable (cmds out) +(defun %dump-executable (cmds out script) + (declare (ignore script)) (ext:saveinitmem out :quiet t @@ -114,10 +117,139 @@ exec ros -- $0 "$@" (ros:run cmds)) :process-command-line nil)) -#-(or sbcl ccl clisp (and cmucl executable)) -(defun %dump-executable (cmds out) + +;;; ecl [WIP] + +;; In ecl, we have to explicitly specify ALL object(fasl) files +;; in order to build a standalone executable. +;; uiop/image:create-image / dump-image does the similar things. + + +;; cf.https://common-lisp.net/project/ecl/manual/ch34s03.html +;; c:build-program +;; {image-name &key lisp-files ld-flags prologue-code epilogue-code} + +#+ecl +(defun print-%-readable-or-lose (sym-name &optional (s *standard-output*)) + (let ((*print-readably* t)) + (handler-case + (format s + "(% ~s '~s)~%" + sym-name + (ignore-errors + (symbol-value + (read-from-string sym-name)))) + (print-not-readable ())))) + +#+ecl +(defun %dump-executable (cmds out ros-file) + (let* ((tmp (uiop:run-program "mktemp -d" :output '(:string :stripped t))) + (ros-opts-file (format nil "~a/ros-opts.lisp" tmp)) + objfiles + (*compile-verbose* t) + (*compile-print* t)) + (format *error-output* "~&; In directory ~a~%" tmp) + (unwind-protect + (progn + (with-open-file (*standard-output* + ros-opts-file + :direction :output + :if-does-not-exist :create) + #+nil + (prin1 + `(setf *load-verbose* t + *load-print* t)) + (terpri) + ;; fixme: duplicated, but necessary + (prin1 + `(defpackage :ros + (:use :cl) + (:shadow :load :eval :package :restart :print :write) + (:export :run :*argv* :*main* :quit :script :quicklisp :getenv :opt + :ignore-shebang :ensure-using-downloaded-asdf :include :ensure-asdf + :roswell :exec :setenv :unsetenv :version :swank :verbose) + (:documentation "Roswell backend."))) + (terpri) + (progn + (prin1 + `(cl:load ,(make-pathname + :name "init" + :type "lisp" + :defaults #.*load-pathname*))) + (terpri)) + #+nil + (progn + (prin1 + `(in-package :ros)) + (terpri) + (princ + "(defmacro eval-with-printing (&body body) + (list* 'progn + (loop for form in body + collect (list 'cl:print (list 'quote form)) + collect (list 'cl:terpri) + collect (list 'cl:finish-output) + collect form)))") + (terpri) + (format *standard-output* "~&(eval-with-printing~&") + (terpri) + (princ `(defun % (string value) + (ignore-errors + (setf (symbol-value + (read-from-string string)) + value)))) + (terpri) + (princ + `(trace %)) + (terpri) + (dolist (sym-name '("QUICKLISP-CLIENT::*LOCAL-PROJECT-DIRECTORIES*" + "ROS::*ROS-OPTS*")) + (print-%-readable-or-lose sym-name)) + (terpri) + (prin1 + `(format t "~&loading init.ros...~&")) + (with-open-file (s (make-pathname + :name "init" + :type "lisp" + :defaults #.*load-pathname*)) + (ignore-errors + ;; copy and paste + (loop (write-char (read-char s) *standard-output*)))) + (format *standard-output* "~&)~&"))) + (format *error-output* "~&finished dumping all special variables.") + (proclaim '(optimize (debug 3) (speed 0))) + (push (compile-file ros-opts-file + :system-p t + :output-file + (format nil "~a/ros-opts.o" tmp)) objfiles) + (push (compile-file ros-file + :system-p t + :output-file + (format nil "~a/script.o" tmp)) objfiles) + (c:build-program + out + :lisp-files ;#+nil + ;; objfiles + ;; #+nil + (nreverse objfiles) + :epilogue-code + (print + `(progn + (setf *load-pathname* (pathname (ext:argv 0))) + (setf ros:*argv* + (eval + (read-from-string + "(loop :for i :from 0 :below (ext:argc) + :collect (ext:argv i))"))) + (print ros:*argv*) + (ros:run ',cmds))))) + ;; (uiop:run-program (format nil "rm -r ~a" tmp)) + ))) + +#-(or sbcl ccl clisp ecl (and cmucl executable)) +(defun %dump-executable (cmds out script) "more informative error message" - (declare (ignorable cmds)) + (declare (ignorable cmds script)) (format *error-output* "While dumping to ~a: ros dump executable is supported only when the following features are satisfied: @@ -165,7 +297,7 @@ On CMUCL, :executable is supported on x86, solaris and sparc. ;; ((:entry "COMMON-LISP:NIL")), which eventually fails. ;; it is better to capture this. (warn "dumping an executable without specifing the initial behaviour.")) - (%dump-executable cmds output)) + (%dump-executable cmds output script)) (format *error-output* "Usage: ros dump executable help~%")))