blob: 8bbd106d872614206d85b33a850cb9636c1a417f (
plain)
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
|
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
(declaim (optimize (speed 0) (safety 3) (debug 3)))
(in-package #:snow)
(defclass fifo ()
((buffer :initarg :buffer
:initform ()
:accessor buffer)
(mutex :initarg :mutex
:initform (sb-thread:make-mutex)
:accessor mutex)
(discard-preceding :initarg :discard-preceding
:initform nil
:accessor discard-preceding)
(wait-interval :initarg :wait-interval
:initform 0
:accessor wait-interval)
(timestamp :initarg :timestamp
:initform (get-universal-time)
:accessor timestamp))
(:documentation ""))
(defmethod dequeue ((fifo fifo))
(sb-thread:with-mutex ((mutex fifo))
(when (or (= (wait-interval fifo) 0)
(> (get-universal-time) (+ (timestamp fifo) (wait-interval fifo))))
(setf (timestamp fifo) (get-universal-time))
(when (buffer fifo)
(pop (buffer fifo))))))
(defmethod enqueue ((fifo fifo) obj)
(sb-thread:with-mutex ((mutex fifo))
(if (discard-preceding fifo)
(setf (buffer fifo) `(,obj))
(push obj (buffer fifo)))))
(defmethod empty-p ((fifo fifo))
(sb-thread:with-mutex ((mutex fifo))
(endp (buffer fifo))))
(defmethod len ((fifo fifo))
(sb-thread:with-mutex ((mutex fifo))
(length (buffer fifo))))
|
