Commit 8e4c34ce authored by Zach Beane's avatar Zach Beane
Browse files

Make a separate Clozure MP backend.

Needed because Clozure process semantics don't do what I expect. I hope
to eliminate Clozure-specific process fiddling when I get my head
wrapped around the Clozure behavior.
parent 8a6b1cb0
;;;; clozure-process.lisp
(in-package #:zacl)
(defclass process (ccl:process)
((run-reasons
:initform nil
:reader mp:process-run-reasons
:accessor run-reasons)
(reasons-lock
:initform (make-lock)
:reader reasons-lock)
(keeps-lisp-alive-p
:initform nil
:accessor mp:process-keeps-lisp-alive-p)
(property-list
:initform nil
:accessor mp:process-property-list)))
(defun make-process (name &key (class 'process) initial-bindings)
(ccl:make-process name
:class class
:initial-bindings initial-bindings))
(defun process-name (process)
(ccl:process-name process))
(defun add-run-reason (process object)
(with-lock-held ((reasons-lock process))
(push object (run-reasons process)))
(ccl:process-enable process))
(defun revoke-run-reason (process object)
(with-lock-held ((reasons-lock process))
(setf (run-reasons process)
(delete object (run-reasons process)))))
(defun process-name (process)
(ccl:process-name process))
(defun yield (process)
(when process
;; XXX private
(ccl::process-yield process)))
(defun kill (process)
(ccl:process-kill process))
(defun preset (process fun &rest args)
(apply #'ccl:process-preset process fun args))
(defun process-run-function (name-or-plist function &rest arguments)
(apply #'ccl:process-run-function
(list* :class 'process name-or-plist)
function arguments ))
(defun current-process ()
ccl:*current-process*)
......@@ -54,7 +54,7 @@
(defgeneric mp:process-allow-schedule ()
(:method ()
(yield *current-process*)))
(yield (current-process))))
(defgeneric mp:process-kill (process)
(:method (process)
......@@ -62,7 +62,7 @@
(defgeneric mp:process-preset (process fun &rest args)
(:method (process fun &rest args)
(apply #'preset process fun args )))
(apply #'preset process fun args)))
(defgeneric mp:process-run-function (name-or-plist function &rest arguments)
(:method ((name string) function &rest arguments)
......
......@@ -26,7 +26,10 @@
(:file "clozure-specific")
#+sbcl
(:file "sbcl-specific")
#-clozure
(:file "portable-process")
#+clozure
(:file "clozure-process")
(:file "defpackage-hack")
(:file "reader")
(:file "fake-slots")
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment