Skip to content
Snippets Groups Projects
Commit 65855429 authored by pw's avatar pw
Browse files

From Paul Foley:

	This patch makes QUIT call a list of functions at
	exit, so that the Motif interface can clean up without having to
	redefine it.
parent c9918062
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/lispinit.lisp,v 1.63 2001/04/07 14:10:58 pw Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/lispinit.lisp,v 1.64 2001/07/08 17:41:41 pw Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -433,6 +433,9 @@ ...@@ -433,6 +433,9 @@
;;;; Miscellaneous external functions: ;;;; Miscellaneous external functions:
(defvar *cleanup-functions* nil
"Functions to be invoked during cleanup at Lisp exit.")
;;; Quit gets us out, one way or another. ;;; Quit gets us out, one way or another.
(defun quit (&optional recklessly-p) (defun quit (&optional recklessly-p)
...@@ -440,7 +443,9 @@ ...@@ -440,7 +443,9 @@
non-Nil." non-Nil."
(if recklessly-p (if recklessly-p
(unix:unix-exit 0) (unix:unix-exit 0)
(throw '%end-of-the-world 0))) (progn
(mapc (lambda (fn) (ignore-errors (funcall fn))) *cleanup-functions*)
(throw '%end-of-the-world 0))))
#-mp ; Multi-processing version defined in multi-proc.lisp. #-mp ; Multi-processing version defined in multi-proc.lisp.
...@@ -455,8 +460,8 @@ ...@@ -455,8 +460,8 @@
(multiple-value-bind (sec usec) (multiple-value-bind (sec usec)
(if (integerp n) (if (integerp n)
(values n 0) (values n 0)
(multiple-value-bind (sec frac)(truncate n) (multiple-value-bind (sec frac) (truncate n)
(values sec(truncate frac 1e-6)))) (values sec (truncate frac 1e-6))))
(unix:unix-select 0 0 0 0 sec usec)) (unix:unix-select 0 0 0 0 sec usec))
nil) nil)
......
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/interface/interface.lisp,v 1.11 2001/02/22 20:28:53 pw Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/interface/interface.lisp,v 1.12 2001/07/08 17:41:41 pw Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -773,13 +773,15 @@ ...@@ -773,13 +773,15 @@
(ext:process-alive-p xt::*local-motif-server*)) (ext:process-alive-p xt::*local-motif-server*))
(ext:process-kill xt::*local-motif-server* :sigint))) (ext:process-kill xt::*local-motif-server* :sigint)))
(in-package "EXT") (pushnew #'cleanup-motif cl::*cleanup-functions*)
(defun quit (&optional recklessly-p) ;;(in-package "EXT")
"Terminates the current Lisp. Things are cleaned up unless Recklessly-P is ;;
non-Nil." ;;(defun quit (&optional recklessly-p)
(if recklessly-p ;; "Terminates the current Lisp. Things are cleaned up unless Recklessly-P is
(unix:unix-exit 0) ;; non-Nil."
(progn ;; (if recklessly-p
(interface::cleanup-motif) ;; (unix:unix-exit 0)
(throw 'cl::%end-of-the-world 0)))) ;; (progn
;; (interface::cleanup-motif)
;; (throw 'cl::%end-of-the-world 0))))
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