Mercurial > core / lisp/lib/cli/tools/sbcl.lisp
changeset 651: |
af486e0a40c9 |
parent: |
f6a340b92274
|
author: |
Richard Westhaver <ellis@rwest.io> |
date: |
Sat, 14 Sep 2024 22:13:06 -0400 |
permissions: |
-rw-r--r-- |
description: |
multi-binaries, working on removing x.lisp |
1 ;;; sbcl.lisp --- SBCL Tools 6 (in-package :cli/tools/sbcl) 8 (deferror sbcl-error (simple-error error) ()) 10 (defun sbcl-error (fmt &rest args) 11 (error 'sbcl-error :format-arguments args :format-control fmt)) 13 (defparameter *sbcl* (or sb-ext:*runtime-pathname* (find-exe "sbcl"))) 15 ;; ref: section 3.3.1 of the manual 16 (defvar *sbcl-runtime-options* 17 '(help version core dynamic-space-size control-stack-size tls-limit 18 noinform disable-ldb lose-on-corruption merge-core-pages no-merge-core-pages)) 20 (defvar *sbcl-toplevel-options* 21 '(sysinit userinit no-sysinit no-userinit disable-debugger noprint script quit non-interactive eval load)) 23 (defun parse-sbcl-option-keys (keys) 25 (sb-int:doplist (k v) keys 27 (push (format nil "--~A" (string-downcase (symbol-name k))) ret) 30 (string (push v ret))))) 33 (defun run-sbcl (&rest args) 34 (let ((proc (sb-ext:run-program *sbcl* (or args nil) :output :stream))) 35 (with-open-stream (s (sb-ext:process-output proc)) 36 (loop for l = (read-line s nil nil) 39 (if (eq 0 (sb-ext:process-exit-code proc)) 41 (sbcl-error "SBCL command failed: ~A ~A" *sbcl* (or args ""))))) 43 (defmacro with-sbcl ((&rest keys) &body body) 44 "Convenience macro for running an external SBCL process in its own shell. The 45 keys are the same as those listed in `sbcl --help` and the BODY is wrapped in 46 a PROGN and passed to the --eval flag." 47 `(run-sbcl ,@(when keys (parse-sbcl-option-keys keys)) 50 (mapcar (lambda (x) (list "--eval" (with-output-to-string (s) (prin1 x s))))