From afe52e866c70c8fdf47011d10f8f2bcd443d941e Mon Sep 17 00:00:00 2001
From: dtc <dtc>
Date: Sun, 11 Jan 1998 20:24:25 +0000
Subject: [PATCH] Add simple-restarts to allow a process to be easily destroyed
 when an error occurs.

---
 code/multi-proc.lisp | 16 ++++++++++------
 1 file changed, 10 insertions(+), 6 deletions(-)

diff --git a/code/multi-proc.lisp b/code/multi-proc.lisp
index fbd1729fd..c91e256f5 100644
--- a/code/multi-proc.lisp
+++ b/code/multi-proc.lisp
@@ -3,7 +3,7 @@
 ;;; This code was written by Douglas T. Crosher and has been placed in
 ;;; the Public domain, and is provided 'as is'.
 ;;;
-;;; $Id: multi-proc.lisp,v 1.18 1998/01/04 22:41:41 dtc Exp $
+;;; $Id: multi-proc.lisp,v 1.19 1998/01/11 20:24:25 dtc Exp $
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -855,8 +855,10 @@
 			     ;; Catch throws to the %end-of-the-world.
 			     (setf *quitting-lisp*
 				   (catch 'lisp::%end-of-the-world
-				     (setf *inhibit-scheduling* nil)
-				     (funcall function)
+				     (with-simple-restart
+					 (destroy "Destroy the process")
+				       (setf *inhibit-scheduling* nil)
+				       (funcall function))
 				     ;; Normal exit.
 				     (throw '%end-of-the-process nil))))
 			(setf *inhibit-scheduling* t)
@@ -925,9 +927,11 @@
 		    ;; Catch throws to the %end-of-the-world.
 		    (setf *quitting-lisp*
 			  (catch 'lisp::%end-of-the-world
-			    (setf *inhibit-scheduling* nil)
-			    (apply (process-initial-function process)
-				   (process-initial-args process))
+			    (with-simple-restart
+				(destroy "Destroy the process")
+			      (setf *inhibit-scheduling* nil)
+			      (apply (process-initial-function process)
+				     (process-initial-args process)))
 			    ;; Normal exit.
 			    (throw '%end-of-the-process nil))))
 	       (setf *inhibit-scheduling* t)
-- 
GitLab