commit 6746e2dbb97287b2e8f9195ff4e768b35dd3e63b
parent c49fedebfc8422de7bfc0076ee6fbd75f2e9942c
Author: Tomas Hlavaty <tom@logand.com>
Date: Mon, 30 Mar 2015 00:21:43 +0200
partial port to mkcl
Diffstat:
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))
