Skip to content
Snippets Groups Projects
Commit 4b968a35 authored by dtc's avatar dtc
Browse files

The top-level-catcher symbol used in top-level should have been

internal to the LISP package; fixes failures to throw to the top level.

Add a new example function Startup-Idle-and-Top-Level-Loops to enter
the idle loop and start a new process to run the top level loop.
parent 1571152e
No related branches found
No related tags found
No related merge requests found
...@@ -4,7 +4,7 @@ ...@@ -4,7 +4,7 @@
;;; the Public domain, and is provided 'as is'. ;;; the Public domain, and is provided 'as is'.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/multi-proc.lisp,v 1.29 1998/05/19 02:08:49 dtc Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/multi-proc.lisp,v 1.30 1998/08/14 07:15:09 dtc Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -1085,7 +1085,7 @@ ...@@ -1085,7 +1085,7 @@
;;; Run-Idle-Process-P -- Internal. ;;; Run-Idle-Process-P -- Internal.
;;; ;;;
;;; Decide when the allow the idle process to run. ;;; Decide when to allow the idle process to run.
;;; ;;;
(defun run-idle-process-p () (defun run-idle-process-p ()
;; Check if there are any other runnable processes. ;; Check if there are any other runnable processes.
...@@ -1162,6 +1162,8 @@ ...@@ -1162,6 +1162,8 @@
;; Ensure the *idle-process* is setup. ;; Ensure the *idle-process* is setup.
(unless *idle-process* (unless *idle-process*
(setf *idle-process* *current-process*)) (setf *idle-process* *current-process*))
;; Adjust the process name.
(setf (process-name *current-process*) "Idle Loop")
(do () (do ()
(*quitting-lisp*) (*quitting-lisp*)
;; Calculate the wait period. ;; Calculate the wait period.
...@@ -1553,7 +1555,7 @@ ...@@ -1553,7 +1555,7 @@
(magic-eof-cookie (cons :eof nil))) (magic-eof-cookie (cons :eof nil)))
(loop (loop
(with-simple-restart (abort "Return to Top-Level.") (with-simple-restart (abort "Return to Top-Level.")
(catch 'top-level-catcher (catch 'lisp::top-level-catcher
(unix:unix-sigsetmask 0) (unix:unix-sigsetmask 0)
(let ((lisp::*in-top-level-catcher* t)) (let ((lisp::*in-top-level-catcher* t))
(loop (loop
...@@ -1574,6 +1576,22 @@ ...@@ -1574,6 +1576,22 @@
(t (t
(throw '%end-of-the-process nil))))))))))) (throw '%end-of-the-process nil)))))))))))
;;; Startup-Idle-and-Top-Level-Loops -- Internal
;;;
(defun startup-idle-and-top-level-loops ()
"Enter the idle loop, starting a new process to run the top level loop.
The awaking of sleeping processes is timed better with the idle loop process
running, and starting a new process for the top level loop supports a
simultaneous interactive session. Such an initialisation will likely be the
default when there is better MP debug support etc."
(assert (eq *current-process* *initial-process*) ()
"Only the *initial-process* is intended to run the idle loop")
(init-multi-processing) ; Initialise in case MP had been shutdown.
;; Start a new Top Level loop.
(make-process #'top-level :name "Top Level Loop")
;; Enter the idle loop.
(idle-process-loop))
;;; Start-Lisp-Connection-Listener ;;; Start-Lisp-Connection-Listener
;;; ;;;
;;; Create a process to listen for connections on a TCP port and start ;;; Create a process to listen for connections on a TCP port and start
......
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