FIFO
This module gives an implementation of a thread safe First In First Out queue. It is based upon the SICP implementation of a FIFO, but its setup is a littlebit different. Where the SICP implementation is based on a pair of pairs, this implementation uses a vector to get the same behaviour. The vector consists of a list and a pairs, where the pair points to the last element of the list. The rest of the vector elements represent semaphores. The first semaphore is used to implement a critical section. The second semaphore is used to implement a producer/consumer queue. The producer increases the semaphore for each new element in the queue. The consumer decreases the semaphore for each element taken from the queue. If the semaphore becomes 0, a consumer will block.
Supportive macros
These macros are not explained.
(define-struct fifo-type (last-element lst sem depth))
(define-syntax last-fifo-element
(syntax-rules ()
((_ fifo)
(fifo-type-last-element fifo))))
(define-syntax last-fifo-element-set!
(syntax-rules ()
((_ fifo item)
(set-fifo-type-last-element! fifo item))))
(define-syntax fifo-list
(syntax-rules ()
((_ fifo)
(fifo-type-lst fifo))))
(define-syntax fifo-list-set!
(syntax-rules ()
((_ fifo item)
(set-fifo-type-lst! fifo item))))
(define-syntax protect
(syntax-rules ()
((_ fifo body1 ...)
(begin
(semaphore-wait (fifo-type-sem fifo))
(let ((result (begin
body1 ...)))
(semaphore-post (fifo-type-sem fifo))
result)))))
(define-syntax inc-fifo-depth
(syntax-rules ()
((_ fifo)
(semaphore-post (fifo-type-depth fifo)))))
(define-syntax dec-fifo-depth
(syntax-rules ()
((_ fifo)
(semaphore-wait (fifo-type-depth fifo)))))
Interface
(fifo-empty? fifo) : boolean
Returns #t, if fifo is empty, #f, otherwise.
(define (fifo-empty? F) (null? (fifo-list F)))
(fifo+ fifo element) : fifo
Inserts a new element in the fifo. Returns fifo, but also alters the existing fifo.
(define (fifo+ F element)
(let ((item (cons element '())))
(protect F
(inc-fifo-depth F)
(if (fifo-empty? F)
(begin
(fifo-list-set! F item)
(last-fifo-element-set! F item))
(begin
(set-cdr! (last-fifo-element F) item)
(last-fifo-element-set! F (cdr (last-fifo-element F))))))
F))
(fifo- fifo) : scheme-object
Blocks if (fifo-empty?) is #t, until fifo+ is used to insert a new element. Takes an element from the fifo and returns it.
(define (fifo- F)
(dec-fifo-depth F)
(protect F
(let ((element (car (fifo-list F))))
(fifo-list-set! F (cdr (fifo-list F)))
element)))
(fifo . elements) : fifo
Returns a new fifo, filled with all given arguments (elements).
(define (fifo . elements)
(let ((F (make-fifo-type (list) (list) (make-semaphore 1) (make-semaphore 0))))
;;;(let ((F (vector (list) (list) (make-semaphore 1) (make-semaphore 0) 'fifo)))
(for-each
(lambda (element)
(fifo+ F element))
elements)
F))
(empty-fifo! fifo) : fifo
Empties fifo, i.e. removes all elements from fifo. This function actually creates a new fifo, and copies the vector elements to the existing fifo.
(define (empty-fifo! F)
(let ((F1 (fifo)))
(last-fifo-element-set! F (last-fifo-element F1))
(fifo-list-set! F (fifo-list F1))
(set-fifo-type-sem! F (fifo-type-sem F1))
(set-fifo-type-depth! F (fifo-type-depth F1))
F))
(fifo? obj) : boolean
Determines if obj is a fifo. Returns #t if it does so, returns #f, otherwise. Note: All fifos are vectors.
(define (fifo? F) (fifo-type? F))
Info
Author(s): Hans Oesterholt-Dijkema (hansatelementalprogrammingdotorgextension).
Copyright: (c) 2005.
License : Elemental Programming License.
File : fifo.scm $Revision: 1.2 $