1
#| ring.jl -- ring buffer support
3
$Id: ring.jl,v 1.8 2001/08/08 06:00:19 jsh Exp $
5
Copyright (C) 1993, 1994, 2000 John Harper <john@dcs.warwick.ac.uk>
7
This file is part of librep.
9
librep is free software; you can redistribute it and/or modify it
10
under the terms of the GNU General Public License as published by
11
the Free Software Foundation; either version 2, or (at your option)
14
librep is distributed in the hope that it will be useful, but
15
WITHOUT ANY WARRANTY; without even the implied warranty of
16
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17
GNU General Public License for more details.
19
You should have received a copy of the GNU General Public License
20
along with librep; see the file COPYING. If not, write to
21
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
24
(define-structure rep.data.ring
40
(define-structure-alias ring rep.data.ring)
42
;; default size of a ring buffer
43
(defconst default-size 16)
45
;; key for datum access
48
(define-datum-printer key (lambda (d s)
52
;; A ring buffer of size N is defined by a vector with N+2 slots; the
53
;; first slot is used to store the size of the buffer, the second stores
54
;; the position of the next slot to be filled.
56
(define (ring-capacity ring)
57
"Returns the number of slots in the ring buffer RING."
58
(- (length (datum-ref ring key)) 2))
60
(define (ring-size ring)
61
"Returns the number of filled slots in the ring buffer RING."
62
(aref (datum-ref ring key) 0))
64
(define (set-size ring size)
65
(aset (datum-ref ring key) 0 size))
67
(define (get-pos ring)
68
(aref (datum-ref ring key) 1))
69
(define (set-pos ring pos)
70
(aset (datum-ref ring key) 1 pos))
72
(define (get-item ring pos)
73
(aref (datum-ref ring key) (+ pos 2)))
74
(define (set-item ring pos val)
75
(aset (datum-ref ring key) (+ pos 2) val))
77
;;; higher level public api
79
(define (make-ring #!optional size)
80
"Create a ring buffer that can contain SIZE values. If SIZE is not
81
specified the default capacity `ring-default-size' is used."
82
(unless size (setq size default-size))
83
(let ((ring (make-datum (make-vector (+ size 2)) key)))
88
(define (ring-append ring object)
89
"Append OBJECT to the ring buffer RING. This may overwrite a previously
91
(set-item ring (get-pos ring) object)
92
(let ((new-pos (mod (1+ (get-pos ring)) (ring-capacity ring))))
93
(unless (= (ring-size ring) (ring-capacity ring))
94
(set-size ring (1+ (ring-size ring))))
95
(set-pos ring new-pos)))
97
(define (ring-ref ring #!optional depth)
98
"Read an object from the ring buffer RING. If DEPTH is true it
99
defines the object to access, the most recently added item is at
100
depth zero, the next at depth one, and so on. If there is no item at
101
DEPTH nil is returned."
102
(unless depth (setq depth 0))
103
(if (>= depth (ring-capacity ring))
105
(get-item ring (mod (- (get-pos ring) (1+ depth))
106
(ring-capacity ring)))))
108
(define (ring-replace ring object)
109
"Replaces the most recently added object in ring buffer RING with OBJECT.
110
If RING contains no items, add OBJECT as the first."
111
(if (zerop (ring-size ring))
112
(add-to-ring ring object)
113
(set-item ring (mod (1- (get-pos ring)) (ring-capacity ring)) object)))
115
(define (ring->list ring)
116
"Return the elements in ring buffer RING as a list, newest to oldest."
117
(let ((size (ring-size ring))
120
((= i size) (nreverse contents))
121
(setq contents (cons (ring-ref ring i) contents)))))
123
;;; compatibility api
125
(define (get-from-ring ring #!optional depth)
126
(ring-ref ring (if depth (1- depth) 0)))
127
(define add-to-ring ring-append)
128
(define set-ring-head ring-replace))
added
removed
lisp/rep/data/ring.jl
