+ use search-trees for timeout-queue

+ export session-adjust-timeout! for admin-surflet.scm

scheme/httpd/surflets/packages.scm

@@ -129,6 +129,7 @@
 	   instance-session-id
            set-session-lifetime!
 	   adjust-timeout!
+           session-adjust-timeout!
 	   session-alive?
 	   session-surflet-name
 	   ;; FIXME: This is too much and should be restricted:
@@ -374,6 +375,7 @@
 	locks				;MAKE-LOCK et al.
 	profiling			;PROFILE-SPACE
 	rt-module-language		;get structures dynamically
+        search-trees
 	scheme-with-scsh		;regexp et al.
 	shift-reset			;SHIFT and RESET
 	srfi-6				;string-ports

scheme/httpd/surflets/surflet-handler.scm

@@ -118,57 +118,36 @@
 
 ;;; SESSION-SURVEILLANCE     
 (define (timeout-queue-register-session! session-id timeout)
-  (set! *timeout-queue* (queue-add *timeout-queue* session-id timeout)))
+  (search-tree-set! *timeout-queue* (cons session-id timeout) 'ignore))
 
 (define (timeout-queue-remove-session! session-id)
-   (set! *timeout-queue* (queue-delete *timeout-queue* session-id)))
+  (search-tree-set! *timeout-queue* (cons session-id 0) #f))
 
 (define (timeout-queue-adjust-session-timeout! session-id new-timeout)
-   (set! *timeout-queue* (queue-delete *timeout-queue* session-id))
-   (set! *timeout-queue*
-         (queue-add *timeout-queue* session-id new-timeout)))
+  (search-tree-set! *timeout-queue* (cons session-id new-timeout) 'ignore))
 
 (define *timeout-queue*)
 
 (define (surveillance-thread)
-  (set! *timeout-queue* (empty-queue))
+  (set! *timeout-queue* (make-search-tree (lambda (p q) (eq? (car p) (car q)))
+                                          (lambda (p q)
+                                            (< (cdr p) (cdr q)))))
   (let lp ()
     (with-lock *session-table-lock*
       (lambda ()
         (let ((now (time)))
           (let lp2 ()
-            (if (not (queue-empty? *timeout-queue*))
-                (let ((session-id.time (queue-head *timeout-queue*)))
+            (receive (session-id.time ignore) (search-tree-min *timeout-queue*)
+              (if session-id.time
                   (if (<= (cdr session-id.time) now)
                       (let ((session-id (car session-id.time)))
                         (table-set! *session-table* session-id #f)
-                        (set! *timeout-queue* 
-                              (queue-delete *timeout-queue* session-id))
+                        (pop-search-tree-min! *timeout-queue*)
                         (lp2)))))))))
     (sleep 1000)
     (lp)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; actually an alist with a head operation on the second argument.
-(define (empty-queue)
-  '())
-
-(define queue-empty? null?)
-
-(define (queue-add q key value)
-  (alist-cons key value q))
-
-(define (queue-delete key q)
-  (alist-delete! q key))
-
-(define (queue-head q)
-  (let lp ((maybe-min (car q)) (q q))
-    (if (null? q)
-        maybe-min
-        (if (< (cdar q) (cdr maybe-min))
-            (lp (car q) (cdr q))
-            (lp maybe-min (cdr q))))))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 ;; doesn't belong to here...
 (define (with-lock lock thunk)