Index: /trunk/ccl/level-1/l1-readloop.lisp
===================================================================
--- /trunk/ccl/level-1/l1-readloop.lisp	(revision 462)
+++ /trunk/ccl/level-1/l1-readloop.lisp	(revision 463)
@@ -155,4 +155,8 @@
 	(if res (return-from find-restart-2 restart)(setq res restart))))))
 |#
+
+(defglobal *quit-acknowledge* nil)
+(defglobal *quit-acknowledge-lock* (make-lock))
+
 (defun quit (&optional (exit-status 0))
   (let* ((ip *initial-process*)
@@ -165,4 +169,7 @@
 				       (#_exit exit-status)))))
       (unless (eq cp ip)
+	(when (try-lock *quit-acknowledge-lock*)
+	  (let-globally ((*quit-acknowledge* (make-semaphore)))
+			(timed-wait-on-semaphore *quit-acknowledge* 1)))
 	(process-kill cp)))))
 
@@ -176,6 +183,6 @@
 
 (defun prepare-to-quit (&optional part)
+  (when *quit-acknowledge* (signal-semaphore *quit-acknowledge*))
   (let-globally ((*quitting* t))
-		
     (when (or (null part) (eql 0 part))
       (dolist (f *lisp-cleanup-functions*)