Revert "Support cancellation of timer operations"

Makefile.am

@@ -119,8 +119,7 @@ TESTS = \
 	tests/parameters.scm \
 	tests/preemption.scm \
 	tests/speedup.scm \
-	tests/timer-wheel.scm \
-	tests/cancel-timer.scm
+	tests/timer-wheel.scm
 
 # The following tests require SOCK_NONBLOCK and SOCK_CLOEXEC. For now we just
 # run them on a platform that supports epoll (probably Linux).

fibers/operations.scm

@@ -60,37 +60,21 @@
             choice-operation
             perform-operation
 
-            make-base-operation
-            make-base-operation/internal))
+            make-base-operation))
 
 ;; Three possible values: W (waiting), C (claimed), or S (synched).
 ;; The meanings are as in the Parallel CML paper.
 (define-inlinable (make-op-state) (make-atomic-box 'W))
 
 (define-record-type <base-op>
-  (%make-base-operation wrap-fn try-fn block-fn cancel-fn)
+  (make-base-operation wrap-fn try-fn block-fn)
   base-op?
   ;; ((arg ...) -> (result ...)) | #f
   (wrap-fn base-op-wrap-fn)
   ;; () -> (thunk | #f)
   (try-fn base-op-try-fn)
   ;; (op-state sched resume-k) -> ()
-  (block-fn base-op-block-fn)
-  ;; (sched) -> ()
-  (cancel-fn base-op-cancel-fn))                  ;for internal use so far
-
-(define* (make-base-operation/internal wrap-fn try-fn block-fn
-                                       #:optional (cancel-fn (const #f)))
-  "This internal-use-only variant of @code{make-base-operation} has an extra
-@var{cancel-fn} argument: a procedure to cancel this operation when, as part
-of a \"choice\" operation, it has not been chosen.
-
-This variant is kept internal while the interface and its consequences are
-being discussed.  Do NOT use it in external code."
-  (%make-base-operation wrap-fn try-fn block-fn cancel-fn))
-
-(define (make-base-operation wrap-fn try-fn block-fn)
-  (%make-base-operation wrap-fn try-fn block-fn (const #f)))
+  (block-fn base-op-block-fn))
 
 (define-record-type <choice-op>
   (make-choice-operation base-ops)
@@ -137,18 +121,6 @@ succeeds, will succeed with one and only one of the sub-operations
     ((base-op) base-op)
     (base-ops (make-choice-operation (list->vector base-ops)))))
 
-(define (cancel-other-operations op index)
-  "Assuming @var{op} is a choice operation, cancel every operation but the
-one at @var{index}."
-  (match op
-    (($ <choice-op> base-ops)
-     (let loop ((i 0))
-       (when (< i (vector-length base-ops))
-         (unless (= i index)
-           (match (vector-ref base-ops i)
-             (($ <base-op> wrap-fn try-fn block-fn cancel-fn)
-              (cancel-fn (current-scheduler))))))))))
-
 (define (perform-operation op)
   "Perform the operation @var{op} and return the resulting values.  If
 the operation cannot complete directly, block until it can complete."
@@ -169,10 +141,7 @@ the operation cannot complete directly, block until it can complete."
            (when (< i (vector-length base-ops))
              (match (vector-ref base-ops i)
                (($ <base-op> wrap-fn try-fn block-fn)
-                (let ((resume (lambda (thunk)
-                                (cancel-other-operations op i)
-                                (resume thunk))))
-                  (block-fn flag sched (wrap-resume resume wrap-fn)))))
+                (block-fn flag sched (wrap-resume resume wrap-fn))))
              (lp (1+ i))))))))
 
   (define (suspend)

fibers/scheduler.scm

@@ -35,7 +35,6 @@
             (scheduler-kernel-thread/public . scheduler-kernel-thread)
             scheduler-remote-peers
             scheduler-work-pending?
-            scheduler-timers
             choose-parallel-scheduler
             run-scheduler
             destroy-scheduler

fibers/timer-wheel.scm

@@ -31,7 +31,6 @@
   #:use-module (ice-9 format)
   #:export (make-timer-wheel
             timer-wheel-add!
-            timer-wheel-remove!
             timer-wheel-next-entry-time
             timer-wheel-next-tick-start
             timer-wheel-next-tick-end
@@ -142,18 +141,6 @@
         (else
          (timer-wheel-add! (or outer (add-outer-wheel! wheel)) t obj)))))))
 
-(define (timer-wheel-remove! wheel entry)
-  "Remove @var{entry}, a timer entry as returned by @code{timer-wheel-add!},
-from @var{wheel}."
-  (match entry
-    (($ <timer-entry> prev next)
-     (when prev
-       (set-timer-entry-next! prev next)
-       (set-timer-entry-prev! entry #f))
-     (when next
-       (set-timer-entry-prev! next prev)
-       (set-timer-entry-next! entry #f)))))
-
 (define (timer-wheel-next-entry-time wheel)
   (define (slot-min-time head)
     (let lp ((entry (timer-entry-next head)) (min #f))

fibers/timers.scm

@@ -1,6 +1,6 @@
 ;; Fibers: cooperative, event-driven user-space threads.
 
-;;;; Copyright (C) 2016, 2024 Free Software Foundation, Inc.
+;;;; Copyright (C) 2016 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -19,7 +19,6 @@
 (define-module (fibers timers)
   #:use-module (fibers scheduler)
   #:use-module (fibers operations)
-  #:autoload   (fibers timer-wheel) (timer-wheel-remove!)
   #:use-module (ice-9 atomic)
   #:use-module (ice-9 match)
   #:use-module (ice-9 threads)
@@ -46,37 +45,23 @@
   "Make an operation that will succeed when the current time is
 greater than or equal to @var{expiry}, expressed in internal time
 units.  The operation will succeed with no values."
-  (define wheel-entry
-    ;; If true, this is the currently active timer entry for this operation.
-    #f)
-
-  (make-base-operation/internal
-   #f                                             ;wrap
-   (lambda ()                                     ;try
-     (and (< expiry (get-internal-real-time))
-          values))
-   (lambda (flag sched resume)                    ;block
-     (define (timer)
-       (match (atomic-box-compare-and-swap! flag 'W 'S)
-         ('W (resume values))
-         ('C (timer))
-         ('S #f)))
-     (if sched
-         (set! wheel-entry
-               (schedule-task-at-time sched expiry timer))
-         (schedule-task
-          (timer-sched)
-          (lambda ()
-            (perform-operation (timer-operation expiry))
-            (timer)))))
-   (lambda (sched)                                ;cancel
-     ;; This operation is being canceled.
-     (when (and sched wheel-entry)
-       ;; Remove WHEEL-ENTRY from the timer wheel right away to avoid
-       ;; accumulating entries in the wheel.  See
-       ;; <https://github.com/wingo/fibers/issues/109>.
-       (timer-wheel-remove! (scheduler-timers sched) wheel-entry)
-       (set! wheel-entry #f)))))
+  (make-base-operation #f
+                       (lambda ()
+                         (and (< expiry (get-internal-real-time))
+                              values))
+                       (lambda (flag sched resume)
+                         (define (timer)
+                           (match (atomic-box-compare-and-swap! flag 'W 'S)
+                             ('W (resume values))
+                             ('C (timer))
+                             ('S #f)))
+                         (if sched
+                             (schedule-task-at-time sched expiry timer)
+                             (schedule-task
+                              (timer-sched)
+                              (lambda ()
+                                (perform-operation (timer-operation expiry))
+                                (timer)))))))
 
 (define (sleep-operation seconds)
   "Make an operation that will succeed with no values when