mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-01 09:51:22 -08:00
Code Issues Projects Releases Wiki Activity

Improve time stamp handling, and be more consistent about it.

Browse source 
This implements a suggestion made in:
http://lists.gnu.org/archive/html/emacs-devel/2014-10/msg00587.html
Among other things, this means timer.el no longer needs to
autoload the time-date module.
* doc/lispref/os.texi (Time of Day, Time Conversion, Time Parsing)
(Processor Run Time, Time Calculations):
Document the new behavior, plus be clearer about the old behavior.
(Idle Timers): Take advantage of new functionality.
* etc/NEWS: Document the changes.
* lisp/allout-widgets.el (allout-elapsed-time-seconds): Doc fix.
* lisp/arc-mode.el (archive-ar-summarize):
* lisp/calendar/time-date.el (seconds-to-time, days-to-time, time-since):
* lisp/emacs-lisp/timer.el (timer-relative-time, timer-event-handler)
(run-at-time, with-timeout-suspend, with-timeout-unsuspend):
* lisp/net/tramp.el (tramp-time-less-p, tramp-time-subtract):
* lisp/proced.el (proced-time-lessp):
* lisp/timezone.el (timezone-time-from-absolute):
* lisp/type-break.el (type-break-schedule, type-break-time-sum):
Simplify by using new functionality.
* lisp/calendar/cal-dst.el (calendar-next-time-zone-transition):
Do not return time values in obsolete and undocumented (HI . LO)
format; use (HI LO) instead.
* lisp/calendar/time-date.el (with-decoded-time-value):
Treat 'nil' as current time.  This is mostly for XEmacs.
(encode-time-value, with-decoded-time-value): Obsolete.
(time-add, time-subtract, time-less-p): Use no-op autoloads, for
XEmacs.  Define only if XEmacs, as they're now C builtins in Emacs.
* lisp/ldefs-boot.el: Update to match new time-date.el
* lisp/proced.el: Do not require time-date.
* src/editfns.c (invalid_time): New function.
Use it instead of 'error ("Invalid time specification")'.
(time_add, time_subtract, time_arith, Ftime_add, Ftime_less_p)
(decode_float_time, lisp_to_timespec, lisp_time_struct):
New functions.
(make_time_tail, make_time): Remove.  All uses changed to use
new functions or plain list4i.
(disassemble_lisp_time): Return effective length if successful.
Check that LOW is an integer, if it's combined with other components.
(decode_time_components): Decode into struct lisp_time, not
struct timespec, so that we can support a wide set of times
regardless of whether time_t is signed.  Decode plain numbers
as seconds since the Epoch, and nil as the current time.
(lisp_time_argument, lisp_seconds_argument, Ffloat_time):
Reimplement in terms of new functions.
(Fencode_time): Just use list2i.
(syms_of_editfns): Add time-add, time-subtract, time-less-p.
* src/keyboard.c (decode_timer): Don't allow the new formats (floating
point or nil) in timers.
* src/systime.h (LO_TIME_BITS): New constant.  Use it everywhere in
place of the magic number '16'.
(struct lisp_time): New type.
(decode_time_components): Use it.
(lisp_to_timespec): New decl.
This commit is contained in:
Paul Eggert 2014-11-16 20:38:15 -08:00
parent 058f56d24f
commit 0921dbc3ab
19 changed files with 548 additions and 327 deletions
Download patch file Download diff file Expand all files Collapse all files

8
doc/lispref/ChangeLog
View file

@ -1,3 +1,11 @@
2014-11-17 Paul Eggert <eggert@cs.ucla.edu>
Improve time stamp handling, and be more consistent about it.
* os.texi (Time of Day, Time Conversion, Time Parsing)
(Processor Run Time, Time Calculations):
Document the new behavior, plus be clearer about the old behavior.
(Idle Timers): Take advantage of new functionality.
2014-11-16 Lars Magne Ingebrigtsen <larsi@gnus.org> 2014-11-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
* text.texi (Special Properties): Mention `inhibit-read-only'. * text.texi (Special Properties): Mention `inhibit-read-only'.

131
doc/lispref/os.texi
View file

@ -1213,37 +1213,34 @@ return value is @code{nil}.
zone. zone.
@cindex epoch @cindex epoch
Most of these functions represent time as a list of either four Most of these functions represent time as a list of four integers
integers, @code{(@var{sec-high} @var{sec-low} @var{microsec} @code{(@var{sec-high} @var{sec-low} @var{microsec} @var{picosec})}.
@var{picosec})}, or of three This represents the number of seconds from the @dfn{epoch} (January
integers, @code{(@var{sec-high} @var{sec-low} @var{microsec})}, or of 1, 1970 at 00:00 UTC), using the formula:
two integers, @code{(@var{sec-high} @var{sec-low})}. The integers
@var{sec-high} and @var{sec-low} give the high and low bits of an
integer number of seconds. This integer,
@ifnottex @ifnottex
@var{high} * 2**16 + @var{low}, @var{high} * 2**16 + @var{low} + @var{micro} * 10**@minus{}6 +
@var{pico} * 10**@minus{}12.
@end ifnottex @end ifnottex
@tex @tex
$high*2^{16}+low$, $high*2^{16} + low + micro*10^{-6} + pico*10^{-12}$.
@end tex @end tex
is the number of seconds from the @dfn{epoch} (January 1, 1970 at 00:00 The return value of @code{current-time} represents time using this
UTC) to the specified time. The third list element @var{microsec}, if form, as do the timestamps in the return values of other functions
present, gives the number of microseconds from the start of that such as @code{file-attributes} (@pxref{Definition of
second to the specified time. file-attributes}). In some cases, functions may return two- or
Similarly, the fourth list element @var{picosec}, if present, gives three-element lists, with omitted @var{microsec} and @var{picosec}
the number of picoseconds from the start of that microsecond to the components defaulting to zero.
specified time.
The return value of @code{current-time} represents time using four @cindex time value
integers, as do the timestamps in the return value of Function arguments, e.g., the @var{time-value} argument to
@code{file-attributes} (@pxref{Definition of @code{current-time-string}, accept a more-general @dfn{time value}
file-attributes}). In function arguments, e.g., the @var{time-value} format, which can be a list of integers as above, or a single number
argument to @code{current-time-string}, two-, three-, and four-integer for seconds since the epoch, or @code{nil} for the current time. You
lists are accepted. You can convert times from the list can convert a time value into a human-readable string using
representation into standard human-readable strings using @code{current-time-string} and @code{format-time-string}, into a list
@code{current-time-string}, or to other forms using the of integers using @code{seconds-to-time}, and into other forms using
@code{decode-time} and @code{format-time-string} functions documented @code{decode-time} and @code{float-time}. These functions are
in the following sections. described in the following sections.
@defun current-time-string &optional time-value @defun current-time-string &optional time-value
This function returns the current time and date as a human-readable This function returns the current time and date as a human-readable
@ -1256,8 +1253,8 @@ characters from the beginning of the string rather than from the end,
as the year might not have exactly four digits, and additional as the year might not have exactly four digits, and additional
information may some day be added at the end. information may some day be added at the end.
The argument @var{time-value}, if given, specifies a time to format The argument @var{time-value}, if given, specifies a time to format,
(represented as a list of integers), instead of the current time. instead of the current time.
@example @example
@group @group
@ -1279,11 +1276,19 @@ become available.
@defun float-time &optional time-value @defun float-time &optional time-value
This function returns the current time as a floating-point number of This function returns the current time as a floating-point number of
seconds since the epoch. The optional argument @var{time-value}, if seconds since the epoch. The optional argument @var{time-value}, if
given, specifies a time (represented as a list of integers) to convert given, specifies a time to convert instead of the current time.
instead of the current time.
@emph{Warning}: Since the result is floating point, it may not be @emph{Warning}: Since the result is floating point, it may not be
exact. Do not use this function if precise time stamps are required. exact. Do not use this function if precise time stamps are required.
@code{time-to-seconds} is an alias for this function.
@end defun
@defun seconds-to-time time-value
This function converts a time value to list-of-integer form.
For example, if @var{time-value} is a number, @code{(time-to-seconds
(seconds-to-time @var{time-value}))} equals the number unless overflow
or rounding errors occur.
@end defun @end defun
@defun current-time-zone &optional time-value @defun current-time-zone &optional time-value
@ -1302,8 +1307,8 @@ adjustment, then the value is constant through time.
If the operating system doesn't supply all the information necessary to If the operating system doesn't supply all the information necessary to
compute the value, the unknown elements of the list are @code{nil}. compute the value, the unknown elements of the list are @code{nil}.
The argument @var{time-value}, if given, specifies a time (represented The argument @var{time-value}, if given, specifies a time value to
as a list of integers) to analyze instead of the current time. analyze instead of the current time.
@end defun @end defun
The current time zone is determined by the @env{TZ} environment The current time zone is determined by the @env{TZ} environment
@ -1316,15 +1321,15 @@ time zone.
@section Time Conversion @section Time Conversion
@cindex calendrical information @cindex calendrical information
These functions convert time values (lists of two to four integers, These functions convert time values (@pxref{Time of Day}) into
as explained in the previous section) into calendrical information and calendrical information and vice versa.
vice versa.
Many 32-bit operating systems are limited to time values containing Many 32-bit operating systems are limited to system times containing
32 bits of information; these systems typically handle only the times 32 bits of information in their seconds component; these systems
from 1901-12-13 20:45:52 UTC through 2038-01-19 03:14:07 UTC@. typically handle only the times from 1901-12-13 20:45:52 UTC through
However, 64-bit and some 32-bit operating systems have larger time 2038-01-19 03:14:07 UTC@. However, 64-bit and some 32-bit operating
values, and can represent times far in the past or future. systems have larger seconds components, and can represent times far in
the past or future.
Time conversion functions always use the Gregorian calendar, even Time conversion functions always use the Gregorian calendar, even
for dates before the Gregorian calendar was introduced. Year numbers for dates before the Gregorian calendar was introduced. Year numbers
@ -1332,9 +1337,9 @@ count the number of years since the year 1 B.C., and do not skip zero
as traditional Gregorian years do; for example, the year number as traditional Gregorian years do; for example, the year number
@minus{}37 represents the Gregorian year 38 B.C@. @minus{}37 represents the Gregorian year 38 B.C@.
@defun decode-time &optional time @defun decode-time &optional time-value
This function converts a time value into calendrical information. If This function converts a time value into calendrical information. If
you don't specify @var{time}, it decodes the current time. The return you don't specify @var{time-value}, it decodes the current time. The return
value is a list of nine elements, as follows: value is a list of nine elements, as follows:
@example @example
@ -1373,8 +1378,9 @@ Greenwich.
@defun encode-time seconds minutes hour day month year &optional zone @defun encode-time seconds minutes hour day month year &optional zone
This function is the inverse of @code{decode-time}. It converts seven This function is the inverse of @code{decode-time}. It converts seven
items of calendrical data into a time value. For the meanings of the items of calendrical data into a list-of-integer time value. For the
arguments, see the table above under @code{decode-time}. meanings of the arguments, see the table above under
@code{decode-time}.
Year numbers less than 100 are not treated specially. If you want them Year numbers less than 100 are not treated specially. If you want them
to stand for years above 1900, or years above 2000, you must alter them to stand for years above 1900, or years above 2000, you must alter them
@ -1418,9 +1424,11 @@ This function parses the time-string @var{string} and returns the
corresponding time value. corresponding time value.
@end defun @end defun
@defun format-time-string format-string &optional time universal @defun format-time-string format-string &optional time-value universal
This function converts @var{time} (or the current time, if @var{time} is
omitted) to a string according to @var{format-string}. The argument This function converts @var{time-value} (or the current time, if
@var{time-value} is omitted) to a string according to
@var{format-string}. The argument
@var{format-string} may contain @samp{%}-sequences which say to @var{format-string} may contain @samp{%}-sequences which say to
substitute parts of the time. Here is a table of what the substitute parts of the time. Here is a table of what the
@samp{%}-sequences mean: @samp{%}-sequences mean:
@ -1540,12 +1548,6 @@ specified by @code{locale-coding-system} (@pxref{Locales}); after
system. system.
@end defun @end defun
@defun seconds-to-time seconds
This function converts @var{seconds}, the number of seconds since the
epoch, to a time value and returns that. To convert back, use
@code{float-time} (@pxref{Time of Day}).
@end defun
@defun format-seconds format-string seconds @defun format-seconds format-string seconds
This function converts its argument @var{seconds} into a string of This function converts its argument @var{seconds} into a string of
years, days, hours, etc., according to @var{format-string}. The years, days, hours, etc., according to @var{format-string}. The
@ -1619,7 +1621,7 @@ When called interactively, it prints the uptime in the echo area.
@defun get-internal-run-time @defun get-internal-run-time
This function returns the processor run time used by Emacs as a list This function returns the processor run time used by Emacs as a list
of four integers: @code{(@var{high} @var{low} @var{microsec} of four integers: @code{(@var{sec-high} @var{sec-low} @var{microsec}
@var{picosec})}, using the same format as @code{current-time} @var{picosec})}, using the same format as @code{current-time}
(@pxref{Time of Day}). (@pxref{Time of Day}).
@ -1643,7 +1645,7 @@ interactively, it prints the duration in the echo area.
@section Time Calculations @section Time Calculations
These functions perform calendrical computations using time values These functions perform calendrical computations using time values
(the kind of list that @code{current-time} returns). (@pxref{Time of Day}).
@defun time-less-p t1 t2 @defun time-less-p t1 t2
This returns @code{t} if time value @var{t1} is less than time value This returns @code{t} if time value @var{t1} is less than time value
@ -1652,26 +1654,26 @@ This returns @code{t} if time value @var{t1} is less than time value
@defun time-subtract t1 t2 @defun time-subtract t1 t2
This returns the time difference @var{t1} @minus{} @var{t2} between This returns the time difference @var{t1} @minus{} @var{t2} between
two time values, in the same format as a time value. two time values, as a time value.
@end defun @end defun
@defun time-add t1 t2 @defun time-add t1 t2
This returns the sum of two time values, one of which ought to This returns the sum of two time values, as a time value.
represent a time difference rather than a point in time. One argument should represent a time difference rather than a point in time.
Here is how to add a number of seconds to a time value: Here is how to add a number of seconds to a time value:
@example @example
(time-add @var{time} (seconds-to-time @var{seconds})) (time-add @var{time} @var{seconds})
@end example @end example
@end defun @end defun
@defun time-to-days time @defun time-to-days time-value
This function returns the number of days between the beginning of year This function returns the number of days between the beginning of year
1 and @var{time}. 1 and @var{time-value}.
@end defun @end defun
@defun time-to-day-in-year time @defun time-to-day-in-year time-value
This returns the day number within the year corresponding to @var{time}. This returns the day number within the year corresponding to @var{time-value}.
@end defun @end defun
@defun date-leap-year-p year @defun date-leap-year-p year
@ -1915,8 +1917,7 @@ idleness. Here's an example:
(run-with-idle-timer (run-with-idle-timer
;; Compute an idle time @var{break-length} ;; Compute an idle time @var{break-length}
;; more than the current value. ;; more than the current value.
(time-add (current-idle-time) (time-add (current-idle-time) @var{break-length})
(seconds-to-time @var{break-length}))
nil nil
'my-timer-function)))) 'my-timer-function))))
@end example @end example

5
etc/ChangeLog
View file

@ -1,3 +1,8 @@
2014-11-17 Paul Eggert <eggert@cs.ucla.edu>
Improve time stamp handling, and be more consistent about it.
* NEWS: Document the changes.
2014-11-14 Lars Magne Ingebrigtsen <larsi@gnus.org> 2014-11-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
* NEWS: Mention the new `M-s M-s' keystroke. * NEWS: Mention the new `M-s M-s' keystroke.

19
etc/NEWS
View file

@ -377,6 +377,25 @@ optional repeat-count argument.
*** New macros `thread-first' and `thread-last' allow threading a form *** New macros `thread-first' and `thread-last' allow threading a form
as the first or last argument of subsequent forms. as the first or last argument of subsequent forms.
+++
** Time-related changes:
*** Time-related functions now consistently accept numbers
(representing seconds since the epoch) and nil (representing the
current time) as well as the usual list-of-integer representation.
Affected functions include `current-time-string', `current-time-zone',
`decode-time', `float-time', `format-time-string', `seconds-to-time',
`time-add', `time-less-p', `time-subtract', `time-to-day-in-year',
`time-to-days', and `time-to-seconds'.
*** The `encode-time-value' and `with-decoded-time-value' macros have
been obsoleted.
*** `calendar-next-time-zone-transition', `time-add', and
`time-subtract' no longer return time values in the obsolete and
undocumented integer-pair format. Instead, they return a list of two
integers.
* Changes in Frames and Windows Code in Emacs 25.1 * Changes in Frames and Windows Code in Emacs 25.1

28
lisp/ChangeLog
View file

@ -1,3 +1,31 @@
2014-11-17 Paul Eggert <eggert@cs.ucla.edu>
Improve time stamp handling, and be more consistent about it.
This implements a suggestion made in:
http://lists.gnu.org/archive/html/emacs-devel/2014-10/msg00587.html
Among other things, this means timer.el no longer needs to
autoload the time-date module.
* allout-widgets.el (allout-elapsed-time-seconds): Doc fix.
* arc-mode.el (archive-ar-summarize):
* calendar/time-date.el (seconds-to-time, days-to-time, time-since):
* emacs-lisp/timer.el (timer-relative-time, timer-event-handler)
(run-at-time, with-timeout-suspend, with-timeout-unsuspend):
* net/tramp.el (tramp-time-less-p, tramp-time-subtract):
* proced.el (proced-time-lessp):
* timezone.el (timezone-time-from-absolute):
* type-break.el (type-break-schedule, type-break-time-sum):
Simplify by using new functionality.
* calendar/cal-dst.el (calendar-next-time-zone-transition):
Do not return time values in obsolete and undocumented (HI . LO)
format; use (HI LO) instead.
* calendar/time-date.el (with-decoded-time-value):
Treat 'nil' as current time. This is mostly for XEmacs.
(encode-time-value, with-decoded-time-value): Obsolete.
(time-add, time-subtract, time-less-p): Use no-op autoloads, for
XEmacs. Define only if XEmacs, as they're now C builtins in Emacs.
* ldefs-boot.el: Update to match new time-date.el
* proced.el: Do not require time-date.
2014-11-16 Lars Magne Ingebrigtsen <larsi@gnus.org> 2014-11-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
* net/eww.el (eww-mode): Make the buffer read-only. * net/eww.el (eww-mode): Make the buffer read-only.

4
lisp/allout-widgets.el
View file

@ -2342,9 +2342,9 @@ We use a caching strategy, so the caller doesn't need to do so."
got))) got)))
;;;_ : Miscellaneous ;;;_ : Miscellaneous
;;;_ > allout-elapsed-time-seconds (triple) ;;;_ > allout-elapsed-time-seconds (time-value time-value)
(defun allout-elapsed-time-seconds (end start) (defun allout-elapsed-time-seconds (end start)
"Return seconds between `current-time' style time START/END triples." "Return seconds between START/END time values."
(let ((elapsed (time-subtract end start))) (let ((elapsed (time-subtract end start)))
(float-time elapsed))) (float-time elapsed)))
;;;_ > allout-frame-property (frame property) ;;;_ > allout-frame-property (frame property)

6
lisp/arc-mode.el
View file

@ -2181,11 +2181,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(size (string-to-number (match-string 6)))) (size (string-to-number (match-string 6))))
;; Move to the beginning of the data. ;; Move to the beginning of the data.
(goto-char (match-end 0)) (goto-char (match-end 0))
(setq time (setq time (format-time-string "%Y-%m-%d %H:%M" time))
(format-time-string
"%Y-%m-%d %H:%M"
(let ((high (truncate (/ time 65536))))
(list high (truncate (- time (* 65536.0 high)))))))
(setq extname (setq extname
(cond ((equal name "// ") (cond ((equal name "// ")
(propertize ".<ExtNamesTable>." 'face 'italic)) (propertize ".<ExtNamesTable>." 'face 'italic))

1
lisp/calendar/cal-dst.el
View file

@ -179,6 +179,7 @@ Return nil if no such transition can be found."
(if (eq (car (current-time-zone probe)) hi-utc-diff) (if (eq (car (current-time-zone probe)) hi-utc-diff)
(setq hi probe) (setq hi probe)
(setq lo probe))) (setq lo probe)))
(setcdr hi (list (cdr hi)))
hi)))) hi))))
(autoload 'calendar-persian-to-absolute "cal-persia") (autoload 'calendar-persian-to-absolute "cal-persia")

158
lisp/calendar/time-date.el
View file

@ -30,10 +30,9 @@
;; value equal to HIGH * 2^16 + LOW + USEC * 10^-6 + PSEC * 10^-12 ;; value equal to HIGH * 2^16 + LOW + USEC * 10^-6 + PSEC * 10^-12
;; seconds, where missing components are treated as zero. HIGH can be ;; seconds, where missing components are treated as zero. HIGH can be
;; negative, either because the value is a time difference, or because ;; negative, either because the value is a time difference, or because
;; the machine supports negative time stamps that fall before the epoch. ;; it represents a time stamp before the epoch. Typically, there are
;; The macro `with-decoded-time-value' and the function ;; more time values than the underlying system time type supports,
;; `encode-time-value' make it easier to deal with these formats. ;; but the reverse can also be true.
;; See `time-subtract' for an example of how to use them.
;;; Code: ;;; Code:
@ -71,6 +70,7 @@ list (HIGH LOW MICRO PICO)."
,low ,micro) ,low ,micro)
(when pico `(,pico)) (when pico `(,pico))
(when type `(,type))) (when type `(,type)))
(or ,gensym (setq ,gensym (current-time)))
(if (consp ,gensym) (if (consp ,gensym)
(progn (progn
(setq ,low (pop ,gensym)) (setq ,low (pop ,gensym))
@ -108,6 +108,10 @@ it is assumed that PICO was omitted and should be treated as zero."
((eq type 3) (list high low micro pico)) ((eq type 3) (list high low micro pico))
((null type) (encode-time-value high low micro 0 pico)))) ((null type) (encode-time-value high low micro 0 pico))))
(when (featurep 'emacs)
(make-obsolete 'encode-time-value nil "25.1")
(make-obsolete 'with-decoded-time-value nil "25.1"))
(autoload 'parse-time-string "parse-time") (autoload 'parse-time-string "parse-time")
(autoload 'timezone-make-date-arpa-standard "timezone") (autoload 'timezone-make-date-arpa-standard "timezone")
@ -158,47 +162,17 @@ TIME defaults to the current time."
;;;###autoload ;;;###autoload
(defun seconds-to-time (seconds) (defun seconds-to-time (seconds)
"Convert SECONDS (a floating point number) to a time value." "Convert SECONDS to a time value."
(let* ((usec (* 1000000 (mod seconds 1))) (time-add 0 seconds))
(ps (round (* 1000000 (mod usec 1))))
(us (floor usec))
(lo (floor (mod seconds 65536)))
(hi (floor seconds 65536)))
(if (eq ps 1000000)
(progn
(setq ps 0)
(setq us (1+ us))
(if (eq us 1000000)
(progn
(setq us 0)
(setq lo (1+ lo))
(if (eq lo 65536)
(progn
(setq lo 0)
(setq hi (1+ hi))))))))
(list hi lo us ps)))
;;;###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 pico1 type1 t1)
(high2 low2 micro2 pico2 type2 t2))
(or (< high1 high2)
(and (= high1 high2)
(or (< low1 low2)
(and (= low1 low2)
(or (< micro1 micro2)
(and (= micro1 micro2)
(< pico1 pico2)))))))))
;;;###autoload ;;;###autoload
(defun days-to-time (days) (defun days-to-time (days)
"Convert DAYS into a time value." "Convert DAYS into a time value."
(let* ((seconds (* 1.0 days 60 60 24)) (let ((time (condition-case nil (seconds-to-time (* 86400.0 days))
(high (condition-case nil (floor (/ seconds 65536)) (range-error (list most-positive-fixnum 65535)))))
(range-error most-positive-fixnum)))) (if (integerp days)
(list high (condition-case nil (floor (- seconds (* 1.0 high 65536))) (setcdr (cdr time) nil))
(range-error 65535))))) time))
;;;###autoload ;;;###autoload
(defun time-since (time) (defun time-since (time)
@ -207,53 +181,71 @@ TIME should be either a time value or a date-time string."
(when (stringp time) (when (stringp time)
;; Convert date strings to internal time. ;; Convert date strings to internal time.
(setq time (date-to-time time))) (setq time (date-to-time time)))
(time-subtract (current-time) time)) (time-subtract nil time))
;;;###autoload ;;;###autoload
(defalias 'subtract-time 'time-subtract) (defalias 'subtract-time 'time-subtract)
;;;###autoload ;; These autoloads do nothing in Emacs 25, where the functions are builtin.
(defun time-subtract (t1 t2) ;;;###autoload(autoload 'time-add "time-date")
"Subtract two time values, T1 minus T2. ;;;###autoload(autoload 'time-subtract "time-date")
Return the difference in the format of a time value." ;;;###autoload(autoload 'time-less-p "time-date")
(with-decoded-time-value ((high low micro pico type t1)
(high2 low2 micro2 pico2 type2 t2))
(setq high (- high high2)
low (- low low2)
micro (- micro micro2)
pico (- pico pico2)
type (max type type2))
(when (< pico 0)
(setq micro (1- micro)
pico (+ pico 1000000)))
(when (< micro 0)
(setq low (1- low)
micro (+ micro 1000000)))
(when (< low 0)
(setq high (1- high)
low (+ low 65536)))
(encode-time-value high low micro pico type)))
;;;###autoload (eval-when-compile
(defun time-add (t1 t2) (when (not (featurep 'emacs))
"Add two time values T1 and T2. One should represent a time difference."
(with-decoded-time-value ((high low micro pico type t1) (defun time-add (t1 t2)
(high2 low2 micro2 pico2 type2 t2)) "Add two time values T1 and T2. One should represent a time difference."
(setq high (+ high high2) (with-decoded-time-value ((high low micro pico type t1)
low (+ low low2) (high2 low2 micro2 pico2 type2 t2))
micro (+ micro micro2) (setq high (+ high high2)
pico (+ pico pico2) low (+ low low2)
type (max type type2)) micro (+ micro micro2)
(when (>= pico 1000000) pico (+ pico pico2)
(setq micro (1+ micro) type (max type type2))
pico (- pico 1000000))) (when (>= pico 1000000)
(when (>= micro 1000000) (setq micro (1+ micro)
(setq low (1+ low) pico (- pico 1000000)))
micro (- micro 1000000))) (when (>= micro 1000000)
(when (>= low 65536) (setq low (1+ low)
(setq high (1+ high) micro (- micro 1000000)))
low (- low 65536))) (when (>= low 65536)
(encode-time-value high low micro pico type))) (setq high (1+ high)
low (- low 65536)))
(encode-time-value high low micro pico type)))
(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 pico type t1)
(high2 low2 micro2 pico2 type2 t2))
(setq high (- high high2)
low (- low low2)
micro (- micro micro2)
pico (- pico pico2)
type (max type type2))
(when (< pico 0)
(setq micro (1- micro)
pico (+ pico 1000000)))
(when (< micro 0)
(setq low (1- low)
micro (+ micro 1000000)))
(when (< low 0)
(setq high (1- high)
low (+ low 65536)))
(encode-time-value high low micro pico type)))
(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 pico1 type1 t1)
(high2 low2 micro2 pico2 type2 t2))
(or (< high1 high2)
(and (= high1 high2)
(or (< low1 low2)
(and (= low1 low2)
(or (< micro1 micro2)
(and (= micro1 micro2)
(< pico1 pico2)))))))))))
;;;###autoload ;;;###autoload
(defun date-to-day (date) (defun date-to-day (date)

16
lisp/emacs-lisp/timer.el
View file

@ -125,9 +125,7 @@ of SECS seconds since the epoch. SECS may be a fraction."
"Advance TIME by SECS seconds and optionally USECS microseconds "Advance TIME by SECS seconds and optionally USECS microseconds
and PSECS picoseconds. SECS may be either an integer or a and PSECS picoseconds. SECS may be either an integer or a
floating point number." floating point number."
(let ((delta (if (floatp secs) (let ((delta secs))
(seconds-to-time secs)
(list (floor secs 65536) (mod secs 65536)))))
(if (or usecs psecs) (if (or usecs psecs)
(setq delta (time-add delta (list 0 0 (or usecs 0) (or psecs 0))))) (setq delta (time-add delta (list 0 0 (or usecs 0) (or psecs 0)))))
(time-add time delta))) (time-add time delta)))
@ -307,8 +305,8 @@ This function is called, by name, directly by the C code."
;; perhaps because Emacs was suspended for a long time, ;; perhaps because Emacs was suspended for a long time,
;; limit how many times things get repeated. ;; limit how many times things get repeated.
(if (and (numberp timer-max-repeats) (if (and (numberp timer-max-repeats)
(< 0 (timer-until timer (current-time)))) (< 0 (timer-until timer nil)))
(let ((repeats (/ (timer-until timer (current-time)) (let ((repeats (/ (timer-until timer nil)
(timer--repeat-delay timer)))) (timer--repeat-delay timer))))
(if (> repeats timer-max-repeats) (if (> repeats timer-max-repeats)
(timer-inc-time timer (* (timer--repeat-delay timer) (timer-inc-time timer (* (timer--repeat-delay timer)
@ -374,13 +372,13 @@ This function returns a timer object which you can use in `cancel-timer'."
;; Handle numbers as relative times in seconds. ;; Handle numbers as relative times in seconds.
(if (numberp time) (if (numberp time)
(setq time (timer-relative-time (current-time) time))) (setq time (timer-relative-time nil time)))
;; Handle relative times like "2 hours 35 minutes" ;; Handle relative times like "2 hours 35 minutes"
(if (stringp time) (if (stringp time)
(let ((secs (timer-duration time))) (let ((secs (timer-duration time)))
(if secs (if secs
(setq time (timer-relative-time (current-time) secs))))) (setq time (timer-relative-time nil secs)))))
;; Handle "11:23pm" and the like. Interpret it as meaning today ;; Handle "11:23pm" and the like. Interpret it as meaning today
;; which admittedly is rather stupid if we have passed that time ;; which admittedly is rather stupid if we have passed that time
@ -486,7 +484,7 @@ The value is a list that the debugger can pass to `with-timeout-unsuspend'
when it exits, to make these timers start counting again." when it exits, to make these timers start counting again."
(mapcar (lambda (timer) (mapcar (lambda (timer)
(cancel-timer timer) (cancel-timer timer)
(list timer (time-subtract (timer--time timer) (current-time)))) (list timer (time-subtract (timer--time timer) nil)))
with-timeout-timers)) with-timeout-timers))
(defun with-timeout-unsuspend (timer-spec-list) (defun with-timeout-unsuspend (timer-spec-list)
@ -495,7 +493,7 @@ The argument should be a value previously returned by `with-timeout-suspend'."
(dolist (elt timer-spec-list) (dolist (elt timer-spec-list)
(let ((timer (car elt)) (let ((timer (car elt))
(delay (cadr elt))) (delay (cadr elt)))
(timer-set-time timer (time-add (current-time) delay)) (timer-set-time timer (time-add nil delay))
(timer-activate timer)))) (timer-activate timer))))
(defun y-or-n-p-with-timeout (prompt seconds default-value) (defun y-or-n-p-with-timeout (prompt seconds default-value)

21
lisp/ldefs-boot.el
View file

@ -27478,15 +27478,10 @@ If DATE lacks timezone information, GMT is assumed.
(autoload 'time-to-seconds "time-date")) (autoload 'time-to-seconds "time-date"))
(autoload 'seconds-to-time "time-date" "\ (autoload 'seconds-to-time "time-date" "\
Convert SECONDS (a floating point number) to a time value. Convert SECONDS to a time value.
\(fn SECONDS)" nil nil) \(fn SECONDS)" nil nil)
(autoload 'time-less-p "time-date" "\
Return non-nil if time value T1 is earlier than time value T2.
\(fn T1 T2)" nil nil)
(autoload 'days-to-time "time-date" "\ (autoload 'days-to-time "time-date" "\
Convert DAYS into a time value. Convert DAYS into a time value.
@ -27499,17 +27494,9 @@ TIME should be either a time value or a date-time string.
\(fn TIME)" nil nil) \(fn TIME)" nil nil)
(defalias 'subtract-time 'time-subtract) (defalias 'subtract-time 'time-subtract)
(autoload 'time-add "time-date")
(autoload 'time-subtract "time-date" "\ (autoload 'time-subtract "time-date")
Subtract two time values, T1 minus T2. (autoload 'time-less-p "time-date")
Return the difference in the format of a time value.
\(fn T1 T2)" nil nil)
(autoload 'time-add "time-date" "\
Add two time values T1 and T2. One should represent a time difference.
\(fn T1 T2)" nil nil)
(autoload 'date-to-day "time-date" "\ (autoload 'date-to-day "time-date" "\
Return the number of days between year 1 and DATE. Return the number of days between year 1 and DATE.

14
lisp/net/tramp.el
View file

@ -4236,25 +4236,15 @@ Invokes `password-read' if available, `read-passwd' else."
("oct" . 10) ("nov" . 11) ("dec" . 12)) ("oct" . 10) ("nov" . 11) ("dec" . 12))
"Alist mapping month names to integers.") "Alist mapping month names to integers.")
;; FIXME: Shouldn't this also look at any subseconds parts of T1 and T2?
;;;###tramp-autoload ;;;###tramp-autoload
(defun tramp-time-less-p (t1 t2) (defun tramp-time-less-p (t1 t2)
"Say whether time value T1 is less than time value T2." "Say whether time value T1 is less than time value T2."
(unless t1 (setq t1 '(0 0))) (time-less-p (or t1 0) (or t2 0)))
(unless t2 (setq t2 '(0 0)))
(or (< (car t1) (car t2))
(and (= (car t1) (car t2))
(< (nth 1 t1) (nth 1 t2)))))
;; FIXME: Shouldn't this also look at any subseconds parts of T1 and T2?
(defun tramp-time-subtract (t1 t2) (defun tramp-time-subtract (t1 t2)
"Subtract two time values. "Subtract two time values.
Return the difference in the format of a time value." Return the difference in the format of a time value."
(unless t1 (setq t1 '(0 0))) (time-subtract (or t1 0) (or t2 0)))
(unless t2 (setq t2 '(0 0)))
(let ((borrow (< (cadr t1) (cadr t2))))
(list (- (car t1) (car t2) (if borrow 1 0))
(- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
;;;###tramp-autoload ;;;###tramp-autoload
(defun tramp-time-diff (t1 t2) (defun tramp-time-diff (t1 t2)

15
lisp/proced.el
View file

@ -49,8 +49,6 @@
;;; Code: ;;; Code:
(require 'time-date) ; for `with-decoded-time-value'
(defgroup proced nil (defgroup proced nil
"Proced mode." "Proced mode."
:group 'processes :group 'processes
@ -1186,17 +1184,8 @@ Return nil otherwise."
(defun proced-time-lessp (t1 t2) (defun proced-time-lessp (t1 t2)
"Return t if time value T1 is less than time value T2. "Return t if time value T1 is less than time value T2.
Return `equal' if T1 equals T2. Return nil otherwise." Return `equal' if T1 equals T2. Return nil otherwise."
(with-decoded-time-value ((high1 low1 micro1 pico1 type1 t1) (or (time-less-p t1 t2)
(high2 low2 micro2 pico2 type2 t2)) (if (not (time-less-p t2 t1)) 'equal)))
(cond ((< high1 high2))
((< high2 high1) nil)
((< low1 low2))
((< low2 low1) nil)
((< micro1 micro2))
((< micro2 micro1) nil)
((< pico1 pico2))
((< pico2 pico1) nil)
(t 'equal))))
;;; Sorting ;;; Sorting

10
lisp/timezone.el
View file

@ -295,13 +295,9 @@ Gregorian date Sunday, December 31, 1 BC."
;; (timezone-absolute-from-gregorian 1 1 1970) ;; (timezone-absolute-from-gregorian 1 1 1970)
(days (- date current-time-origin)) (days (- date current-time-origin))
(seconds-per-day (float 86400)) (seconds-per-day (float 86400))
(seconds (+ seconds (* days seconds-per-day))) (day-seconds (* days seconds-per-day)))
(current-time-arithmetic-base (float 65536)) (condition-case nil (time-add day-seconds seconds)
(hi (floor (/ seconds current-time-arithmetic-base))) (range-error))))
(hibase (* hi current-time-arithmetic-base))
(lo (floor (- seconds hibase))))
(and (< (abs (- seconds (+ hibase lo))) 2) ;; Check for integer overflow.
(cons hi lo))))
(defun timezone-time-zone-from-absolute (date seconds) (defun timezone-time-zone-from-absolute (date seconds)
"Compute the local time zone for DATE at time SECONDS after midnight. "Compute the local time zone for DATE at time SECONDS after midnight.

17
lisp/type-break.el
View file

@ -604,8 +604,7 @@ INTERVAL is the full length of an interval (defaults to TIME)."
(type-break-time-warning-schedule time 'reset) (type-break-time-warning-schedule time 'reset)
(type-break-run-at-time (max 1 time) nil 'type-break-alarm) (type-break-run-at-time (max 1 time) nil 'type-break-alarm)
(setq type-break-time-next-break (setq type-break-time-next-break
(type-break-time-sum (or start (current-time)) (type-break-time-sum start (or interval time))))
(or interval time))))
(defun type-break-cancel-schedule () (defun type-break-cancel-schedule ()
(type-break-cancel-time-warning-schedule) (type-break-cancel-time-warning-schedule)
@ -961,19 +960,11 @@ FRAC should be the inverse of the fractional value; for example, a value of
(defun type-break-time-difference (a b) (defun type-break-time-difference (a b)
(round (float-time (time-subtract b a)))) (round (float-time (time-subtract b a))))
;; Return (in a new list the same in structure to that returned by ;; Return a time value that is the sum of the time-value arguments.
;; `current-time') the sum of the arguments. Each argument may be a time
;; list or a single integer, a number of seconds.
;; This function keeps the high and low 16 bits of the seconds properly
;; balanced so that the lower value never exceeds 16 bits. Otherwise, when
;; the result is passed to `current-time-string' it will toss some of the
;; "low" bits and format the time incorrectly.
(defun type-break-time-sum (&rest tmlist) (defun type-break-time-sum (&rest tmlist)
(let ((sum '(0 0 0))) (let ((sum '(0 0)))
(dolist (tem tmlist) (dolist (tem tmlist)
(setq sum (time-add sum (if (integerp tem) (setq sum (time-add sum tem)))
(list (floor tem 65536) (mod tem 65536))
tem))))
sum)) sum))
(defun type-break-time-stamp (&optional when) (defun type-break-time-stamp (&optional when)

28
src/ChangeLog
View file

@ -1,3 +1,31 @@
2014-11-17 Paul Eggert <eggert@cs.ucla.edu>
Improve time stamp handling, and be more consistent about it.
* editfns.c (invalid_time): New function.
Use it instead of 'error ("Invalid time specification")'.
(time_add, time_subtract, time_arith, Ftime_add, Ftime_less_p)
(decode_float_time, lisp_to_timespec, lisp_time_struct):
New functions.
(make_time_tail, make_time): Remove. All uses changed to use
new functions or plain list4i.
(disassemble_lisp_time): Return effective length if successful.
Check that LOW is an integer, if it's combined with other components.
(decode_time_components): Decode into struct lisp_time, not
struct timespec, so that we can support a wide set of times
regardless of whether time_t is signed. Decode plain numbers
as seconds since the Epoch, and nil as the current time.
(lisp_time_argument, lisp_seconds_argument, Ffloat_time):
Reimplement in terms of new functions.
(Fencode_time): Just use list2i.
(syms_of_editfns): Add time-add, time-subtract, time-less-p.
* keyboard.c (decode_timer): Don't allow the new formats (floating
point or nil) in timers.
* systime.h (LO_TIME_BITS): New constant. Use it everywhere in
place of the magic number '16'.
(struct lisp_time): New type.
(decode_time_components): Use it.
(lisp_to_timespec): New decl.
2014-11-16 Lars Magne Ingebrigtsen <larsi@gnus.org> 2014-11-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
* intervals.h (INTERVAL_WRITABLE_P): Check the `inhibit-read-only' * intervals.h (INTERVAL_WRITABLE_P): Check the `inhibit-read-only'

368
src/editfns.c
View file

@ -64,6 +64,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
extern Lisp_Object w32_get_internal_run_time (void); extern Lisp_Object w32_get_internal_run_time (void);
#endif #endif
static struct lisp_time lisp_time_struct (Lisp_Object, int *);
static void set_time_zone_rule (char const *); static void set_time_zone_rule (char const *);
static Lisp_Object format_time_string (char const *, ptrdiff_t, struct timespec, static Lisp_Object format_time_string (char const *, ptrdiff_t, struct timespec,
bool, struct tm *); bool, struct tm *);
@ -1392,6 +1393,12 @@ time_overflow (void)
error ("Specified time is not representable"); error ("Specified time is not representable");
} }
static void
invalid_time (void)
{
error ("Invalid time specification");
}
/* A substitute for mktime_z on platforms that lack it. It's not /* A substitute for mktime_z on platforms that lack it. It's not
thread-safe, but should be good enough for Emacs in typical use. */ thread-safe, but should be good enough for Emacs in typical use. */
#ifndef HAVE_TZALLOC #ifndef HAVE_TZALLOC
@ -1420,26 +1427,26 @@ mktime_z (timezone_t tz, struct tm *tm)
static EMACS_INT static EMACS_INT
hi_time (time_t t) hi_time (time_t t)
{ {
time_t hi = t >> 16; time_t hi = t >> LO_TIME_BITS;
/* Check for overflow, helping the compiler for common cases where /* Check for overflow, helping the compiler for common cases where
no runtime check is needed, and taking care not to convert no runtime check is needed, and taking care not to convert
negative numbers to unsigned before comparing them. */ negative numbers to unsigned before comparing them. */
if (! ((! TYPE_SIGNED (time_t) if (! ((! TYPE_SIGNED (time_t)
|| MOST_NEGATIVE_FIXNUM <= TIME_T_MIN >> 16 || MOST_NEGATIVE_FIXNUM <= TIME_T_MIN >> LO_TIME_BITS
|| MOST_NEGATIVE_FIXNUM <= hi) || MOST_NEGATIVE_FIXNUM <= hi)
&& (TIME_T_MAX >> 16 <= MOST_POSITIVE_FIXNUM && (TIME_T_MAX >> LO_TIME_BITS <= MOST_POSITIVE_FIXNUM
|| hi <= MOST_POSITIVE_FIXNUM))) || hi <= MOST_POSITIVE_FIXNUM)))
time_overflow (); time_overflow ();
return hi; return hi;
} }
/* Return the bottom 16 bits of the time T. */ /* Return the bottom bits of the time T. */
static int static int
lo_time (time_t t) lo_time (time_t t)
{ {
return t & ((1 << 16) - 1); return t & ((1 << LO_TIME_BITS) - 1);
} }
DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0, DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0,
@ -1453,6 +1460,96 @@ picosecond counts. */)
return make_lisp_time (current_timespec ()); return make_lisp_time (current_timespec ());
} }
static struct lisp_time
time_add (struct lisp_time ta, struct lisp_time tb)
{
EMACS_INT hi = ta.hi + tb.hi;
int lo = ta.lo + tb.lo;
int us = ta.us + tb.us;
int ps = ta.ps + tb.ps;
us += (1000000 <= ps);
ps -= (1000000 <= ps) * 1000000;
lo += (1000000 <= us);
us -= (1000000 <= us) * 1000000;
hi += (1 << LO_TIME_BITS <= lo);
lo -= (1 << LO_TIME_BITS <= lo) << LO_TIME_BITS;
return (struct lisp_time) { hi, lo, us, ps };
}
static struct lisp_time
time_subtract (struct lisp_time ta, struct lisp_time tb)
{
EMACS_INT hi = ta.hi - tb.hi;
int lo = ta.lo - tb.lo;
int us = ta.us - tb.us;
int ps = ta.ps - tb.ps;
us -= (ps < 0);
ps += (ps < 0) * 1000000;
lo -= (us < 0);
us += (us < 0) * 1000000;
hi -= (lo < 0);
lo += (lo < 0) << LO_TIME_BITS;
return (struct lisp_time) { hi, lo, us, ps };
}
static Lisp_Object
time_arith (Lisp_Object a, Lisp_Object b,
struct lisp_time (*op) (struct lisp_time, struct lisp_time))
{
int alen, blen;
struct lisp_time ta = lisp_time_struct (a, &alen);
struct lisp_time tb = lisp_time_struct (b, &blen);
struct lisp_time t = op (ta, tb);
if (! (MOST_NEGATIVE_FIXNUM <= t.hi && t.hi <= MOST_POSITIVE_FIXNUM))
time_overflow ();
Lisp_Object val = Qnil;
switch (max (alen, blen))
{
default:
val = Fcons (make_number (t.ps), val);
/* Fall through. */
case 3:
val = Fcons (make_number (t.us), val);
/* Fall through. */
case 2:
val = Fcons (make_number (t.lo), val);
val = Fcons (make_number (t.hi), val);
break;
}
return val;
}
DEFUN ("time-add", Ftime_add, Stime_add, 2, 2, 0,
doc: /* Return the sum of two time values A and B, as a time value. */)
(Lisp_Object a, Lisp_Object b)
{
return time_arith (a, b, time_add);
}
DEFUN ("time-subtract", Ftime_subtract, Stime_subtract, 2, 2, 0,
doc: /* Return the difference between two time values A and B, as a time value. */)
(Lisp_Object a, Lisp_Object b)
{
return time_arith (a, b, time_subtract);
}
DEFUN ("time-less-p", Ftime_less_p, Stime_less_p, 2, 2, 0,
doc: /* Return non-nil if time value T1 is earlier than time value T2. */)
(Lisp_Object t1, Lisp_Object t2)
{
int t1len, t2len;
struct lisp_time a = lisp_time_struct (t1, &t1len);
struct lisp_time b = lisp_time_struct (t2, &t2len);
return ((a.hi != b.hi ? a.hi < b.hi
: a.lo != b.lo ? a.lo < b.lo
: a.us != b.us ? a.us < b.us
: a.ps < b.ps)
? Qt : Qnil);
}
DEFUN ("get-internal-run-time", Fget_internal_run_time, Sget_internal_run_time, DEFUN ("get-internal-run-time", Fget_internal_run_time, Sget_internal_run_time,
0, 0, 0, 0, 0, 0,
doc: /* Return the current run time used by Emacs. doc: /* Return the current run time used by Emacs.
@ -1491,21 +1588,6 @@ does the same thing as `current-time'. */)
} }
/* Make a Lisp list that represents the time T with fraction TAIL. */
static Lisp_Object
make_time_tail (time_t t, Lisp_Object tail)
{
return Fcons (make_number (hi_time (t)),
Fcons (make_number (lo_time (t)), tail));
}
/* Make a Lisp list that represents the system time T. */
static Lisp_Object
make_time (time_t t)
{
return make_time_tail (t, Qnil);
}
/* Make a Lisp list that represents the Emacs time T. T may be an /* Make a Lisp list that represents the Emacs time T. T may be an
invalid time, with a slightly negative tv_nsec value such as invalid time, with a slightly negative tv_nsec value such as
UNKNOWN_MODTIME_NSECS; in that case, the Lisp list contains a UNKNOWN_MODTIME_NSECS; in that case, the Lisp list contains a
@ -1513,23 +1595,30 @@ make_time (time_t t)
Lisp_Object Lisp_Object
make_lisp_time (struct timespec t) make_lisp_time (struct timespec t)
{ {
time_t s = t.tv_sec;
int ns = t.tv_nsec; int ns = t.tv_nsec;
return make_time_tail (t.tv_sec, list2i (ns / 1000, ns % 1000 * 1000)); return list4i (hi_time (s), lo_time (s), ns / 1000, ns % 1000 * 1000);
} }
/* Decode a Lisp list SPECIFIED_TIME that represents a time. /* Decode a Lisp list SPECIFIED_TIME that represents a time.
Set *PHIGH, *PLOW, *PUSEC, *PPSEC to its parts; do not check their values. Set *PHIGH, *PLOW, *PUSEC, *PPSEC to its parts; do not check their values.
Return true if successful. */ Return 2, 3, or 4 to indicate the effective length of SPECIFIED_TIME
static bool if successful, 0 if unsuccessful. */
static int
disassemble_lisp_time (Lisp_Object specified_time, Lisp_Object *phigh, disassemble_lisp_time (Lisp_Object specified_time, Lisp_Object *phigh,
Lisp_Object *plow, Lisp_Object *pusec, Lisp_Object *plow, Lisp_Object *pusec,
Lisp_Object *ppsec) Lisp_Object *ppsec)
{ {
Lisp_Object high = make_number (0);
Lisp_Object low = specified_time;
Lisp_Object usec = make_number (0);
Lisp_Object psec = make_number (0);
int len = 4;
if (CONSP (specified_time)) if (CONSP (specified_time))
{ {
Lisp_Object low = XCDR (specified_time); high = XCAR (specified_time);
Lisp_Object usec = make_number (0); low = XCDR (specified_time);
Lisp_Object psec = make_number (0);
if (CONSP (low)) if (CONSP (low))
{ {
Lisp_Object low_tail = XCDR (low); Lisp_Object low_tail = XCDR (low);
@ -1540,40 +1629,119 @@ disassemble_lisp_time (Lisp_Object specified_time, Lisp_Object *phigh,
low_tail = XCDR (low_tail); low_tail = XCDR (low_tail);
if (CONSP (low_tail)) if (CONSP (low_tail))
psec = XCAR (low_tail); psec = XCAR (low_tail);
else
len = 3;
} }
else if (!NILP (low_tail)) else if (!NILP (low_tail))
usec = low_tail; {
usec = low_tail;
len = 3;
}
else
len = 2;
} }
else
len = 2;
*phigh = XCAR (specified_time); /* When combining components, require LOW to be an integer,
*plow = low; as otherwise it would be a pain to add up times. */
*pusec = usec; if (! INTEGERP (low))
*ppsec = psec; return 0;
return 1;
} }
else if (INTEGERP (specified_time))
len = 2;
return 0; *phigh = high;
*plow = low;
*pusec = usec;
*ppsec = psec;
return len;
}
/* Convert T into an Emacs time *RESULT, truncating toward minus infinity.
Return true if T is in range, false otherwise. */
static bool
decode_float_time (double t, struct lisp_time *result)
{
double lo_multiplier = 1 << LO_TIME_BITS;
double emacs_time_min = MOST_NEGATIVE_FIXNUM * lo_multiplier;
if (! (emacs_time_min <= t && t < -emacs_time_min))
return false;
double small_t = t / lo_multiplier;
EMACS_INT hi = small_t;
double t_sans_hi = t - hi * lo_multiplier;
int lo = t_sans_hi;
long double fracps = (t_sans_hi - lo) * 1e12L;
#ifdef INT_FAST64_MAX
int_fast64_t ifracps = fracps;
int us = ifracps / 1000000;
int ps = ifracps % 1000000;
#else
int us = fracps / 1e6L;
int ps = fracps - us * 1e6L;
#endif
us -= (ps < 0);
ps += (ps < 0) * 1000000;
lo -= (us < 0);
us += (us < 0) * 1000000;
hi -= (lo < 0);
lo += (lo < 0) << LO_TIME_BITS;
result->hi = hi;
result->lo = lo;
result->us = us;
result->ps = ps;
return true;
} }
/* From the time components HIGH, LOW, USEC and PSEC taken from a Lisp /* From the time components HIGH, LOW, USEC and PSEC taken from a Lisp
list, generate the corresponding time value. list, generate the corresponding time value.
If LOW is floating point, the other components should be zero.
If RESULT is not null, store into *RESULT the converted time; If RESULT is not null, store into *RESULT the converted time.
if the converted time does not fit into struct timespec,
store an invalid timespec to indicate the overflow.
If *DRESULT is not null, store into *DRESULT the number of If *DRESULT is not null, store into *DRESULT the number of
seconds since the start of the POSIX Epoch. seconds since the start of the POSIX Epoch.
Return true if successful. */ Return true if successful, false if the components are of the
wrong type or represent a time out of range. */
bool bool
decode_time_components (Lisp_Object high, Lisp_Object low, Lisp_Object usec, decode_time_components (Lisp_Object high, Lisp_Object low, Lisp_Object usec,
Lisp_Object psec, Lisp_Object psec,
struct timespec *result, double *dresult) struct lisp_time *result, double *dresult)
{ {
EMACS_INT hi, lo, us, ps; EMACS_INT hi, lo, us, ps;
if (! (INTEGERP (high) && INTEGERP (low) if (! (INTEGERP (high)
&& INTEGERP (usec) && INTEGERP (psec))) && INTEGERP (usec) && INTEGERP (psec)))
return false; return false;
if (! INTEGERP (low))
{
if (FLOATP (low))
{
double t = XFLOAT_DATA (low);
if (result && ! decode_float_time (t, result))
return false;
if (dresult)
*dresult = t;
return true;
}
else if (NILP (low))
{
struct timespec now = current_timespec ();
if (result)
{
result->hi = hi_time (now.tv_sec);
result->lo = lo_time (now.tv_sec);
result->us = now.tv_nsec / 1000;
result->ps = now.tv_nsec % 1000 * 1000;
}
if (dresult)
*dresult = now.tv_sec + now.tv_nsec / 1e9;
return true;
}
else
return false;
}
hi = XINT (high); hi = XINT (high);
lo = XINT (low); lo = XINT (low);
us = XINT (usec); us = XINT (usec);
@ -1583,53 +1751,68 @@ decode_time_components (Lisp_Object high, Lisp_Object low, Lisp_Object usec,
each overflow into the next higher-order component. */ each overflow into the next higher-order component. */
us += ps / 1000000 - (ps % 1000000 < 0); us += ps / 1000000 - (ps % 1000000 < 0);
lo += us / 1000000 - (us % 1000000 < 0); lo += us / 1000000 - (us % 1000000 < 0);
hi += lo >> 16; hi += lo >> LO_TIME_BITS;
ps = ps % 1000000 + 1000000 * (ps % 1000000 < 0); ps = ps % 1000000 + 1000000 * (ps % 1000000 < 0);
us = us % 1000000 + 1000000 * (us % 1000000 < 0); us = us % 1000000 + 1000000 * (us % 1000000 < 0);
lo &= (1 << 16) - 1; lo &= (1 << LO_TIME_BITS) - 1;
if (result) if (result)
{ {
if ((TYPE_SIGNED (time_t) ? TIME_T_MIN >> 16 <= hi : 0 <= hi) if (! (MOST_NEGATIVE_FIXNUM <= hi && hi <= MOST_POSITIVE_FIXNUM))
&& hi <= TIME_T_MAX >> 16) return false;
{ result->hi = hi;
/* Return the greatest representable time that is not greater result->lo = lo;
than the requested time. */ result->us = us;
time_t sec = hi; result->ps = ps;
*result = make_timespec ((sec << 16) + lo, us * 1000 + ps / 1000);
}
else
*result = invalid_timespec ();
} }
if (dresult) if (dresult)
*dresult = (us * 1e6 + ps) / 1e12 + lo + hi * 65536.0; {
double dhi = hi;
*dresult = (us * 1e6 + ps) / 1e12 + lo + dhi * (1 << LO_TIME_BITS);
}
return true; return true;
} }
/* Decode a Lisp list SPECIFIED_TIME that represents a time. struct timespec
If SPECIFIED_TIME is nil, use the current time. lisp_to_timespec (struct lisp_time t)
{
if (! ((TYPE_SIGNED (time_t) ? TIME_T_MIN >> LO_TIME_BITS <= t.hi : 0 <= t.hi)
&& t.hi <= TIME_T_MAX >> LO_TIME_BITS))
return invalid_timespec ();
time_t s = (t.hi << LO_TIME_BITS) + t.lo;
int ns = t.us * 1000 + t.ps / 1000;
return make_timespec (s, ns);
}
Round the time down to the nearest struct timespec value. /* Decode a Lisp list SPECIFIED_TIME that represents a time.
Return seconds since the Epoch. Store its effective length into *PLEN.
Signal an error if unsuccessful. */ If SPECIFIED_TIME is nil, use the current time.
Signal an error if SPECIFIED_TIME does not represent a time. */
static struct lisp_time
lisp_time_struct (Lisp_Object specified_time, int *plen)
{
Lisp_Object high, low, usec, psec;
struct lisp_time t;
int len = disassemble_lisp_time (specified_time, &high, &low, &usec, &psec);
if (! (len && decode_time_components (high, low, usec, psec, &t, 0)))
invalid_time ();
*plen = len;
return t;
}
/* Like lisp_time_struct, except return a struct timespec.
Discard any low-order digits. */
struct timespec struct timespec
lisp_time_argument (Lisp_Object specified_time) lisp_time_argument (Lisp_Object specified_time)
{ {
if (NILP (specified_time)) int len;
return current_timespec (); struct lisp_time lt = lisp_time_struct (specified_time, &len);
else struct timespec t = lisp_to_timespec (lt);
{ if (! timespec_valid_p (t))
Lisp_Object high, low, usec, psec; time_overflow ();
struct timespec t; return t;
if (! (disassemble_lisp_time (specified_time, &high, &low, &usec, &psec)
&& decode_time_components (high, low, usec, psec, &t, 0)))
error ("Invalid time specification");
if (! timespec_valid_p (t))
time_overflow ();
return t;
}
} }
/* Like lisp_time_argument, except decode only the seconds part, /* Like lisp_time_argument, except decode only the seconds part,
@ -1637,20 +1820,16 @@ lisp_time_argument (Lisp_Object specified_time)
static time_t static time_t
lisp_seconds_argument (Lisp_Object specified_time) lisp_seconds_argument (Lisp_Object specified_time)
{ {
if (NILP (specified_time)) Lisp_Object high, low, usec, psec;
return time (NULL); struct lisp_time t;
else if (! (disassemble_lisp_time (specified_time, &high, &low, &usec, &psec)
{ && decode_time_components (high, low, make_number (0),
Lisp_Object high, low, usec, psec; make_number (0), &t, 0)))
struct timespec t; invalid_time ();
if (! (disassemble_lisp_time (specified_time, &high, &low, &usec, &psec) if (! ((TYPE_SIGNED (time_t) ? TIME_T_MIN >> LO_TIME_BITS <= t.hi : 0 <= t.hi)
&& decode_time_components (high, low, make_number (0), && t.hi <= TIME_T_MAX >> LO_TIME_BITS))
make_number (0), &t, 0))) time_overflow ();
error ("Invalid time specification"); return (t.hi << LO_TIME_BITS) + t.lo;
if (! timespec_valid_p (t))
time_overflow ();
return t.tv_sec;
}
} }
DEFUN ("float-time", Ffloat_time, Sfloat_time, 0, 1, 0, DEFUN ("float-time", Ffloat_time, Sfloat_time, 0, 1, 0,
@ -1668,18 +1847,10 @@ or (if you need time as a string) `format-time-string'. */)
(Lisp_Object specified_time) (Lisp_Object specified_time)
{ {
double t; double t;
if (NILP (specified_time)) Lisp_Object high, low, usec, psec;
{ if (! (disassemble_lisp_time (specified_time, &high, &low, &usec, &psec)
struct timespec now = current_timespec (); && decode_time_components (high, low, usec, psec, 0, &t)))
t = now.tv_sec + now.tv_nsec / 1e9; invalid_time ();
}
else
{
Lisp_Object high, low, usec, psec;
if (! (disassemble_lisp_time (specified_time, &high, &low, &usec, &psec)
&& decode_time_components (high, low, usec, psec, 0, &t)))
error ("Invalid time specification");
}
return make_float (t); return make_float (t);
} }
@ -1969,7 +2140,7 @@ usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */)
if (value == (time_t) -1) if (value == (time_t) -1)
time_overflow (); time_overflow ();
return make_time (value); return list2i (hi_time (value), lo_time (value));
} }
DEFUN ("current-time-string", Fcurrent_time_string, Scurrent_time_string, 0, 1, 0, DEFUN ("current-time-string", Fcurrent_time_string, Scurrent_time_string, 0, 1, 0,
@ -4874,6 +5045,9 @@ functions if all the text being accessed has this property. */);
defsubr (&Suser_full_name); defsubr (&Suser_full_name);
defsubr (&Semacs_pid); defsubr (&Semacs_pid);
defsubr (&Scurrent_time); defsubr (&Scurrent_time);
defsubr (&Stime_add);
defsubr (&Stime_subtract);
defsubr (&Stime_less_p);
defsubr (&Sget_internal_run_time); defsubr (&Sget_internal_run_time);
defsubr (&Sformat_time_string); defsubr (&Sformat_time_string);
defsubr (&Sfloat_time); defsubr (&Sfloat_time);

11
src/keyboard.c
View file

@ -4429,10 +4429,15 @@ decode_timer (Lisp_Object timer, struct timespec *result)
vector = XVECTOR (timer)->contents; vector = XVECTOR (timer)->contents;
if (! NILP (vector[0])) if (! NILP (vector[0]))
return 0; return 0;
if (! INTEGERP (vector[2]))
return false;
return (decode_time_components (vector[1], vector[2], vector[3], vector[8], struct lisp_time t;
result, 0) if (! decode_time_components (vector[1], vector[2], vector[3], vector[8],
&& timespec_valid_p (*result)); &t, 0))
return false;
*result = lisp_to_timespec (t);
return timespec_valid_p (*result);
} }

15
src/systime.h
View file

@ -86,10 +86,23 @@ extern void set_waiting_for_input (struct timespec *);
happen when this files is used outside the src directory). happen when this files is used outside the src directory).
Use GCPRO1 to determine if lisp.h was included. */ Use GCPRO1 to determine if lisp.h was included. */
#ifdef GCPRO1 #ifdef GCPRO1
/* Emacs uses the integer list (HI LO US PS) to represent the time
(HI << LO_TIME_BITS) + LO + US / 1e6 + PS / 1e12. */
enum { LO_TIME_BITS = 16 };
/* A Lisp time (HI LO US PS), sans the cons cells. */
struct lisp_time
{
EMACS_INT hi;
int lo, us, ps;
};
/* defined in editfns.c */ /* defined in editfns.c */
extern Lisp_Object make_lisp_time (struct timespec); extern Lisp_Object make_lisp_time (struct timespec);
extern bool decode_time_components (Lisp_Object, Lisp_Object, Lisp_Object, extern bool decode_time_components (Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object, struct timespec *, double *); Lisp_Object, struct lisp_time *, double *);
extern struct timespec lisp_to_timespec (struct lisp_time);
extern struct timespec lisp_time_argument (Lisp_Object); extern struct timespec lisp_time_argument (Lisp_Object);
#endif #endif