Factored locking primitives out to their own implementation-dependend
files. Part of the porting effort to LispWorks.
This commit is contained in:
28
src/cmu-locking.cl
Normal file
28
src/cmu-locking.cl
Normal file
@ -0,0 +1,28 @@
|
|||||||
|
;;;; CLASH --- The Common Lisp Adaptable Simple HTTP server
|
||||||
|
;;;; This is copyrighted software. See documentation for terms.
|
||||||
|
;;;;
|
||||||
|
;;;; cmu-locking.cl --- Platform independent locking primitives
|
||||||
|
;;;;
|
||||||
|
;;;; Checkout Tag: $Name$
|
||||||
|
;;;; $Id$
|
||||||
|
|
||||||
|
(in-package :CLASH)
|
||||||
|
|
||||||
|
;;;; %File Description:
|
||||||
|
;;;;
|
||||||
|
;;;;
|
||||||
|
;;;;
|
||||||
|
|
||||||
|
;;; Locking primitives for CMUCL
|
||||||
|
|
||||||
|
(defmacro pop-atomically (place)
|
||||||
|
#+MP
|
||||||
|
`(mp:atomic-pop ,place)
|
||||||
|
#-MP
|
||||||
|
`(pop ,place))
|
||||||
|
|
||||||
|
(defmacro push-atomically (value place)
|
||||||
|
#+MP
|
||||||
|
`(mp:atomic-push ,value ,place)
|
||||||
|
#-MP
|
||||||
|
`(push ,value ,place))
|
||||||
24
src/lwl-locking.cl
Normal file
24
src/lwl-locking.cl
Normal file
@ -0,0 +1,24 @@
|
|||||||
|
;;;; CLASH --- The Common Lisp Adaptable Simple HTTP server
|
||||||
|
;;;; This is copyrighted software. See documentation for terms.
|
||||||
|
;;;;
|
||||||
|
;;;; lwl-locking.cl --- Platform independent locking primitives
|
||||||
|
;;;;
|
||||||
|
;;;; Checkout Tag: $Name$
|
||||||
|
;;;; $Id$
|
||||||
|
|
||||||
|
(in-package :CLASH)
|
||||||
|
|
||||||
|
;;;; %File Description:
|
||||||
|
;;;;
|
||||||
|
;;;;
|
||||||
|
;;;;
|
||||||
|
|
||||||
|
;;; Locking primitives for LWL
|
||||||
|
|
||||||
|
(defmacro pop-atomically (place)
|
||||||
|
`(mp:without-preemption
|
||||||
|
(pop ,place)))
|
||||||
|
|
||||||
|
(defmacro push-atomically (value place)
|
||||||
|
`(mp:without-preemption
|
||||||
|
(push ,value ,place)))
|
||||||
@ -29,21 +29,14 @@ server needs.")
|
|||||||
with `release-io-buffer', to enable it to be recycled. Otherwise it
|
with `release-io-buffer', to enable it to be recycled. Otherwise it
|
||||||
will just be GC'ed as usual."
|
will just be GC'ed as usual."
|
||||||
(or
|
(or
|
||||||
#+(and :CMU :MP)
|
(pop-atomically *io-buffers*)
|
||||||
(mp:atomic-pop *io-buffers*)
|
|
||||||
#-(and :CMU :MP)
|
|
||||||
(pop *io-buffers*)
|
|
||||||
|
|
||||||
;; No ready-made buffer, so we create a new one
|
;; No ready-made buffer, so we create a new one
|
||||||
(make-new-buffer)))
|
(make-new-buffer)))
|
||||||
|
|
||||||
(defun release-io-buffer (buffer)
|
(defun release-io-buffer (buffer)
|
||||||
"Return a buffer allocated by `get-io-buffer' to the buffer pool for
|
"Return a buffer allocated by `get-io-buffer' to the buffer pool for
|
||||||
re-use."
|
re-use."
|
||||||
#+(and :CMU :MP)
|
(push-atomically buffer *io-buffers*)
|
||||||
(mp:atomic-push buffer *io-buffers*)
|
|
||||||
#-(and :CMU :MP)
|
|
||||||
(push buffer *io-buffers*)
|
|
||||||
t)
|
t)
|
||||||
|
|
||||||
(defmacro with-io-buffer ((var) &body body)
|
(defmacro with-io-buffer ((var) &body body)
|
||||||
|
|||||||
Reference in New Issue
Block a user