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 ()
next prev 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.