all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
From: Paul Eggert <eggert@cs.ucla.edu>
To: Emacs Development <emacs-devel@gnu.org>
Subject: [PATCH 7/7] Lisp-level support for ns-resolution time stamps
Date: Fri, 01 Jul 2011 01:16:35 -0700	[thread overview]
Message-ID: <4E0D8263.9010808@cs.ucla.edu> (raw)
In-Reply-To: <4E0D704F.4070304@cs.ucla.edu>

[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 @@
 \f
 (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 ()





  parent reply	other threads:[~2011-07-01  8:16 UTC|newest]

Thread overview: 18+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2011-07-01  6:59 nanosecond-resolution time stamps Paul Eggert
2011-07-01  8:14 ` [PATCH 1/7] gnulib substrate for ns-resolution " Paul Eggert
2011-07-01 11:20   ` Eli Zaretskii
2011-07-01 14:13     ` Eli Zaretskii
2011-07-01 16:27     ` Paul Eggert
2011-07-01 17:39       ` Eli Zaretskii
2011-07-01 18:50       ` Paul Eggert
2011-07-01 19:52         ` Eli Zaretskii
2011-07-01  8:14 ` [PATCH 2/7] etc/NEWS patch " Paul Eggert
2011-07-01  8:15 ` [PATCH 3/7] Doc patches " Paul Eggert
2011-07-01  8:15 ` [PATCH 4/7] configure-time support " Paul Eggert
2011-07-01  8:15 ` [PATCH 5/7] C-level " Paul Eggert
2011-07-01  8:16 ` [PATCH 6/7] lib-src " Paul Eggert
2011-07-01  8:16 ` Paul Eggert [this message]
2011-07-01 15:55 ` nanosecond-resolution " Stefan Monnier
2011-07-01 17:15   ` Paul Eggert
2011-07-04 15:04     ` Stefan Monnier
2011-07-05  7:13       ` Paul Eggert

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=4E0D8263.9010808@cs.ucla.edu \
    --to=eggert@cs.ucla.edu \
    --cc=emacs-devel@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.