Changeset 39725 in project

Timestamp:

03/16/21 21:33:05 (5 weeks ago)

Author:

Kon Lovett

Message:

add unbuffered-cursor

File:

• release/5/mailbox/trunk/inline-queue.scm (modified) (2 diffs)

release/5/mailbox/trunk/inline-queue.scm

@@ -197 +197 @@
   (error '%queue-limited-push-back-list! "unsupported" q ls) )
 
+;index
 (define-inline (%make-queue-limited-cursor) (void))
 (define-inline (%queue-limited-cursor? c) #f)
@@ -265 +266 @@
   (%queue-unbuffered-add! q (car ls)) )
 
-(define-inline (%make-queue-unbuffered-cursor) (void))
-(define-inline (%queue-unbuffered-cursor? c) #f)
+(define-inline (%make-queue-unbuffered-cursor) (cons -1 (void)))
+(define-inline (%queue-unbuffered-cursor? c) (pair c))
+(define-inline (%queue-unbuffered-index c) (car c))
+(define-inline (%queue-unbuffered-index-set! c v) (set-car! c v))
 
 (define-inline (%queue-unbuffered-cursor-winding? q c)
-  (error '%queue-unbuffered-cursor-winding? "unsupported" q c) )
+  (fx<= 0 (%queue-unbuffered-index c)) )
 
 (define-inline (%queue-unbuffered-cursor-unwound? q c)
-  (error '%queue-unbuffered-cursor-unwound? "unsupported" q c) )
+  (fx= 1 (%queue-unbuffered-index c)) )
 
 (define-inline (%queue-unbuffered-cursor-start! q c)
-  (error '%queue-unbuffered-cursor-start! "unsupported" q c) )
+  (%queue-unbuffered-index-set! c 0) )
 
 ;#!eof | *
 (define-inline (%queue-unbuffered-cursor-next! q c)
-  (error '%queue-unbuffered-cursor-next! "unsupported" q c) )
+  (cond
+    ((%queue-unbuffered-cursor-unwound? q c)  #!eof)
+    ((not (%queue-unbuffered-maybe? q))       #!eof)
+    (else
+      (%queue-unbuffered-index-set! c 1)
+      (%queue-unbuffered-value q) ) ) )
 
 (define-inline (%queue-unbuffered-cursor-continue! q c)
-  (error '%queue-unbuffered-cursor-continue! "unsupported" q c) )
+  (%queue-unbuffered-index-set! c 0) )
 
 (define-inline (%queue-unbuffered-cursor-rewind! q c)
-  (error '%queue-unbuffered-cursor-rewind! "unsupported" q c) )
+  (%queue-unbuffered-index-set! c -1) )
 
 (define-inline (%queue-unbuffered-cursor-extract! q c)
-  (error '%queue-unbuffered-cursor-extract! "unsupported" q c) )
+  ;unless 'mailbox-cursor-next' has been called don't remove
+  (when (%queue-unbuffered-cursor-winding? q c)
+    (%queue-unbuffered-maybe-set! q #f) ) )
 
 ;; Queue Generic