Artifact 2504c42f5703635ece5b622bf372e0ec346759a3b450c568f523ff3b1afba0b5:

• File psl-1983/3-1/util/ring-buffer.sl — part of check-in [eb17ceb7f6] at 2020-04-21 19:40:01 on branch master — Add Reduce 3.0 to the historical section of the archive, and some more
  files relating to version sof PSL from the early 1980s. Thanks are due to
  Paul McJones and Nelson Beebe for these, as well as to all the original
  authors.

  git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 2489) [annotate] [blame] [check-ins using] [more...]

• File psl-1983/util/ring-buffer.sl — part of check-in [eb17ceb7f6] at 2020-04-21 19:40:01 on branch master — Add Reduce 3.0 to the historical section of the archive, and some more
  files relating to version sof PSL from the early 1980s. Thanks are due to
  Paul McJones and Nelson Beebe for these, as well as to all the original
  authors.

  git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 2489) [annotate] [blame] [check-ins using]

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% RING-BUFFER.SL - General Ring Buffers
% 
% Author:      Alan Snyder
%              Hewlett-Packard/CRC
% Date:        6 July 1982
% Revised:     16 November 1982
%
% 16-Nov-82 Alan Snyder
%   Recoded using OBJECTS package.  Added FETCH and ROTATE operations.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(BothTimes (load objects))
(CompileTime (load fast-int fast-vectors))

(de ring-buffer-create (maximum-size)
  (make-instance 'ring-buffer 'maximum-size maximum-size))

(defflavor ring-buffer ((maximum-size 16)	% Maximum number of elements.
			vec			% Stores the elements.
			(size 0)		% Elements 0..size-1 are valid.
			(ptr -1)		% Element vec[ptr] is current.
			)
  ()
  (gettable-instance-variables maximum-size size)
  (initable-instance-variables maximum-size)
  )

(defmethod (ring-buffer init) (init-plist)
  (setf vec (mkvect (- maximum-size 1))))

(defmethod (ring-buffer push) (new-element)
  (let ((new-ptr (+ ptr 1)))
    (when (> new-ptr (vector-upper-bound vec))
      (setf new-ptr 0))
    (when (>= new-ptr size)
      (setf size (+ new-ptr 1)))
    (setf ptr new-ptr)
    (vector-store vec new-ptr new-element)
    new-element
    ))

(defmethod (ring-buffer top) ()
  % Returns NIL if the buffer is empty.
  (=> self fetch 0))

(defmethod (ring-buffer pop) ()
  % Returns NIL if the buffer is empty.
  (when (> size 0)
    (let ((old-element (vector-fetch vec ptr)))
      (setf ptr (- ptr 1))
      (when (< ptr 0) (setf ptr (- size 1)))
      old-element
      )))

(defmethod (ring-buffer fetch) (index)
  % Index 0 is the top element.
  % Index -1 is the next previous element, etc.
  % Index 1 is the most previous element, etc.
  % Returns NIL if the buffer is empty.

  (when (> size 0)
    (vector-fetch vec (ring-buffer-mod (+ ptr index) size))
    ))

(defmethod (ring-buffer rotate) (count)
  % Rotate -1 makes the next "older" element current (like POP), etc.
  % Rotate 1 makes the next "newer" element current, etc.

  (when (> size 0)
    (setf ptr (ring-buffer-mod (+ ptr count) size))
    ))

(de ring-buffer-mod (a b)
  (let ((remainder (// a b)))
    (if (>= remainder 0) remainder (+ b remainder))
    ))

% The following functions are defined for backwards compatibility:

(de ring-buffer-push (rb new-element)
  (=> rb push new-element))

(de ring-buffer-top (rb)
  (=> rb top))

(de ring-buffer-pop (rb)
  (=> rb pop))