1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
|
;;; This file implements the process functions for AllegroServe in Corman Lisp.
(require 'mp)
(defpackage :acl-compat-mp
(:use :common-lisp :mp :sys)
(:export
#:process-interrrupt
#:make-process
#:make-process-lock
#:process-add-run-reason
#:process-kill
#:process-property-list
#:process-revoke-run-reason
#:process-run-function
#:with-process-lock
#:with-timeout
#:without-scheduling
#:*current-process*
#:lock
#:process-allow-schedule
#:process-name
#:process-preset
#:process-run-reasons
#:process-wait
#:without-interrupts
))
(in-package :acl-compat-mp)
; existing stuff from ccl we can reuse directly
;; The following process-property-list implementation was taken from
;; the acl-mp-scl.lisp implementation.
(defvar *process-plists* (make-hash-table :test #'eq)
"maps processes to their plists.
See the functions process-plist, (setf process-plist).")
(defun process-property-list (process)
(gethash process *process-plists*))
(defun (setf process-property-list) (new-value process)
(setf (gethash process *process-plists*) new-value))
;; Dummy implementation of process-wait
(defun process-wait (whostate function &rest args)
"This function suspends the current process (the value of sys:*current-process*)
until applying function to arguments yields true. The whostate argument must be a
string which temporarily replaces the process' whostate for the duration of the wait.
This function returns nil."
(loop until (apply function args) do (sleep 0))
nil)
|
