initial commit

1 files changed, 44 insertions, 0 deletions

diff --git a/lisp/queue/fifo.lisp b/lisp/queue/fifo.lisp
new file mode 100644
index 0000000..8bbd106
--- /dev/null
+++ b/lisp/queue/fifo.lisp
@@ -0,0 +1,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))))