Skip to content
Browse files

Merge pull request #5 from lokedhs/master

Add the function TRIVIAL-SHELL:EXIT
  • Loading branch information...
2 parents c8d98b4 + f442762 commit da2a652ab3476fa38b925994aba7adc61022e8fd @gwkkwg committed
Showing with 55 additions and 6 deletions.
  1. +2 −0 dev/allegro.lisp
  2. +3 −0 dev/clisp.lisp
  3. +6 −1 dev/cmucl.lisp
  4. +3 −0 dev/digitool.lisp
  5. +4 −1 dev/ecl.lisp
  6. +4 −1 dev/lispworks.lisp
  7. +4 −1 dev/openmcl.lisp
  8. +1 −0 dev/package.lisp
  9. +15 −1 dev/sbcl.lisp
  10. +4 −1 dev/scl.lisp
  11. +9 −0 dev/shell.lisp
View
2 dev/allegro.lisp
@@ -32,3 +32,5 @@
(defun %get-env-var (name)
(sys:getenv name))
+(defun %exit (code)
+ (excl:exit code))
View
3 dev/clisp.lisp
@@ -14,3 +14,6 @@
(defun %get-env-var (name)
(ext:getenv name))
+
+(defun %exit (code)
+ (ext:exit code))
View
7 dev/cmucl.lisp
@@ -21,4 +21,9 @@
(defun %get-env-var (name)
(cdr (assoc (intern (substitute #\_ #\- name)
:keyword)
- ext:*environment-list*)))
+ ext:*environment-list*)))
+
+(defun %exit (code)
+ (unless (zerop code)
+ (error "CMUCL does not support exit codes."))
+ (ext:quit t))
View
3 dev/digitool.lisp
@@ -4,3 +4,6 @@
(when input
(error "This version of trivial-shell does not support the input parameter."))
(ccl:do-shell-script command))
+
+(defun %exit (code)
+ (error 'unsupported-function-error :function 'exit))
View
5 dev/ecl.lisp
@@ -7,4 +7,7 @@
(error 'unsupported-function-error :function 'os-process-id))
(defun %get-env-var (name)
- (ext:getenv name))
+ (ext:getenv name))
+
+(defun %exit (code)
+ (ext:exit code))
View
5 dev/lispworks.lisp
@@ -19,4 +19,7 @@
(error 'unsupported-function-error :function 'os-process-id))
(defun %get-env-var (name)
- (lw:environment-variable name))
+ (lw:environment-variable name))
+
+(defun %exit (code)
+ (lw:quit :status code))
View
5 dev/openmcl.lisp
@@ -30,4 +30,7 @@
(error 'unsupported-function-error :function 'os-process-id))
(defun %get-env-var (name)
- (ccl::getenv name))
+ (ccl::getenv name))
+
+(defun %exit (code)
+ (ccl:quit code))
View
1 dev/package.lisp
@@ -7,6 +7,7 @@
#:shell-command
#:with-timeout
#:get-env-var
+ #:exit
#:*bourne-compatible-shell*
#:*shell-search-paths*
View
16 dev/sbcl.lisp
@@ -84,4 +84,18 @@
(error 'unsupported-function-error :function 'os-process-id))
(defun %get-env-var (name)
- (sb-ext:posix-getenv name))
+ (sb-ext:posix-getenv name))
+
+(defun symbol-if-external (name package)
+ (multiple-value-bind (symbol s) (find-symbol name package)
+ (when (eq s :external)
+ symbol)))
+
+(defun %exit (code)
+ (let ((exit-sym (symbol-if-external "EXIT" "SB-EXT")))
+ (if exit-sym
+ (funcall exit-sym :code code)
+ (let ((quit-sym (symbol-if-external "QUIT" "SB-EXT")))
+ (if quit-sym
+ (funcall quit-sym :unix-status code :recklessly-p t)
+ (error "SBCL version without EXIT or QUIT."))))))
View
5 dev/scl.lisp
@@ -7,4 +7,7 @@
(error 'unsupported-function-error :function 'os-process-id))
(defun %get-env-var (name)
- (cdr (assoc name ext:*environment-list* :test #'string=))
+ (cdr (assoc name ext:*environment-list* :test #'string=))
+
+(defun %exit (code)
+ (ext:quit :status code))
View
9 dev/shell.lisp
@@ -69,3 +69,12 @@ may be used to find a shell to use in executing `command`."
(defun get-env-var (name)
"Return the value of the environment variable `name`."
(%get-env-var name))
+
+(defun exit (&optional (code :success))
+ "Exit the process. CODE is either a numeric exit code, or the special values :SUCCESS
+or :FAILURE, which maps to the appropriate exit codes for the operating system."
+ ;; Currently, :SUCCESS always maps to 0 and :FAILURE maps to 1
+ (%exit (cond ((eq code :success) 0)
+ ((eq code :failure) 1)
+ ((integerp code) code)
+ (t (error "Illegal exit code: ~s (should be an integer or the values :SUCCESS or :FAILURE)" code)))))

0 comments on commit da2a652

Please sign in to comment.
Something went wrong with that request. Please try again.