diff --git a/code/lispinit.lisp b/code/lispinit.lisp index 3124732c2740644c8e92fc917f4ef3534692732e..18225b492e40bfd6bf963581c5181353eeed5514 100644 --- a/code/lispinit.lisp +++ b/code/lispinit.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (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 @@ ;;;; Miscellaneous external functions: +(defvar *cleanup-functions* nil + "Functions to be invoked during cleanup at Lisp exit.") + ;;; Quit gets us out, one way or another. (defun quit (&optional recklessly-p) @@ -440,7 +443,9 @@ non-Nil." (if recklessly-p (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. @@ -455,8 +460,8 @@ (multiple-value-bind (sec usec) (if (integerp n) (values n 0) - (multiple-value-bind (sec frac)(truncate n) - (values sec(truncate frac 1e-6)))) + (multiple-value-bind (sec frac) (truncate n) + (values sec (truncate frac 1e-6)))) (unix:unix-select 0 0 0 0 sec usec)) nil) diff --git a/interface/interface.lisp b/interface/interface.lisp index 7b08772043aa592eb66578fd3a69cb528563010d..d3b8d65bcbff29a3983ce0e14561eab527e10440 100644 --- a/interface/interface.lisp +++ b/interface/interface.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (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 @@ (ext:process-alive-p xt::*local-motif-server*)) (ext:process-kill xt::*local-motif-server* :sigint))) -(in-package "EXT") - -(defun quit (&optional recklessly-p) - "Terminates the current Lisp. Things are cleaned up unless Recklessly-P is - non-Nil." - (if recklessly-p - (unix:unix-exit 0) - (progn - (interface::cleanup-motif) - (throw 'cl::%end-of-the-world 0)))) +(pushnew #'cleanup-motif cl::*cleanup-functions*) + +;;(in-package "EXT") +;; +;;(defun quit (&optional recklessly-p) +;; "Terminates the current Lisp. Things are cleaned up unless Recklessly-P is +;; non-Nil." +;; (if recklessly-p +;; (unix:unix-exit 0) +;; (progn +;; (interface::cleanup-motif) +;; (throw 'cl::%end-of-the-world 0))))