[PATCH 7/7] Lisp-level support for ns-resolution time stamps

[Paul Eggert]

[lisp/ChangeLog]
Switch to ns-resolution time stamps.

* calendar/time-date.el (make-fixnum-or-float): New function.
(seconds-to-time): Use it.  Don't assume 1st and 3rd components
are in fixnum range.
(seconds-to-time, time-subtract, time-add):
Switch to ns-resolution time stamps.

* emacs-lisp/timer.el (timer): Use nsecs, not usecs.
All uses changed.
(timer-next-integral-multiple-of-time): Time stamps now have
nanosecond resolution, not microsecond.
* emacs-lisp/timer.el (timer--activate):
* type-break.el (timep): The 1st and 3rd parts might be floats now.

* net/sasl.el (sasl-unique-id-function): Fix comment.
[lisp/gnus/ChangeLog]
* message.el (message-unique-id): Fix comment.
[lisp/org/ChangeLog]
* org-id.el (org-id-time-to-b36): Time stamps have ns-resolution now.
=== modified file 'lisp/calendar/time-date.el'
--- lisp/calendar/time-date.el  2011-04-19 04:11:01 +0000
+++ lisp/calendar/time-date.el  2011-07-01 07:43:11 +0000
@@ -26,9 +26,9 @@
 ;; Time values come in three formats.  The oldest format is a cons
 ;; cell of the form (HIGH . LOW).  This format is obsolete, but still
 ;; supported.  The two other formats are the lists (HIGH LOW) and
-;; (HIGH LOW MICRO).  The first two formats specify HIGH * 2^16 + LOW
-;; seconds; the third format specifies HIGH * 2^16 + LOW + MICRO /
-;; 1000000 seconds.  We should have 0 <= MICRO < 1000000 and 0 <= LOW
+;; (HIGH LOW NANO).  The first two formats specify HIGH * 2^16 + LOW
+;; seconds; the third format specifies HIGH * 2^16 + LOW + NANO /
+;; 1000000000 seconds.  We should have 0 <= NANO < 1000000000 and 0 <= LOW
 ;; < 2^16.  If the time value represents a point in time, then HIGH is
 ;; nonnegative.  If the time value is a time difference, then HIGH can
 ;; be negative as well.  The macro `with-decoded-time-value' and the
@@ -44,13 +44,13 @@
 The value of the last form in BODY is returned.

 Each element of the list VARLIST is a list of the form
-\(HIGH-SYMBOL LOW-SYMBOL MICRO-SYMBOL [TYPE-SYMBOL] TIME-VALUE).
+\(HIGH-SYMBOL LOW-SYMBOL NANO-SYMBOL [TYPE-SYMBOL] TIME-VALUE).
 The time value TIME-VALUE is decoded and the result it bound to
-the symbols HIGH-SYMBOL, LOW-SYMBOL and MICRO-SYMBOL.
+the symbols HIGH-SYMBOL, LOW-SYMBOL and NANO-SYMBOL.

 The optional TYPE-SYMBOL is bound to the type of the time value.
 Type 0 is the cons cell (HIGH . LOW), type 1 is the list (HIGH
-LOW), and type 2 is the list (HIGH LOW MICRO)."
+LOW), and type 2 is the list (HIGH LOW NANO)."
   (declare (indent 1)
           (debug ((&rest (symbolp symbolp symbolp &or [symbolp form] form))
                   body)))
@@ -58,36 +58,36 @@
       (let* ((elt (pop varlist))
             (high (pop elt))
             (low (pop elt))
-            (micro (pop elt))
+            (nano (pop elt))
             (type (unless (eq (length elt) 1)
                     (pop elt)))
             (time-value (car elt))
             (gensym (make-symbol "time")))
        `(let* ,(append `((,gensym ,time-value)
                          (,high (pop ,gensym))
-                         ,low ,micro)
+                         ,low ,nano)
                        (when type `(,type)))
           (if (consp ,gensym)
               (progn
                 (setq ,low (pop ,gensym))
                 (if ,gensym
-                    ,(append `(setq ,micro (car ,gensym))
+                    ,(append `(setq ,nano (car ,gensym))
                              (when type `(,type 2)))
-                  ,(append `(setq ,micro 0)
+                  ,(append `(setq ,nano 0)
                            (when type `(,type 1)))))
-            ,(append `(setq ,low ,gensym ,micro 0)
+            ,(append `(setq ,low ,gensym ,nano 0)
                      (when type `(,type 0))))
           (with-decoded-time-value ,varlist ,@body)))
     `(progn ,@body)))

-(defun encode-time-value (high low micro type)
-  "Encode HIGH, LOW, and MICRO into a time value of type TYPE.
+(defun encode-time-value (high low nano type)
+  "Encode HIGH, LOW, and NANO into a time value of type TYPE.
 Type 0 is the cons cell (HIGH . LOW), type 1 is the list (HIGH LOW),
-and type 2 is the list (HIGH LOW MICRO)."
+and type 2 is the list (HIGH LOW NANO)."
   (cond
    ((eq type 0) (cons high low))
    ((eq type 1) (list high low))
-   ((eq type 2) (list high low micro))))
+   ((eq type 2) (list high low nano))))

 (autoload 'parse-time-string "parse-time")
 (autoload 'timezone-make-date-arpa-standard "timezone")
@@ -128,25 +128,33 @@
         (with-decoded-time-value ((high low micro time))
           (+ (* 1.0 high 65536)
              low
+            ;; Divide by 1 million not 1 billion, since this is executed
+            ;; only on older Emacs, for which 1 million is correct.
              (/ micro 1000000.0))))))

+(defun make-fixnum-or-float (val)
+  (if (and (<= most-negative-fixnum val) (<= val most-positive-fixnum))
+      (floor val)
+    val))
+
 ;;;###autoload
 (defun seconds-to-time (seconds)
   "Convert SECONDS (a floating point number) to a time value."
-  (list (floor seconds 65536)
+  (list (make-fixnum-or-float (ffloor (/ seconds 65536)))
        (floor (mod seconds 65536))
-       (floor (* (- seconds (ffloor seconds)) 1000000))))
+       (make-fixnum-or-float (ffloor (* (- seconds (ffloor seconds))
+                                        1000000000)))))

 ;;;###autoload
 (defun time-less-p (t1 t2)
   "Return non-nil if time value T1 is earlier than time value T2."
-  (with-decoded-time-value ((high1 low1 micro1 t1)
-                           (high2 low2 micro2 t2))
+  (with-decoded-time-value ((high1 low1 nano1 t1)
+                           (high2 low2 nano2 t2))
     (or (< high1 high2)
        (and (= high1 high2)
             (or (< low1 low2)
                 (and (= low1 low2)
-                     (< micro1 micro2)))))))
+                     (< nano1 nano2)))))))

 ;;;###autoload
 (defun days-to-time (days)
@@ -173,36 +181,36 @@
 (defun time-subtract (t1 t2)
   "Subtract two time values, T1 minus T2.
 Return the difference in the format of a time value."
-  (with-decoded-time-value ((high low micro type t1)
-                           (high2 low2 micro2 type2 t2))
+  (with-decoded-time-value ((high low nano type t1)
+                           (high2 low2 nano2 type2 t2))
     (setq high (- high high2)
          low (- low low2)
-         micro (- micro micro2)
+         nano (- nano nano2)
          type (max type type2))
-    (when (< micro 0)
+    (when (< nano 0)
       (setq low (1- low)
-           micro (+ micro 1000000)))
+           nano (+ nano 1000000000)))
     (when (< low 0)
       (setq high (1- high)
            low (+ low 65536)))
-    (encode-time-value high low micro type)))
+    (encode-time-value high low nano type)))

 ;;;###autoload
 (defun time-add (t1 t2)
   "Add two time values T1 and T2.  One should represent a time difference."
-  (with-decoded-time-value ((high low micro type t1)
-                           (high2 low2 micro2 type2 t2))
+  (with-decoded-time-value ((high low nano type t1)
+                           (high2 low2 nano2 type2 t2))
     (setq high (+ high high2)
          low (+ low low2)
-         micro (+ micro micro2)
+         nano (+ nano nano2)
          type (max type type2))
-    (when (>= micro 1000000)
+    (when (>= nano 1000000000)
       (setq low (1+ low)
-           micro (- micro 1000000)))
+           nano (- nano 1000000000)))
     (when (>= low 65536)
       (setq high (1+ high)
            low (- low 65536)))
-    (encode-time-value high low micro type)))
+    (encode-time-value high low nano type)))

 ;;;###autoload
 (defun date-to-day (date)

=== modified file 'lisp/emacs-lisp/timer.el'
--- lisp/emacs-lisp/timer.el    2011-07-01 01:27:40 +0000
+++ lisp/emacs-lisp/timer.el    2011-07-01 05:33:16 +0000
@@ -28,7 +28,7 @@
 ;;; Code:

 ;; Layout of a timer vector:
-;; [triggered-p high-seconds low-seconds usecs repeat-delay
+;; [triggered-p high-seconds low-seconds nsecs repeat-delay
 ;;  function args idle-delay]
 ;; triggered-p is nil if the timer is active (waiting to be triggered),
 ;;  t if it is inactive ("already triggered", in theory)
@@ -42,7 +42,7 @@
             (:type vector)
             (:conc-name timer--))
   (triggered t)
-  high-seconds low-seconds usecs repeat-delay function args idle-delay)
+  high-seconds low-seconds nsecs repeat-delay function args idle-delay)

 (defun timerp (object)
   "Return t if OBJECT is a timer."
@@ -52,7 +52,7 @@
 (defun timer--time (timer)
   (list (timer--high-seconds timer)
         (timer--low-seconds timer)
-        (timer--usecs timer)))
+        (timer--nsecs timer)))

 (defsetf timer--time
   (lambda (timer time)
@@ -60,7 +60,7 @@
     (setf (timer--high-seconds timer) (pop time))
     (setf (timer--low-seconds timer)
          (if (consp time) (car time) time))
-    (setf (timer--usecs timer) (or (and (consp time) (consp (cdr time))
+    (setf (timer--nsecs timer) (or (and (consp time) (consp (cdr time))
                                        (cadr time))
                                   0))))

@@ -77,7 +77,7 @@
 (defun timer-set-idle-time (timer secs &optional repeat)
   "Set the trigger idle time of TIMER to SECS.
 SECS may be an integer, floating point number, or the internal
-time format (HIGH LOW USECS) returned by, e.g., `current-idle-time'.
+time format (HIGH LOW NSECS) returned by, e.g., `current-idle-time'.
 If optional third argument REPEAT is non-nil, make the timer
 fire each time Emacs is idle for that many seconds."
   (if (consp secs)
@@ -94,27 +94,27 @@
   (let ((time-base (ash 1 16)))
     ;; Use floating point, taking care to not lose precision.
     (let* ((float-time-base (float time-base))
-          (million 1000000.0)
-          (time-usec (+ (* million
+          (billion 1e9)
+          (time-nsec (+ (* billion
                            (+ (* float-time-base (nth 0 time))
                               (nth 1 time)))
                         (nth 2 time)))
-          (secs-usec (* million secs))
-          (mod-usec (mod time-usec secs-usec))
-          (next-usec (+ (- time-usec mod-usec) secs-usec))
-          (time-base-million (* float-time-base million)))
-      (list (floor next-usec time-base-million)
-           (floor (mod next-usec time-base-million) million)
-           (floor (mod next-usec million))))))
+          (secs-nsec (* billion secs))
+          (mod-nsec (mod time-nsec secs-nsec))
+          (next-nsec (+ (- time-nsec mod-nsec) secs-nsec))
+          (time-base-billion (* float-time-base billion)))
+      (list (floor next-nsec time-base-billion)
+           (floor (mod next-nsec time-base-billion) billion)
+           (floor (mod next-nsec billion))))))

-(defun timer-relative-time (time secs &optional usecs)
-  "Advance TIME by SECS seconds and optionally USECS microseconds.
+(defun timer-relative-time (time secs &optional nsecs)
+  "Advance TIME by SECS seconds and optionally NSECS nanoseconds.
 SECS may be either an integer or a floating point number."
   (let ((delta (if (floatp secs)
                   (seconds-to-time secs)
                 (list (floor secs 65536) (mod secs 65536)))))
-    (if usecs
-       (setq delta (time-add delta (list 0 0 usecs))))
+    (if nsecs
+       (setq delta (time-add delta (list 0 0 nsecs))))
     (time-add time delta)))

 (defun timer--time-less-p (t1 t2)
@@ -128,20 +128,20 @@
                    (and (= low1 low2)
                         (< micro1 micro2))))))))

-(defun timer-inc-time (timer secs &optional usecs)
-  "Increment the time set in TIMER by SECS seconds and USECS microseconds.
-SECS may be a fraction.  If USECS is omitted, that means it is zero."
+(defun timer-inc-time (timer secs &optional nsecs)
+  "Increment the time set in TIMER by SECS seconds and NSECS nanoseconds.
+SECS may be a fraction.  If NSECS is omitted, that means it is zero."
   (setf (timer--time timer)
-        (timer-relative-time (timer--time timer) secs usecs)))
+        (timer-relative-time (timer--time timer) secs nsecs)))

 (defun timer-set-time-with-usecs (timer time usecs &optional delta)
   "Set the trigger time of TIMER to TIME plus USECS.
 TIME must be in the internal format returned by, e.g., `current-time'.
-The microsecond count from TIME is ignored, and USECS is used instead.
+The nanosecond count from TIME is ignored, and USECS is used instead.
 If optional fourth argument DELTA is a positive number, make the timer
 fire repeatedly that many seconds apart."
   (setf (timer--time timer) time)
-  (setf (timer--usecs timer) usecs)
+  (setf (timer--nsecs timer) (* usecs 1e3))
   (setf (timer--repeat-delay timer) (and (numberp delta) (> delta 0) delta))
   timer)
 (make-obsolete 'timer-set-time-with-usecs
@@ -158,9 +158,9 @@
 
 (defun timer--activate (timer &optional triggered-p reuse-cell idle)
   (if (and (timerp timer)
-          (integerp (timer--high-seconds timer))
+          (numberp (timer--high-seconds timer))
           (integerp (timer--low-seconds timer))
-          (integerp (timer--usecs timer))
+          (numberp (timer--nsecs timer))
           (timer--function timer))
       (let ((timers (if idle timer-idle-list timer-list))
            last)
@@ -394,7 +394,7 @@
   "Perform an action the next time Emacs is idle for SECS seconds.
 The action is to call FUNCTION with arguments ARGS.
 SECS may be an integer, a floating point number, or the internal
-time format (HIGH LOW USECS) returned by, e.g., `current-idle-time'.
+time format (HIGH LOW NSECS) returned by, e.g., `current-idle-time'.
 If Emacs is currently idle, and has been idle for N seconds (N < SECS),
 then it will call FUNCTION in SECS - N seconds from now.


=== modified file 'lisp/gnus/message.el'
--- lisp/gnus/message.el        2011-06-30 01:02:47 +0000
+++ lisp/gnus/message.el        2011-07-01 05:24:16 +0000
@@ -5486,7 +5486,7 @@
 ;; You might for example insert a "." somewhere (not next to another dot
 ;; or string boundary), or modify the "fsf" string.
 (defun message-unique-id ()
-  ;; Don't use microseconds from (current-time), they may be unsupported.
+  ;; Don't use nanoseconds from (current-time), they may be unsupported.
   ;; Instead we use this randomly inited counter.
   (setq message-unique-id-char
        (% (1+ (or message-unique-id-char (logand (random t) (1- (lsh 1 20)))))

=== modified file 'lisp/net/sasl.el'
--- lisp/net/sasl.el    2011-01-25 04:08:28 +0000
+++ lisp/net/sasl.el    2011-07-01 05:24:17 +0000
@@ -180,7 +180,7 @@

 ;; stolen (and renamed) from message.el
 (defun sasl-unique-id-function ()
-  ;; Don't use microseconds from (current-time), they may be unsupported.
+  ;; Don't use nanoseconds from (current-time), they may be unsupported.
   ;; Instead we use this randomly inited counter.
   (setq sasl-unique-id-char
        (% (1+ (or sasl-unique-id-char (logand (random t) (1- (lsh 1 20)))))

=== modified file 'lisp/org/org-id.el'
--- lisp/org/org-id.el  2011-03-06 00:30:16 +0000
+++ lisp/org/org-id.el  2011-07-01 05:24:18 +0000
@@ -385,7 +385,7 @@
   (setq time (or time (current-time)))
   (concat (org-id-int-to-b36 (nth 0 time) 4)
          (org-id-int-to-b36 (nth 1 time) 4)
-         (org-id-int-to-b36 (or (nth 2 time) 0) 4)))
+         (org-id-int-to-b36 (/ (or (nth 2 time) 0) 1000) 4)))

 (defun org-id-decode (id)
   "Split ID into the prefix and the time value that was used to create it.
@@ -642,6 +642,3 @@
 (provide 'org-id)

 ;;; org-id.el ends here
-
-
-

=== modified file 'lisp/type-break.el'
--- lisp/type-break.el  2011-07-01 04:36:40 +0000
+++ lisp/type-break.el  2011-07-01 05:24:20 +0000
@@ -503,9 +503,9 @@
 return TIME, else return nil."
   (and (listp time)
        (eq (length time) 3)
-       (integerp (car time))
+       (numberp (car time))
        (integerp (nth 1 time))
-       (integerp (nth 2 time))
+       (numberp (nth 2 time))
        time))

 (defun type-break-choose-file ()