cl-rw

Layered streams for Common Lisp
git clone https://logand.com/git/cl-rw.git/
Log | Files | Refs

commit 6746e2dbb97287b2e8f9195ff4e768b35dd3e63b
parent c49fedebfc8422de7bfc0076ee6fbd75f2e9942c
Author: Tomas Hlavaty <tom@logand.com>
Date:   Mon, 30 Mar 2015 00:21:43 +0200

partial port to mkcl

Diffstat:
Mconcurrency.lisp | 18++++++++++++------
Msocket.lisp | 28++++++++++++++--------------
2 files changed, 26 insertions(+), 20 deletions(-)

diff --git a/concurrency.lisp b/concurrency.lisp @@ -34,33 +34,38 @@ (in-package :rw.concurrency) (defmacro with-lock ((lock) &body body) - #-(or ccl ecl sbcl) (error "RW.CONCURRENCY:WITH-LOCK not ported") + #-(or ccl ecl mkcl sbcl) (error "RW.CONCURRENCY:WITH-LOCK not ported") #+ccl `(ccl:with-lock-grabbed (,lock) ,@body) #+ecl `(mp:with-lock (,lock) ,@body) + #+mkcl `(mt:with-lock (,lock) ,@body) #+sbcl `(sb-concurrency::with-mutex (,lock) ,@body)) (defun make-lock (name) - #-(or ccl ecl sbcl) (error "RW.CONCURRENCY:MAKE-LOCK not ported") + #-(or ccl ecl mkcl sbcl) (error "RW.CONCURRENCY:MAKE-LOCK not ported") #+ccl (ccl:make-lock name) #+ecl (mp:make-lock :name name) + #+mkcl (mt:make-lock :name name) #+sbcl (sb-concurrency::make-mutex :name (string name))) (defun make-semaphore () - #-(or ccl ecl sbcl) (error "RW.CONCURRENCY:MAKE-SEMAPHORE not ported") + #-(or ccl ecl mkcl sbcl) (error "RW.CONCURRENCY:MAKE-SEMAPHORE not ported") #+ccl (ccl:make-semaphore) #+ecl (mp:make-semaphore) + #+mkcl (mt:make-semaphore) #+sbcl (sb-concurrency::make-semaphore)) (defun signal-semaphore (x) - #-(or ccl ecl sbcl) (error "RW.CONCURRENCY:SIGNAL-SEMAPHORE not ported") + #-(or ccl ecl mkcl sbcl) (error "RW.CONCURRENCY:SIGNAL-SEMAPHORE not ported") #+ccl (ccl:signal-semaphore x) #+ecl (mp:signal-semaphore x) + #+mkcl (mt:semaphore-signal x) #+sbcl (sb-concurrency::signal-semaphore x)) (defun wait-on-semaphore (x) - #-(or ccl ecl sbcl) (error "RW.CONCURRENCY:WAIT-ON-SEMAPHORE not ported") + #-(or ccl ecl mkcl sbcl) (error "RW.CONCURRENCY:WAIT-ON-SEMAPHORE not ported") #+ccl (ccl:wait-on-semaphore x) #+ecl (mp:wait-on-semaphore x) + #+mkcl (mt:semaphore-wait x) #+sbcl (sb-concurrency::wait-on-semaphore x)) (defun make-concurrent-queue () @@ -93,9 +98,10 @@ ;; (funcall q) (defun make-thread (name fn) - #-(or ccl ecl sbcl) (error "RW.CONCURRENCY:MAKE-THREAD not ported") + #-(or ccl ecl mkcl sbcl) (error "RW.CONCURRENCY:MAKE-THREAD not ported") #+ccl (ccl:process-run-function name fn) #+ecl (mp:process-run-function name fn) + #+mkcl (mt:thread-run-function name fn) #+sbcl (sb-concurrency::make-thread fn :name (string name))) (defun make-program-server (command args writer reader) diff --git a/socket.lisp b/socket.lisp @@ -258,12 +258,12 @@ (ipv6-address (ipv6-address-native x))))) (defun close-socket (socket) - #-(or ccl ecl sbcl) + #-(or ccl ecl mkcl sbcl) (error "TODO port RW.SOCKET::CLOSE-SOCKET") ;; clisp socket:socket-server-close? #+ccl (close socket) - #+(or ecl sbcl) + #+(or ecl sbcl mkcl) (sb-bsd-sockets:socket-close socket)) (defun call-with-socket (socket fn) @@ -274,11 +274,11 @@ `(call-with-socket ,socket (lambda (,var) ,@body))) (defun make-tcp-server-socket (local-host local-port &key backlog) - #-(or clisp sbcl ecl ccl) + #-(or clisp sbcl ecl mkcl ccl) (error "TODO port RW.SOCKET:MAKE-TCP-SERVER-SOCKET") #+clisp (socket:socket-server local-port :interface local-host :backlog backlog) - #+(or sbcl ecl) + #+(or sbcl ecl mkcl) (let ((x (make-instance 'sb-bsd-sockets:inet-socket :type :stream :protocol :tcp))) @@ -300,11 +300,11 @@ :reuse-address t)) (defun make-tcp-client-socket (remote-host remote-port) - #-(or clisp sbcl ecl ccl) + #-(or clisp sbcl ecl mkcl ccl) (error "TODO port RW.SOCKET:MAKE-TCP-CLIENT-SOCKET") #+clisp (socket:socket-connect remote-port remote-host) - #+(or sbcl ecl) + #+(or sbcl ecl mkcl) (let ((x (make-instance 'sb-bsd-sockets:inet-socket :type :stream :protocol :tcp))) @@ -324,7 +324,7 @@ :remote-port remote-port)) (defun make-udp-socket (&key local-host local-port remote-host remote-port) - #-(or ccl ecl sbcl) + #-(or ccl ecl mkcl sbcl) (error "TODO port RW.SOCKET:MAKE-PASSIVE-UDP-SOCKET") ;; #+clisp ;; rawsock not present by default ;; (rawsock:socket :inet :dgram 0) @@ -335,7 +335,7 @@ :local-port local-port :remote-host (native-ip-address remote-host) :remote-port remote-port) - #+(or ecl sbcl) + #+(or ecl mkcl sbcl) (let ((x (make-instance 'sb-bsd-sockets:inet-socket :type :datagram :protocol :udp))) @@ -359,11 +359,11 @@ ;; fd (defun accept (socket) - #-(or clisp sbcl ecl ccl) + #-(or clisp sbcl ecl mkcl ccl) (error "TODO port RW.SOCKET:ACCEPT") #+clisp (socket:socket-accept socket) - #+(or sbcl ecl) + #+(or sbcl ecl mkcl) (sb-bsd-sockets:socket-make-stream (sb-bsd-sockets:socket-accept socket) :input t :output t @@ -372,21 +372,21 @@ (ccl:accept-connection socket)) (defun udp-send (socket buf len &key remote-host remote-port) - #-(or ccl ecl sbcl) + #-(or ccl ecl mkcl sbcl) (error "TODO port RW.SOCKET:UDP-SEND") #+ccl (ccl:send-to socket buf len :remote-host (native-ip-address remote-host) :remote-port remote-port) - #+(or ecl sbcl) + #+(or ecl mkcl sbcl) (sb-bsd-sockets:socket-send socket buf len :address (list (native-ip-address remote-host) remote-port))) (defun udp-receive (socket buf len) - #-(or ccl ecl sbcl) + #-(or ccl ecl mkcl sbcl) (error "TODO port RW.SOCKET:UDP-RECEIVE") #+ccl (ccl:receive-from socket len :buffer buf) - #+(or ecl sbcl) + #+(or ecl mkcl sbcl) (sb-bsd-sockets:socket-receive socket buf len))