[MLton-commit] r5119

[Vesa Karvonen]

Background processor now keeps just one timer while processing.

----------------------------------------------------------------------

U   mlton/trunk/ide/emacs/bg-job.el
U   mlton/trunk/ide/emacs/def-use-mode.el
U   mlton/trunk/ide/emacs/def-use-util.el

----------------------------------------------------------------------

Modified: mlton/trunk/ide/emacs/bg-job.el
===================================================================
--- mlton/trunk/ide/emacs/bg-job.el	2007-02-03 20:41:51 UTC (rev 5118)
+++ mlton/trunk/ide/emacs/bg-job.el	2007-02-04 08:42:19 UTC (rev 5119)
@@ -33,7 +33,7 @@
 A job may call `bg-job-start' to start new jobs and multiple background
 jobs may be active simultaneously."
   (push (cons args (cons done? (cons step finalize))) bg-job-queue)
-  (bg-job-reschedule))
+  (bg-job-timer-start))
 
 (defun bg-job-done? (job)
   (apply (cadr job) (car job)))
@@ -47,35 +47,38 @@
 (defvar bg-job-queue nil)
 (defvar bg-job-timer nil)
 
-(defconst bg-job-period 0.03)
-(defconst bg-job-cpu-ratio 0.3)
+(defconst bg-job-period 0.10)
+(defconst bg-job-cpu-ratio 0.2)
 
-(defun bg-job-reschedule ()
+(defun bg-job-timer-start ()
   (unless bg-job-timer
     (setq bg-job-timer
           (run-with-timer
-           (/ bg-job-period bg-job-cpu-ratio)
-           nil
-           (function bg-job-quantum)))))
+           bg-job-period bg-job-period (function bg-job-quantum)))))
 
+(defun bg-job-timer-stop ()
+  (when bg-job-timer
+    (def-use-delete-timer bg-job-timer)
+    (setq bg-job-timer nil)))
+
 (defun bg-job-quantum ()
-  (let ((start-time (bg-job-time-to-double (current-time))))
-    (while (and bg-job-queue
-                (< (- (bg-job-time-to-double (current-time)) start-time)
-                   bg-job-period))
+  (let ((end-time (+ (bg-job-time-to-double (current-time))
+                     (* bg-job-period bg-job-cpu-ratio))))
+    (while (and (< (bg-job-time-to-double (current-time))
+                   end-time)
+                bg-job-queue)
       (let ((job (pop bg-job-queue)))
         (if (bg-job-done? job)
             (bg-job-finalize job)
           (bg-job-step job)
           (setq bg-job-queue (nconc bg-job-queue (list job)))))))
-  (setq bg-job-timer nil)
-  (when bg-job-queue
-    (bg-job-reschedule)))
+  (unless bg-job-queue
+    (bg-job-timer-stop)))
 
 (defun bg-job-time-to-double (time)
   (+ (* (car time) 65536.0)
      (cadr time)
-     (/ (caddr time) 1000000.0)))
+     (* (caddr time) 1e-06)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 

Modified: mlton/trunk/ide/emacs/def-use-mode.el
===================================================================
--- mlton/trunk/ide/emacs/def-use-mode.el	2007-02-03 20:41:51 UTC (rev 5118)
+++ mlton/trunk/ide/emacs/def-use-mode.el	2007-02-04 08:42:19 UTC (rev 5119)
@@ -336,7 +336,7 @@
 
 (defun def-use-delete-highlight-timer ()
   (when def-use-highlight-timer
-    (def-use-delete-idle-timer def-use-highlight-timer)
+    (def-use-delete-timer def-use-highlight-timer)
     (setq def-use-highlight-timer nil)))
 
 (defun def-use-create-highlight-timer ()

Modified: mlton/trunk/ide/emacs/def-use-util.el
===================================================================
--- mlton/trunk/ide/emacs/def-use-util.el	2007-02-03 20:41:51 UTC (rev 5118)
+++ mlton/trunk/ide/emacs/def-use-util.el	2007-02-04 08:42:19 UTC (rev 5119)
@@ -39,8 +39,8 @@
     (point)))
 
 (if (string-match "XEmacs" emacs-version)
-    (defalias 'def-use-delete-idle-timer (function delete-itimer))
-  (defalias 'def-use-delete-idle-timer (function cancel-timer)))
+    (defalias 'def-use-delete-timer (function delete-itimer))
+  (defalias 'def-use-delete-timer (function cancel-timer)))
 
 (defun def-use-gethash-or-put (key_ mk-value_ table_)
   (or (gethash key_ table_)