Skip to content
Snippets Groups Projects
Commit 7f8b471a authored by dtc's avatar dtc
Browse files

Add support for an idle process that isn't run when there are other

runnable processes.

Take care not to schedule inactive processes.
parent 71917f53
No related branches found
No related tags found
No related merge requests found
...@@ -3,7 +3,7 @@ ...@@ -3,7 +3,7 @@
;;; This code was written by Douglas T. Crosher and has been placed in ;;; This code was written by Douglas T. Crosher and has been placed in
;;; the Public domain, and is provided 'as is'. ;;; the Public domain, and is provided 'as is'.
;;; ;;;
;;; $Id: multi-proc.lisp,v 1.6 1997/11/22 14:46:36 dtc Exp $ ;;; $Id: multi-proc.lisp,v 1.7 1997/12/28 04:33:01 dtc Exp $
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -818,6 +818,31 @@ ...@@ -818,6 +818,31 @@
;;; first element of this list. ;;; first element of this list.
(defvar *remaining-processes* nil) (defvar *remaining-processes* nil)
;;; The idle process will only run when there are no other runnable
;;; processes.
(defvar *idle-process* nil)
;;; Decide when the allow the idle process to run.
(defun run-idle-process-p ()
;; Check if there are any other runnable processes.
(dolist (process *all-processes* t)
(when (and (not (eq process *idle-process*))
(process-active-p process)
(not (process-wait-function process)))
(return nil))))
;;; A useful idle process loop, waiting on events using the select
;;; based event server, and yielding periodically.
;;;
;;; Timeout for the idle loop, something acceptable by
;;; sever-all-events.
(defvar *idle-loop-timeout* 1)
;;;
(defun idle-process-loop ()
(loop
(sys:serve-all-events *idle-loop-timeout*)
(process-yield)))
;;; Scheduler. ;;; Scheduler.
(defun process-yield () (defun process-yield ()
"Allow other processes to run." "Allow other processes to run."
...@@ -837,60 +862,65 @@ ...@@ -837,60 +862,65 @@
;; Shouldn't see any :killed porcesses here. ;; Shouldn't see any :killed porcesses here.
(assert (process-alive-p next)) (assert (process-alive-p next))
;; New process at the head of the queue? (cond
(unless (eq next *current-process*) ;; New process at the head of the queue?
(cond ((eq next *current-process*))
;; If the next process has pending interrupts then return ;; Ignore inactive processes.
;; to it to execute these. ((not (process-active-p next)))
((process-interrupts next) ;; If the next process has pending interrupts then return to
(setf *current-process* next) ;; it to execute these.
(stack-group-resume (process-stack-group next))) ((process-interrupts next)
(t (setf *current-process* next)
;; If not waiting then return. (stack-group-resume (process-stack-group next)))
(let ((wait-fn (process-wait-function next))) (t
(cond ;; If not waiting then return.
((null wait-fn) (let ((wait-fn (process-wait-function next)))
(cond
((null wait-fn)
;; Skip the idle process if there are other runnable
;; processes.
(when (or (not (eq next *idle-process*))
(run-idle-process-p))
(setf *current-process* next) (setf *current-process* next)
(stack-group-resume (process-stack-group next))) (stack-group-resume (process-stack-group next))))
(t (t
;; Check the wait function in the current context ;; Check the wait function in the current context
;; saving a stack-group switch; although ;; saving a stack-group switch; although
;; *current-process* is setup. ;; *current-process* is setup.
(let ((current-process *current-process*)) (let ((current-process *current-process*))
(setf *current-process* next) (setf *current-process* next)
;; Predicate true? ;; Predicate true?
(let ((wait-return-value (funcall wait-fn))) (let ((wait-return-value (funcall wait-fn)))
(cond (wait-return-value (cond (wait-return-value
;; Flush the wait. ;; Flush the wait.
(setf (process-wait-return-value next) (setf (process-wait-return-value next)
wait-return-value) wait-return-value)
(setf (process-wait-timeout next) nil) (setf (process-wait-timeout next) nil)
(setf (process-wait-function next) nil) (setf (process-wait-function next) nil)
(setf (process-%whostate next) nil) (setf (process-%whostate next) nil)
(stack-group-resume (process-stack-group next))) (stack-group-resume (process-stack-group next)))
(t (t
;; Timeout? ;; Timeout?
(let ((timeout (process-wait-timeout next))) (let ((timeout (process-wait-timeout next)))
(when (and timeout (when (and timeout
(> (the fixnum (> (the fixnum (get-internal-real-time))
(get-internal-real-time)) timeout))
timeout)) ;; Flush the wait.
;; Flush the wait. (setf (process-wait-return-value next) nil)
(setf (process-wait-return-value next) nil) (setf (process-wait-timeout next) nil)
(setf (process-wait-timeout next) nil) (setf (process-wait-function next) nil)
(setf (process-wait-function next) nil) (setf (process-%whostate next) nil)
(setf (process-%whostate next) nil) (stack-group-resume
(stack-group-resume (process-stack-group next)))))))
(process-stack-group next))))))) ;; Restore the *current-process*.
;; Restore the *current-process*. (setf *current-process* current-process))))))))
(setf *current-process* current-process)))))))))
;; May have just returned, or have cycled the queue. ;; May have just returned, or have cycled the queue.
(let ((next (first *remaining-processes*))) (let ((next (first *remaining-processes*)))
;; Tolerate :killed processes on the *remaining-processes* list ;; Tolerate :killed processes on the *remaining-processes* list
;; saving their deletion from this list when killed; will be ;; saving their deletion from this list when killed; will be
;; corrected when it cycle back to *all-processes*. ;; corrected when it cycles back to *all-processes*.
(when (and (process-alive-p next) (when (and (process-active-p next)
;; Current process at the head of the queue? ;; Current process at the head of the queue?
(eq next *current-process*)) (eq next *current-process*))
;; Run any pending interrupts. ;; Run any pending interrupts.
...@@ -921,7 +951,9 @@ ...@@ -921,7 +951,9 @@
(let ((wait-fn (process-wait-function next))) (let ((wait-fn (process-wait-function next)))
(cond (cond
((null wait-fn) ((null wait-fn)
(return)) (when (or (not (eq next *idle-process*))
(run-idle-process-p))
(return)))
(t (t
;; Predicate true? ;; Predicate true?
(let ((return-value (funcall wait-fn))) (let ((return-value (funcall wait-fn)))
......
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