flanchan
/
cl-channel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

remove unneeded dependancy

Browse Source
master
Avril 5 years ago
parent 1c7954c451
commit 111f317d20
Signed by: flanchan
GPG Key ID: 284488987C31F630
4 changed files with 25 additions and 23 deletions
Show Stats Download Patch File Download Diff File

7
cl-box.lisp
Unescape View File

@ -2,8 +2,6 @@
(in-package :cl-box) (in-package :cl-box)
(flan-utils:enable-all-readers)
(defstruct %box (defstruct %box
value value
lock) lock)
@ -11,7 +9,8 @@
(defmacro %atomic (box &body re) (defmacro %atomic (box &body re)
`(bt:with-lock-held ((%box-lock ,box)) `(bt:with-lock-held ((%box-lock ,box))
,@re)) ,@re))
[ (mapc 'export (list
(defun make-box (&optional value) (defun make-box (&optional value)
(let ((b (make-%box))) (let ((b (make-%box)))
(setf (%box-value b) value) (setf (%box-value b) value)
@ -62,7 +61,7 @@
,@things) ,@things)
(<-! ,name))))) (<-! ,name)))))
] ))
(defun test () (defun test ()
(let ((box (make))) (let ((box (make)))

3
cl-channel.asd
Unescape View File

@ -6,8 +6,7 @@
:license "None" :license "None"
:version "0.0.1" :version "0.0.1"
:serial t :serial t
:depends-on ( :flan-utils :depends-on ( :bt-semaphore )
:bt-semaphore )
:components ((:file "package") :components ((:file "package")
(:file "cl-channel") (:file "cl-channel")
(:file "cl-box") (:file "cl-box")

28
cl-channel.lisp
Unescape View File

@ -2,13 +2,13 @@
(in-package :cl-channel) (in-package :cl-channel)
(flan-utils:enable-all-readers)
(defstruct %queue (defstruct %queue
internal internal
mutex) mutex)
[
(mapc 'export (list
(defun make-queue (&optional (from nil)) (defun make-queue (&optional (from nil))
(let ((q (make-%queue))) (let ((q (make-%queue)))
(setf (%queue-internal q) from) (setf (%queue-internal q) from)
@ -31,7 +31,7 @@
(defun queue-clear (q) (defun queue-clear (q)
(bt:with-lock-held ((%queue-mutex q)) (bt:with-lock-held ((%queue-mutex q))
(setf (%queue-internal q) nil))) (setf (%queue-internal q) nil)))
] ))
(defstruct %channel (defstruct %channel
internal internal
@ -49,7 +49,8 @@
(defun sigall (sem) (defun sigall (sem)
(bt-sem:signal-semaphore sem (bt-sem:semaphore-waiters sem))) (bt-sem:signal-semaphore sem (bt-sem:semaphore-waiters sem)))
[ (mapc 'export (list
(defun make-channel (&optional (max 0)) (defun make-channel (&optional (max 0))
(let ((c (make-%channel))) (let ((c (make-%channel)))
(setf (%channel-internal c) (make-queue)) (setf (%channel-internal c) (make-queue))
@ -71,7 +72,7 @@
(defun <- (chan) (defun <- (chan)
(let ((out nil) (let ((out nil)
(rout nil)) (rout nil))
(loop while (and (null out) ¬(closed chan)) do (loop while (and (null out) (not (closed chan))) do
(progn (progn
(if (> (poll chan) 0) (if (> (poll chan) 0)
(%atomic chan (%atomic chan
@ -83,15 +84,15 @@
(if (closed chan) (values nil nil) (values rout t)))) (if (closed chan) (values nil nil) (values rout t))))
(defun -> (chan item) (defun -> (chan item)
(loop while (and ¬(closed chan) (> (%channel-max chan) 0) (%atomic chan (>= (queue-poll (%channel-internal chan)) (%channel-max chan)))) (loop while (and (not (closed chan)) (> (%channel-max chan) 0) (%atomic chan (>= (queue-poll (%channel-internal chan)) (%channel-max chan))))
do (bt-sem:wait-on-semaphore (%channel-rel-send))) do (bt-sem:wait-on-semaphore (%channel-rel-send)))
(let ((lv (%atomic chan (let ((lv (%atomic chan
(if ¬(if (or (%channel-closed chan) (and (> (%channel-max chan) 0) (>= (queue-poll (%channel-internal chan)) (%channel-max chan)))) (if (not (if (or (%channel-closed chan) (and (> (%channel-max chan) 0) (>= (queue-poll (%channel-internal chan)) (%channel-max chan))))
nil nil
(progn (progn
(queue-> (%channel-internal chan) item) (queue-> (%channel-internal chan) item)
(bt-sem:signal-semaphore (%channel-rel-recv chan) 1) (bt-sem:signal-semaphore (%channel-rel-recv chan) 1)
t)) t)))
(if (%channel-closed chan) nil 'reset) (if (%channel-closed chan) nil 'reset)
t)))) t))))
(if (eq lv 'reset) (if (eq lv 'reset)
@ -110,9 +111,10 @@
(defmacro make () (defmacro make ()
`(make-channel)) `(make-channel))
]
(defun test () ))
#|(defun test ()
(let ((chan (make-channel))) (let ((chan (make-channel)))
$(progn $(progn
(loop while ¬(closed chan) do (let ((val (<- chan))) (loop while ¬(closed chan) do (let ((val (<- chan)))
@ -122,5 +124,9 @@
(release chan)))) (release chan))))
(print "Thread end") (print "Thread end")
(print ".")) (print "."))
$(loop while ¬(closed chan) do
(progn
(sleep 2)
(-> chan 'teste)))
(loop while ¬(closed chan) do (-> chan (write-to-string (read))))) (loop while ¬(closed chan) do (-> chan (write-to-string (read)))))
(print "End")) (print "End"))|#

10
cl-dispatcher.lisp
Unescape View File

@ -2,8 +2,6 @@
(in-package :cl-dispatcher) (in-package :cl-dispatcher)
(flan-utils:enable-all-readers)
(defstruct %dispatcher (defstruct %dispatcher
hooks hooks
lock) lock)
@ -12,7 +10,8 @@
`(bt:with-lock-held ((%dispatcher-lock disp)) `(bt:with-lock-held ((%dispatcher-lock disp))
,@thing)) ,@thing))
[ (mapc 'export (list
(defun make-dispatcher () (defun make-dispatcher ()
(let ((d (make-%dispatcher))) (let ((d (make-%dispatcher)))
(setf (%dispatcher-hooks d ) nil) (setf (%dispatcher-hooks d ) nil)
@ -33,7 +32,7 @@
(let ((hooks (assoc name (%dispatcher-hooks disp)))) (let ((hooks (assoc name (%dispatcher-hooks disp))))
(if (null hooks) (if (null hooks)
nil nil
(mapc #'(lambda (y) $(funcall y x)) (cdr hooks)))))) (mapcar #'(lambda (y) (bt:make-thread (funcall y x))) (cdr hooks))))))
(defun sig-serial (disp name &optional (x nil)) (defun sig-serial (disp name &optional (x nil))
(%atomic disp (%atomic disp
@ -41,7 +40,7 @@
(if (null hooks) (if (null hooks)
nil nil
(mapc #'(lambda (y) (funcall y x)) (cdr hooks)))))) (mapc #'(lambda (y) (funcall y x)) (cdr hooks))))))
] ))
(defun test () (defun test ()
(let ((d (make))) (let ((d (make)))
@ -51,4 +50,3 @@
(sig-serial d "test" 'uwu) (sig-serial d "test" 'uwu)
(print 'signalled))) (print 'signalled)))

Write Preview
Loading…
Cancel
Save