aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorPaul Eggert2018-10-03 09:10:01 -0700
committerPaul Eggert2018-10-06 23:31:04 -0700
commit93fe420942c08111a6048af7c4d7807c61d80a09 (patch)
tree9ec406b06d09cde9573e757574e9e626e86d7a77 /src
parent84f39d3389209e566dde9acbdd78f5572f0c6751 (diff)
downloademacs-93fe420942c08111a6048af7c4d7807c61d80a09.tar.gz
emacs-93fe420942c08111a6048af7c4d7807c61d80a09.zip
New (TICKS . HZ) timestamp format
This follows on a suggestion by Stefan Monnier in: https://lists.gnu.org/r/emacs-devel/2018-08/msg00991.html (Bug#32902). * doc/lispref/buffers.texi (Modification Time): * doc/lispref/os.texi (Processor Run Time, Time Calculations) * doc/lispref/processes.texi (System Processes): * doc/lispref/text.texi (Undo): Let the "Time of Day" section cover timestamp format details. * doc/lispref/os.texi (Time of Day): Say that timestamp internal format should not be assumed. Document new (ticks . hz) format. Omit mention of seconds-to-time since it is now just an alias for encode-time. (Time Conversion): Document encode-time extension. * etc/NEWS: Mention changes. * lisp/calendar/cal-dst.el (calendar-system-time-basis): Now const. * lisp/calendar/cal-dst.el (calendar-absolute-from-time) (calendar-time-from-absolute) (calendar-next-time-zone-transition): * lisp/emacs-lisp/timer.el (timer-next-integral-multiple-of-time): Simplify by using bignums, (TICKS . HZ), and new encode-time. * lisp/emacs-lisp/timer.el (timer-next-integral-multiple-of-time): Simplify by using bignums and new encode-time. * lisp/calendar/parse-time.el (parse-iso8601-time-string): Handle DST more accurately, by using new encode-time. * lisp/calendar/time-date.el (seconds-to-time): * lisp/calendar/timeclock.el (timeclock-seconds-to-time): Now just an alias for encode-time. * lisp/calendar/time-date.el (days-to-time): * lisp/emacs-lisp/timer.el (timer--time-setter): * lisp/net/ntlm.el (ntlm-compute-timestamp): * lisp/obsolete/vc-arch.el (vc-arch-add-tagline): * lisp/org/org-id.el (org-id-uuid, org-id-time-to-b36): * lisp/tar-mode (tar-octal-time): Don't assume timestamps default to list form. * lisp/tar-mode.el (tar-parse-octal-long-integer): Now an obsolete alias for tar-parse-octal-integer. * src/keyboard.c (decode_timer): Adjust to changes to time decoding functions elsewhere. * src/timefns.c: Include bignum.h, limits.h. (FASTER_TIMEFNS): New macro. (WARN_OBSOLETE_TIMESTAMPS, CURRENT_TIME_LIST) (timespec_hz, trillion, ztrillion): New constants. (make_timeval): Use TIME_T_MAX instead of its definiens. (check_time_validity, time_add, time_subtract): Remove. All uses removed. (disassemble_lisp_time): Remove; old code now folded into decode_lisp_time. All callers changed. (invalid_hz, s_ns_to_double, ticks_hz_list4, mpz_set_time) (timespec_mpz, timespec_ticks, time_hz_ticks) (lisp_time_hz_ticks, lisp_time_seconds) (time_form_stamp, lisp_time_form_stamp, decode_ticks_hz) (decode_lisp_time, mpz_time, list4_to_timespec): New functions. (decode_float_time, decode_time_components, lisp_to_timespec): Adjust to new struct lisp_time, which does not lose information like the old one did. (enum timeform): New enum. (decode_time_components): New arg FORM. All callers changed. RESULT and DRESULT are now mutually exclusive; no callers need to change because of this. (decode_time_components, lisp_time_struct) (lisp_seconds_argument, time_arith, make_lisp_time, Ffloat_time) (Fencode_time): Add support for (TICKS . HZ) form. (DECODE_SECS_ONLY): New constant. (lisp_time_struct): 2nd arg is now enum timeform, not int. All callers changed. (check_tm_member): Support bignums.m (Fencode_time): Add new two-arg functionality. * src/systime.h (struct lisp_time): Now ticks+hz rather than hi+lo+us+ps, since ticks+hz does not lose info. * test/src/systime-tests.el (time-equal-p-nil-nil): New test.
Diffstat (limited to 'src')
-rw-r--r--src/bignum.c2
-rw-r--r--src/keyboard.c11
-rw-r--r--src/systime.h15
-rw-r--r--src/timefns.c1137
4 files changed, 810 insertions, 355 deletions
diff --git a/src/bignum.c b/src/bignum.c
index 5d8ab670f24..0ab8de3ab7a 100644
--- a/src/bignum.c
+++ b/src/bignum.c
@@ -31,7 +31,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
31 storage is exhausted. Admittedly this is not ideal. An mpz value 31 storage is exhausted. Admittedly this is not ideal. An mpz value
32 in a temporary is made permanent by mpz_swapping it with a bignum's 32 in a temporary is made permanent by mpz_swapping it with a bignum's
33 value. Although typically at most two temporaries are needed, 33 value. Although typically at most two temporaries are needed,
34 rounding_driver and rounddiv_q need four altogther. */ 34 time_arith, rounddiv_q and rounding_driver each need four. */
35 35
36mpz_t mpz[4]; 36mpz_t mpz[4];
37 37
diff --git a/src/keyboard.c b/src/keyboard.c
index 35d74f4a795..8ea15d3c890 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -4163,18 +4163,13 @@ decode_timer (Lisp_Object timer, struct timespec *result)
4163 Lisp_Object *vec; 4163 Lisp_Object *vec;
4164 4164
4165 if (! (VECTORP (timer) && ASIZE (timer) == 9)) 4165 if (! (VECTORP (timer) && ASIZE (timer) == 9))
4166 return 0; 4166 return false;
4167 vec = XVECTOR (timer)->contents; 4167 vec = XVECTOR (timer)->contents;
4168 if (! NILP (vec[0])) 4168 if (! NILP (vec[0]))
4169 return 0;
4170 if (! FIXNUMP (vec[2]))
4171 return false; 4169 return false;
4172 4170 if (! FIXNUMP (vec[2]))
4173 struct lisp_time t;
4174 if (decode_time_components (vec[1], vec[2], vec[3], vec[8], &t, 0) <= 0)
4175 return false; 4171 return false;
4176 *result = lisp_to_timespec (t); 4172 return list4_to_timespec (vec[1], vec[2], vec[3], vec[8], result);
4177 return timespec_valid_p (*result);
4178} 4173}
4179 4174
4180 4175
diff --git a/src/systime.h b/src/systime.h
index f2f51b009e2..0bc1e90fb05 100644
--- a/src/systime.h
+++ b/src/systime.h
@@ -75,19 +75,22 @@ extern void set_waiting_for_input (struct timespec *);
75 (HI << LO_TIME_BITS) + LO + US / 1e6 + PS / 1e12. */ 75 (HI << LO_TIME_BITS) + LO + US / 1e6 + PS / 1e12. */
76enum { LO_TIME_BITS = 16 }; 76enum { LO_TIME_BITS = 16 };
77 77
78/* A Lisp time (HI LO US PS), sans the cons cells. */ 78/* Components of a new-format Lisp timestamp. */
79struct lisp_time 79struct lisp_time
80{ 80{
81 EMACS_INT hi; 81 /* Clock count as a Lisp integer. */
82 int lo, us, ps; 82 Lisp_Object ticks;
83
84 /* Clock frequency (ticks per second) as a positive Lisp integer.
85 (TICKS . HZ) is a valid Lisp timestamp unless HZ < 65536. */
86 Lisp_Object hz;
83}; 87};
84 88
85/* defined in timefns.c */ 89/* defined in timefns.c */
86extern struct timeval make_timeval (struct timespec) ATTRIBUTE_CONST; 90extern struct timeval make_timeval (struct timespec) ATTRIBUTE_CONST;
87extern Lisp_Object make_lisp_time (struct timespec); 91extern Lisp_Object make_lisp_time (struct timespec);
88extern int decode_time_components (Lisp_Object, Lisp_Object, Lisp_Object, 92extern bool list4_to_timespec (Lisp_Object, Lisp_Object, Lisp_Object,
89 Lisp_Object, struct lisp_time *, double *); 93 Lisp_Object, struct timespec *);
90extern struct timespec lisp_to_timespec (struct lisp_time);
91extern struct timespec lisp_time_argument (Lisp_Object); 94extern struct timespec lisp_time_argument (Lisp_Object);
92extern _Noreturn void time_overflow (void); 95extern _Noreturn void time_overflow (void);
93extern void init_timefns (bool); 96extern void init_timefns (bool);
diff --git a/src/timefns.c b/src/timefns.c
index fcb4485ae30..72cb54d3a0c 100644
--- a/src/timefns.c
+++ b/src/timefns.c
@@ -22,12 +22,14 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
22#include "systime.h" 22#include "systime.h"
23 23
24#include "blockinput.h" 24#include "blockinput.h"
25#include "bignum.h"
25#include "coding.h" 26#include "coding.h"
26#include "lisp.h" 27#include "lisp.h"
27 28
28#include <strftime.h> 29#include <strftime.h>
29 30
30#include <errno.h> 31#include <errno.h>
32#include <limits.h>
31#include <math.h> 33#include <math.h>
32#include <stdio.h> 34#include <stdio.h>
33#include <stdlib.h> 35#include <stdlib.h>
@@ -55,6 +57,47 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
55# define TIME_T_MAX TYPE_MAXIMUM (time_t) 57# define TIME_T_MAX TYPE_MAXIMUM (time_t)
56#endif 58#endif
57 59
60/* Compile with -DFASTER_TIMEFNS=0 to disable common optimizations and
61 allow easier testing of some slow-path code. */
62#ifndef FASTER_TIMEFNS
63# define FASTER_TIMEFNS 1
64#endif
65
66/* Whether to warn about Lisp timestamps (TICKS . HZ) that may be
67 instances of obsolete-format timestamps (HI . LO) where HI is
68 the high-order bits and LO the low-order 16 bits. Currently this
69 is true, but it should change to false in a future version of
70 Emacs. Compile with -DWARN_OBSOLETE_TIMESTAMPS=0 to see what the
71 future will be like. */
72#ifndef WARN_OBSOLETE_TIMESTAMPS
73enum { WARN_OBSOLETE_TIMESTAMPS = true };
74#endif
75
76/* Although current-time etc. generate list-format timestamps
77 (HI LO US PS), the plan is to change these functions to generate
78 frequency-based timestamps (TICKS . HZ) in a future release.
79 To try this now, compile with -DCURRENT_TIME_LIST=0. */
80#ifndef CURRENT_TIME_LIST
81enum { CURRENT_TIME_LIST = true };
82#endif
83
84#if FIXNUM_OVERFLOW_P (1000000000)
85static Lisp_Object timespec_hz;
86#else
87# define timespec_hz make_fixnum (TIMESPEC_HZ)
88#endif
89
90#define TRILLION 1000000000000
91#if FIXNUM_OVERFLOW_P (TRILLION)
92static Lisp_Object trillion;
93# define ztrillion (XBIGNUM (trillion)->value)
94#else
95# define trillion make_fixnum (TRILLION)
96# if ULONG_MAX < TRILLION || !FASTER_TIMEFNS
97mpz_t ztrillion;
98# endif
99#endif
100
58/* Return a struct timeval that is roughly equivalent to T. 101/* Return a struct timeval that is roughly equivalent to T.
59 Use the least timeval not less than T. 102 Use the least timeval not less than T.
60 Return an extremal value if the result would overflow. */ 103 Return an extremal value if the result would overflow. */
@@ -69,7 +112,7 @@ make_timeval (struct timespec t)
69 { 112 {
70 if (tv.tv_usec < 999999) 113 if (tv.tv_usec < 999999)
71 tv.tv_usec++; 114 tv.tv_usec++;
72 else if (tv.tv_sec < TYPE_MAXIMUM (time_t)) 115 else if (tv.tv_sec < TIME_T_MAX)
73 { 116 {
74 tv.tv_sec++; 117 tv.tv_sec++;
75 tv.tv_usec = 0; 118 tv.tv_usec = 0;
@@ -309,52 +352,430 @@ invalid_time (void)
309 error ("Invalid time specification"); 352 error ("Invalid time specification");
310} 353}
311 354
312/* Check a return value compatible with that of decode_time_components. */ 355static _Noreturn void
313static void 356invalid_hz (Lisp_Object hz)
314check_time_validity (int validity)
315{ 357{
316 if (validity <= 0) 358 xsignal2 (Qerror, build_string ("Invalid time frequency"), hz);
317 {
318 if (validity < 0)
319 time_overflow ();
320 else
321 invalid_time ();
322 }
323} 359}
324 360
325/* Return the upper part of the time T (everything but the bottom 16 bits). */ 361/* Return the upper part of the time T (everything but the bottom 16 bits). */
326static EMACS_INT 362static Lisp_Object
327hi_time (time_t t) 363hi_time (time_t t)
328{ 364{
329 time_t hi = t >> LO_TIME_BITS; 365 return INT_TO_INTEGER (t >> LO_TIME_BITS);
330 if (FIXNUM_OVERFLOW_P (hi))
331 time_overflow ();
332 return hi;
333} 366}
334 367
335/* Return the bottom bits of the time T. */ 368/* Return the bottom bits of the time T. */
336static int 369static Lisp_Object
337lo_time (time_t t) 370lo_time (time_t t)
338{ 371{
339 return t & ((1 << LO_TIME_BITS) - 1); 372 return make_fixnum (t & ((1 << LO_TIME_BITS) - 1));
340} 373}
341 374
342/* Decode a Lisp list SPECIFIED_TIME that represents a time. 375/* Convert T into an Emacs time *RESULT, truncating toward minus infinity.
343 Set *PHIGH, *PLOW, *PUSEC, *PPSEC to its parts; do not check their values. 376 Return true if T is in range, false otherwise. */
344 Return 2, 3, or 4 to indicate the effective length of SPECIFIED_TIME 377static bool
345 if successful, 0 if unsuccessful. */ 378decode_float_time (double t, struct lisp_time *result)
346static int 379{
347disassemble_lisp_time (Lisp_Object specified_time, Lisp_Object *phigh, 380 if (!isfinite (t))
348 Lisp_Object *plow, Lisp_Object *pusec, 381 return false;
349 Lisp_Object *ppsec) 382 /* Actual hz unknown; guess TIMESPEC_HZ. */
383 mpz_set_d (mpz[1], t);
384 mpz_set_si (mpz[0], floor ((t - trunc (t)) * TIMESPEC_HZ));
385 mpz_addmul_ui (mpz[0], mpz[1], TIMESPEC_HZ);
386 result->ticks = make_integer_mpz ();
387 result->hz = timespec_hz;
388 return true;
389}
390
391/* Compute S + NS/TIMESPEC_HZ as a double.
392 Calls to this function suffer from double-rounding;
393 work around some of the problem by using long double. */
394static double
395s_ns_to_double (long double s, long double ns)
396{
397 return s + ns / TIMESPEC_HZ;
398}
399
400/* Make a 4-element timestamp (HI LO US PS) from TICKS and HZ.
401 Drop any excess precision. */
402static Lisp_Object
403ticks_hz_list4 (Lisp_Object ticks, Lisp_Object hz)
404{
405 mpz_t *zticks = bignum_integer (&mpz[0], ticks);
406#if FASTER_TIMEFNS && TRILLION <= ULONG_MAX
407 mpz_mul_ui (mpz[0], *zticks, TRILLION);
408#else
409 mpz_mul (mpz[0], *zticks, ztrillion);
410#endif
411 mpz_fdiv_q (mpz[0], mpz[0], *bignum_integer (&mpz[1], hz));
412#if FASTER_TIMEFNS && TRILLION <= ULONG_MAX
413 unsigned long int fullps = mpz_fdiv_q_ui (mpz[0], mpz[0], TRILLION);
414 int us = fullps / 1000000;
415 int ps = fullps % 1000000;
416#else
417 mpz_fdiv_qr (mpz[0], mpz[1], mpz[0], ztrillion);
418 int ps = mpz_fdiv_q_ui (mpz[1], mpz[1], 1000000);
419 int us = mpz_get_ui (mpz[1]);
420#endif
421 unsigned long ulo = mpz_get_ui (mpz[0]);
422 if (mpz_sgn (mpz[0]) < 0)
423 ulo = -ulo;
424 int lo = ulo & ((1 << LO_TIME_BITS) - 1);
425 mpz_fdiv_q_2exp (mpz[0], mpz[0], LO_TIME_BITS);
426 return list4 (make_integer_mpz (), make_fixnum (lo),
427 make_fixnum (us), make_fixnum (ps));
428}
429
430/* Set ROP to T. */
431static void
432mpz_set_time (mpz_t rop, time_t t)
433{
434 if (EXPR_SIGNED (t))
435 mpz_set_intmax (rop, t);
436 else
437 mpz_set_uintmax (rop, t);
438}
439
440/* Store into mpz[0] a clock tick count for T, assuming a
441 TIMESPEC_HZ-frequency clock. Use mpz[1] as a temp. */
442static void
443timespec_mpz (struct timespec t)
444{
445 mpz_set_ui (mpz[0], t.tv_nsec);
446 mpz_set_time (mpz[1], t.tv_sec);
447 mpz_addmul_ui (mpz[0], mpz[1], TIMESPEC_HZ);
448}
449
450/* Convert T to a Lisp integer counting TIMESPEC_HZ ticks. */
451static Lisp_Object
452timespec_ticks (struct timespec t)
453{
454 intmax_t accum;
455 if (FASTER_TIMEFNS
456 && !INT_MULTIPLY_WRAPV (t.tv_sec, TIMESPEC_HZ, &accum)
457 && !INT_ADD_WRAPV (t.tv_nsec, accum, &accum))
458 return make_int (accum);
459 timespec_mpz (t);
460 return make_integer_mpz ();
461}
462
463/* Convert T to a Lisp integer counting HZ ticks, taking the floor.
464 Assume T is valid, but check HZ. */
465static Lisp_Object
466time_hz_ticks (time_t t, Lisp_Object hz)
467{
468 if (FIXNUMP (hz))
469 {
470 if (XFIXNUM (hz) <= 0)
471 invalid_hz (hz);
472 intmax_t ticks;
473 if (FASTER_TIMEFNS && !INT_MULTIPLY_WRAPV (t, XFIXNUM (hz), &ticks))
474 return make_int (ticks);
475 }
476 else if (! (BIGNUMP (hz) && 0 < mpz_sgn (XBIGNUM (hz)->value)))
477 invalid_hz (hz);
478
479 mpz_set_time (mpz[0], t);
480 mpz_mul (mpz[0], mpz[0], *bignum_integer (&mpz[1], hz));
481 return make_integer_mpz ();
482}
483static Lisp_Object
484lisp_time_hz_ticks (struct lisp_time t, Lisp_Object hz)
485{
486 if (FASTER_TIMEFNS && EQ (t.hz, hz))
487 return t.ticks;
488 if (FIXNUMP (hz))
489 {
490 if (XFIXNUM (hz) <= 0)
491 invalid_hz (hz);
492 intmax_t ticks;
493 if (FASTER_TIMEFNS && FIXNUMP (t.ticks) && FIXNUMP (t.hz)
494 && !INT_MULTIPLY_WRAPV (XFIXNUM (t.ticks), XFIXNUM (hz), &ticks))
495 return make_int (ticks / XFIXNUM (t.hz)
496 - (ticks % XFIXNUM (t.hz) < 0));
497 }
498 else if (! (BIGNUMP (hz) && 0 < mpz_sgn (XBIGNUM (hz)->value)))
499 invalid_hz (hz);
500
501 mpz_mul (mpz[0],
502 *bignum_integer (&mpz[0], t.ticks),
503 *bignum_integer (&mpz[1], hz));
504 mpz_fdiv_q (mpz[0], mpz[0], *bignum_integer (&mpz[1], t.hz));
505 return make_integer_mpz ();
506}
507
508/* Convert T to a Lisp integer counting seconds, taking the floor. */
509static Lisp_Object
510lisp_time_seconds (struct lisp_time t)
511{
512 if (!FASTER_TIMEFNS)
513 return lisp_time_hz_ticks (t, make_fixnum (1));
514 if (FIXNUMP (t.ticks) && FIXNUMP (t.hz))
515 return make_fixnum (XFIXNUM (t.ticks) / XFIXNUM (t.hz)
516 - (XFIXNUM (t.ticks) % XFIXNUM (t.hz) < 0));
517 mpz_fdiv_q (mpz[0],
518 *bignum_integer (&mpz[0], t.ticks),
519 *bignum_integer (&mpz[1], t.hz));
520 return make_integer_mpz ();
521}
522
523/* Convert T to a Lisp timestamp. */
524Lisp_Object
525make_lisp_time (struct timespec t)
526{
527 if (CURRENT_TIME_LIST)
528 {
529 time_t s = t.tv_sec;
530 int ns = t.tv_nsec;
531 return list4 (hi_time (s), lo_time (s),
532 make_fixnum (ns / 1000), make_fixnum (ns % 1000 * 1000));
533 }
534 else
535 return Fcons (timespec_ticks (t), timespec_hz);
536}
537
538/* Convert T to a Lisp timestamp. FORM specifies the timestamp format. */
539static Lisp_Object
540time_form_stamp (time_t t, Lisp_Object form)
541{
542 if (NILP (form))
543 form = CURRENT_TIME_LIST ? Qlist : Qt;
544 if (EQ (form, Qlist))
545 return list2 (hi_time (t), lo_time (t));
546 if (EQ (form, Qt) || EQ (form, Qinteger))
547 return INT_TO_INTEGER (t);
548 return Fcons (time_hz_ticks (t, form), form);
549}
550static Lisp_Object
551lisp_time_form_stamp (struct lisp_time t, Lisp_Object form)
552{
553 if (NILP (form))
554 form = CURRENT_TIME_LIST ? Qlist : Qt;
555 if (EQ (form, Qlist))
556 return ticks_hz_list4 (t.ticks, t.hz);
557 if (EQ (form, Qinteger))
558 return lisp_time_seconds (t);
559 if (EQ (form, Qt))
560 form = t.hz;
561 return Fcons (lisp_time_hz_ticks (t, form), form);
562}
563
564/* From what should be a valid timestamp (TICKS . HZ), generate the
565 corresponding time values.
566
567 If RESULT is not null, store into *RESULT the converted time.
568 Otherwise, store into *DRESULT the number of seconds since the
569 start of the POSIX Epoch. Unsuccessful calls may or may not store
570 results.
571
572 Return true if successful, false if (TICKS . HZ) would not
573 be a valid new-format timestamp. */
574static bool
575decode_ticks_hz (Lisp_Object ticks, Lisp_Object hz,
576 struct lisp_time *result, double *dresult)
577{
578 int ns;
579 mpz_t *q = &mpz[0];
580
581 if (! (INTEGERP (ticks)
582 && ((FIXNUMP (hz) && 0 < XFIXNUM (hz))
583 || (BIGNUMP (hz) && 0 < mpz_sgn (XBIGNUM (hz)->value)))))
584 return false;
585
586 if (result)
587 {
588 result->ticks = ticks;
589 result->hz = hz;
590 }
591 else
592 {
593 if (FASTER_TIMEFNS && EQ (hz, timespec_hz))
594 {
595 if (FIXNUMP (ticks))
596 {
597 verify (1 < TIMESPEC_HZ);
598 EMACS_INT s = XFIXNUM (ticks) / TIMESPEC_HZ;
599 ns = XFIXNUM (ticks) % TIMESPEC_HZ;
600 if (ns < 0)
601 s--, ns += TIMESPEC_HZ;
602 *dresult = s_ns_to_double (s, ns);
603 return true;
604 }
605 ns = mpz_fdiv_q_ui (*q, XBIGNUM (ticks)->value, TIMESPEC_HZ);
606 }
607 else if (FASTER_TIMEFNS && EQ (hz, make_fixnum (1)))
608 {
609 ns = 0;
610 if (FIXNUMP (ticks))
611 {
612 *dresult = XFIXNUM (ticks);
613 return true;
614 }
615 q = &XBIGNUM (ticks)->value;
616 }
617 else
618 {
619 mpz_mul_ui (*q, *bignum_integer (&mpz[1], ticks), TIMESPEC_HZ);
620 mpz_fdiv_q (*q, *q, *bignum_integer (&mpz[1], hz));
621 ns = mpz_fdiv_q_ui (*q, *q, TIMESPEC_HZ);
622 }
623
624 *dresult = s_ns_to_double (mpz_get_d (*q), ns);
625 }
626
627 return true;
628}
629
630/* Lisp timestamp classification. */
631enum timeform
632 {
633 TIMEFORM_INVALID = 0,
634 TIMEFORM_HI_LO, /* seconds in the form (HI << LO_TIME_BITS) + LO. */
635 TIMEFORM_HI_LO_US, /* seconds plus microseconds (HI LO US) */
636 TIMEFORM_NIL, /* current time in nanoseconds */
637 TIMEFORM_HI_LO_US_PS, /* seconds plus micro and picoseconds (HI LO US PS) */
638 TIMEFORM_FLOAT, /* time as a float */
639 TIMEFORM_TICKS_HZ /* fractional time: HI is ticks, LO is ticks per second */
640 };
641
642/* From the valid form FORM and the time components HIGH, LOW, USEC
643 and PSEC, generate the corresponding time value. If LOW is
644 floating point, the other components should be zero and FORM should
645 not be TIMEFORM_TICKS_HZ.
646
647 If RESULT is not null, store into *RESULT the converted time.
648 Otherwise, store into *DRESULT the number of seconds since the
649 start of the POSIX Epoch. Unsuccessful calls may or may not store
650 results.
651
652 Return true if successful, false if the components are of the wrong
653 type. */
654static bool
655decode_time_components (enum timeform form,
656 Lisp_Object high, Lisp_Object low,
657 Lisp_Object usec, Lisp_Object psec,
658 struct lisp_time *result, double *dresult)
659{
660 switch (form)
661 {
662 case TIMEFORM_INVALID:
663 return false;
664
665 case TIMEFORM_TICKS_HZ:
666 return decode_ticks_hz (high, low, result, dresult);
667
668 case TIMEFORM_FLOAT:
669 {
670 double t = XFLOAT_DATA (low);
671 if (result)
672 return decode_float_time (t, result);
673 else
674 {
675 *dresult = t;
676 return true;
677 }
678 }
679
680 case TIMEFORM_NIL:
681 {
682 struct timespec now = current_timespec ();
683 if (result)
684 {
685 result->ticks = timespec_ticks (now);
686 result->hz = timespec_hz;
687 }
688 else
689 *dresult = s_ns_to_double (now.tv_sec, now.tv_nsec);
690 return true;
691 }
692
693 default:
694 break;
695 }
696
697 if (! (INTEGERP (high) && INTEGERP (low)
698 && FIXNUMP (usec) && FIXNUMP (psec)))
699 return false;
700 EMACS_INT us = XFIXNUM (usec);
701 EMACS_INT ps = XFIXNUM (psec);
702
703 /* Normalize out-of-range lower-order components by carrying
704 each overflow into the next higher-order component. */
705 us += ps / 1000000 - (ps % 1000000 < 0);
706 mpz_set_intmax (mpz[0], us / 1000000 - (us % 1000000 < 0));
707 mpz_add (mpz[0], mpz[0], *bignum_integer (&mpz[1], low));
708 mpz_addmul_ui (mpz[0], *bignum_integer (&mpz[1], high), 1 << LO_TIME_BITS);
709 ps = ps % 1000000 + 1000000 * (ps % 1000000 < 0);
710 us = us % 1000000 + 1000000 * (us % 1000000 < 0);
711
712 if (result)
713 {
714 switch (form)
715 {
716 case TIMEFORM_HI_LO:
717 /* Floats and nil were handled above, so it was an integer. */
718 result->hz = make_fixnum (1);
719 break;
720
721 case TIMEFORM_HI_LO_US:
722 mpz_mul_ui (mpz[0], mpz[0], 1000000);
723 mpz_add_ui (mpz[0], mpz[0], us);
724 result->hz = make_fixnum (1000000);
725 break;
726
727 case TIMEFORM_HI_LO_US_PS:
728 mpz_mul_ui (mpz[0], mpz[0], 1000000);
729 mpz_add_ui (mpz[0], mpz[0], us);
730 mpz_mul_ui (mpz[0], mpz[0], 1000000);
731 mpz_add_ui (mpz[0], mpz[0], ps);
732 result->hz = trillion;
733 break;
734
735 default:
736 eassume (false);
737 }
738 result->ticks = make_integer_mpz ();
739 }
740 else
741 *dresult = mpz_get_d (mpz[0]) + (us * 1e6L + ps) / 1e12L;
742
743 return true;
744}
745
746enum { DECODE_SECS_ONLY = WARN_OBSOLETE_TIMESTAMPS + 1 };
747
748/* Decode a Lisp timestamp SPECIFIED_TIME that represents a time.
749
750 FLAGS specifies conversion flags. If FLAGS & DECODE_SECS_ONLY,
751 ignore and do not validate any sub-second components of an
752 old-format SPECIFIED_TIME. If FLAGS & WARN_OBSOLETE_TIMESTAMPS,
753 diagnose what could be obsolete (HIGH . LOW) timestamps.
754
755 If PFORM is not null, store into *PFORM the form of SPECIFIED-TIME.
756 If RESULT is not null, store into *RESULT the converted time;
757 otherwise, store into *DRESULT the number of seconds since the
758 start of the POSIX Epoch. Unsuccessful calls may or may not store
759 results.
760
761 Return true if successful, false if SPECIFIED_TIME is
762 not a valid Lisp timestamp. */
763static bool
764decode_lisp_time (Lisp_Object specified_time, int flags,
765 enum timeform *pform,
766 struct lisp_time *result, double *dresult)
350{ 767{
351 Lisp_Object high = make_fixnum (0); 768 Lisp_Object high = make_fixnum (0);
352 Lisp_Object low = specified_time; 769 Lisp_Object low = specified_time;
353 Lisp_Object usec = make_fixnum (0); 770 Lisp_Object usec = make_fixnum (0);
354 Lisp_Object psec = make_fixnum (0); 771 Lisp_Object psec = make_fixnum (0);
355 int len = 4; 772 enum timeform form = TIMEFORM_HI_LO;
356 773
357 if (CONSP (specified_time)) 774 if (NILP (specified_time))
775 form = TIMEFORM_NIL;
776 else if (FLOATP (specified_time))
777 form = TIMEFORM_FLOAT;
778 else if (CONSP (specified_time))
358 { 779 {
359 high = XCAR (specified_time); 780 high = XCAR (specified_time);
360 low = XCDR (specified_time); 781 low = XCDR (specified_time);
@@ -362,259 +783,185 @@ disassemble_lisp_time (Lisp_Object specified_time, Lisp_Object *phigh,
362 { 783 {
363 Lisp_Object low_tail = XCDR (low); 784 Lisp_Object low_tail = XCDR (low);
364 low = XCAR (low); 785 low = XCAR (low);
365 if (CONSP (low_tail)) 786 if (! (flags & DECODE_SECS_ONLY))
366 { 787 {
367 usec = XCAR (low_tail);
368 low_tail = XCDR (low_tail);
369 if (CONSP (low_tail)) 788 if (CONSP (low_tail))
370 psec = XCAR (low_tail); 789 {
371 else 790 usec = XCAR (low_tail);
372 len = 3; 791 low_tail = XCDR (low_tail);
373 } 792 if (CONSP (low_tail))
374 else if (!NILP (low_tail)) 793 {
375 { 794 psec = XCAR (low_tail);
376 usec = low_tail; 795 form = TIMEFORM_HI_LO_US_PS;
377 len = 3; 796 }
797 else
798 form = TIMEFORM_HI_LO_US;
799 }
800 else if (!NILP (low_tail))
801 {
802 usec = low_tail;
803 form = TIMEFORM_HI_LO_US;
804 }
378 } 805 }
379 else
380 len = 2;
381 } 806 }
382 else 807 else
383 len = 2; 808 {
809 if (flags & WARN_OBSOLETE_TIMESTAMPS
810 && RANGED_FIXNUMP (0, low, (1 << LO_TIME_BITS) - 1))
811 message ("obsolete timestamp with cdr %"pI"d", XFIXNUM (low));
812 form = TIMEFORM_TICKS_HZ;
813 }
384 814
385 /* When combining components, require LOW to be an integer, 815 /* Require LOW to be an integer, as otherwise the computation
386 as otherwise it would be a pain to add up times. */ 816 would be considerably trickier. */
387 if (! INTEGERP (low)) 817 if (! INTEGERP (low))
388 return 0; 818 form = TIMEFORM_INVALID;
389 } 819 }
390 else if (INTEGERP (specified_time)) 820
391 len = 2; 821 if (pform)
392 822 *pform = form;
393 *phigh = high; 823 return decode_time_components (form, high, low, usec, psec, result, dresult);
394 *plow = low;
395 *pusec = usec;
396 *ppsec = psec;
397 return len;
398} 824}
399 825
400/* Convert T into an Emacs time *RESULT, truncating toward minus infinity. 826/* Convert Z to time_t, returning true if it fits. */
401 Return true if T is in range, false otherwise. */
402static bool 827static bool
403decode_float_time (double t, struct lisp_time *result) 828mpz_time (mpz_t const z, time_t *t)
404{ 829{
405 double lo_multiplier = 1 << LO_TIME_BITS; 830 if (TYPE_SIGNED (time_t))
406 double emacs_time_min = MOST_NEGATIVE_FIXNUM * lo_multiplier; 831 {
407 if (! (emacs_time_min <= t && t < -emacs_time_min)) 832 intmax_t i;
408 return false; 833 if (! (mpz_to_intmax (z, &i) && TIME_T_MIN <= i && i <= TIME_T_MAX))
409 834 return false;
410 double small_t = t / lo_multiplier; 835 *t = i;
411 EMACS_INT hi = small_t; 836 }
412 double t_sans_hi = t - hi * lo_multiplier; 837 else
413 int lo = t_sans_hi; 838 {
414 long double fracps = (t_sans_hi - lo) * 1e12L; 839 uintmax_t i;
415#ifdef INT_FAST64_MAX 840 if (! (mpz_to_uintmax (z, &i) && i <= TIME_T_MAX))
416 int_fast64_t ifracps = fracps; 841 return false;
417 int us = ifracps / 1000000; 842 *t = i;
418 int ps = ifracps % 1000000; 843 }
419#else
420 int us = fracps / 1e6L;
421 int ps = fracps - us * 1e6L;
422#endif
423 us -= (ps < 0);
424 ps += (ps < 0) * 1000000;
425 lo -= (us < 0);
426 us += (us < 0) * 1000000;
427 hi -= (lo < 0);
428 lo += (lo < 0) << LO_TIME_BITS;
429 result->hi = hi;
430 result->lo = lo;
431 result->us = us;
432 result->ps = ps;
433 return true; 844 return true;
434} 845}
435 846
436/* From the time components HIGH, LOW, USEC and PSEC taken from a Lisp 847/* Convert T to struct timespec, returning an invalid timespec
437 list, generate the corresponding time value. 848 if T does not fit. */
438 If LOW is floating point, the other components should be zero. 849static struct timespec
439 850lisp_to_timespec (struct lisp_time t)
440 If RESULT is not null, store into *RESULT the converted time.
441 If *DRESULT is not null, store into *DRESULT the number of
442 seconds since the start of the POSIX Epoch.
443
444 Return 1 if successful, 0 if the components are of the
445 wrong type, and -1 if the time is out of range. */
446int
447decode_time_components (Lisp_Object high, Lisp_Object low, Lisp_Object usec,
448 Lisp_Object psec,
449 struct lisp_time *result, double *dresult)
450{ 851{
451 EMACS_INT hi, us, ps; 852 struct timespec result = invalid_timespec ();
452 intmax_t lo; 853 int ns;
453 if (! (FIXNUMP (high) 854 mpz_t *q = &mpz[0];
454 && FIXNUMP (usec) && FIXNUMP (psec))) 855
455 return 0; 856 if (FASTER_TIMEFNS && EQ (t.hz, timespec_hz))
456 if (! INTEGERP (low))
457 { 857 {
458 if (FLOATP (low)) 858 if (FIXNUMP (t.ticks))
459 {
460 double t = XFLOAT_DATA (low);
461 if (result && ! decode_float_time (t, result))
462 return -1;
463 if (dresult)
464 *dresult = t;
465 return 1;
466 }
467 else if (NILP (low))
468 { 859 {
469 struct timespec now = current_timespec (); 860 EMACS_INT s = XFIXNUM (t.ticks) / TIMESPEC_HZ;
470 if (result) 861 ns = XFIXNUM (t.ticks) % TIMESPEC_HZ;
862 if (ns < 0)
863 s--, ns += TIMESPEC_HZ;
864 if ((TYPE_SIGNED (time_t) ? TIME_T_MIN <= s : 0 <= s)
865 && s <= TIME_T_MAX)
471 { 866 {
472 result->hi = hi_time (now.tv_sec); 867 result.tv_sec = s;
473 result->lo = lo_time (now.tv_sec); 868 result.tv_nsec = ns;
474 result->us = now.tv_nsec / 1000;
475 result->ps = now.tv_nsec % 1000 * 1000;
476 } 869 }
477 if (dresult) 870 return result;
478 *dresult = now.tv_sec + now.tv_nsec / 1e9;
479 return 1;
480 } 871 }
481 else 872 else
482 return 0; 873 ns = mpz_fdiv_q_ui (*q, XBIGNUM (t.ticks)->value, TIMESPEC_HZ);
483 } 874 }
484 875 else if (FASTER_TIMEFNS && EQ (t.hz, make_fixnum (1)))
485 hi = XFIXNUM (high);
486 if (! integer_to_intmax (low, &lo))
487 return -1;
488 us = XFIXNUM (usec);
489 ps = XFIXNUM (psec);
490
491 /* Normalize out-of-range lower-order components by carrying
492 each overflow into the next higher-order component. */
493 us += ps / 1000000 - (ps % 1000000 < 0);
494 lo += us / 1000000 - (us % 1000000 < 0);
495 if (INT_ADD_WRAPV (lo >> LO_TIME_BITS, hi, &hi))
496 return -1;
497 ps = ps % 1000000 + 1000000 * (ps % 1000000 < 0);
498 us = us % 1000000 + 1000000 * (us % 1000000 < 0);
499 lo &= (1 << LO_TIME_BITS) - 1;
500
501 if (result)
502 { 876 {
503 if (FIXNUM_OVERFLOW_P (hi)) 877 ns = 0;
504 return -1; 878 if (FIXNUMP (t.ticks))
505 result->hi = hi; 879 {
506 result->lo = lo; 880 EMACS_INT s = XFIXNUM (t.ticks);
507 result->us = us; 881 if ((TYPE_SIGNED (time_t) ? TIME_T_MIN <= s : 0 <= s)
508 result->ps = ps; 882 && s <= TIME_T_MAX)
883 {
884 result.tv_sec = s;
885 result.tv_nsec = ns;
886 }
887 return result;
888 }
889 else
890 q = &XBIGNUM (t.ticks)->value;
509 } 891 }
510 892 else
511 if (dresult)
512 { 893 {
513 double dhi = hi; 894 mpz_mul_ui (*q, *bignum_integer (q, t.ticks), TIMESPEC_HZ);
514 *dresult = (us * 1e6 + ps) / 1e12 + lo + dhi * (1 << LO_TIME_BITS); 895 mpz_fdiv_q (*q, *q, *bignum_integer (&mpz[1], t.hz));
896 ns = mpz_fdiv_q_ui (*q, *q, TIMESPEC_HZ);
515 } 897 }
516 898
517 return 1; 899 if (mpz_time (*q, &result.tv_sec))
900 result.tv_nsec = ns;
901 return result;
518} 902}
519 903
520struct timespec 904/* Convert (HIGH LOW USEC PSEC) to struct timespec.
521lisp_to_timespec (struct lisp_time t) 905 Return true if successful. */
906bool
907list4_to_timespec (Lisp_Object high, Lisp_Object low,
908 Lisp_Object usec, Lisp_Object psec,
909 struct timespec *result)
522{ 910{
523 if (! ((TYPE_SIGNED (time_t) ? TIME_T_MIN >> LO_TIME_BITS <= t.hi : 0 <= t.hi) 911 struct lisp_time t;
524 && t.hi <= TIME_T_MAX >> LO_TIME_BITS)) 912 if (! decode_time_components (TIMEFORM_HI_LO_US_PS, high, low, usec, psec,
525 return invalid_timespec (); 913 &t, 0))
526 time_t s = (t.hi << LO_TIME_BITS) + t.lo; 914 return false;
527 int ns = t.us * 1000 + t.ps / 1000; 915 *result = lisp_to_timespec (t);
528 return make_timespec (s, ns); 916 return timespec_valid_p (*result);
529} 917}
530 918
531/* Decode a Lisp list SPECIFIED_TIME that represents a time. 919/* Decode a Lisp list SPECIFIED_TIME that represents a time.
532 Store its effective length into *PLEN.
533 If SPECIFIED_TIME is nil, use the current time. 920 If SPECIFIED_TIME is nil, use the current time.
534 Signal an error if SPECIFIED_TIME does not represent a time. */ 921 Signal an error if SPECIFIED_TIME does not represent a time. */
535static struct lisp_time 922static struct lisp_time
536lisp_time_struct (Lisp_Object specified_time, int *plen) 923lisp_time_struct (Lisp_Object specified_time, enum timeform *pform)
537{ 924{
538 Lisp_Object high, low, usec, psec; 925 int flags = WARN_OBSOLETE_TIMESTAMPS;
539 struct lisp_time t; 926 struct lisp_time t;
540 int len = disassemble_lisp_time (specified_time, &high, &low, &usec, &psec); 927 if (! decode_lisp_time (specified_time, flags, pform, &t, 0))
541 if (!len)
542 invalid_time (); 928 invalid_time ();
543 int val = decode_time_components (high, low, usec, psec, &t, 0);
544 check_time_validity (val);
545 *plen = len;
546 return t; 929 return t;
547} 930}
548 931
549/* Like lisp_time_struct, except return a struct timespec. 932/* Decode a Lisp list SPECIFIED_TIME that represents a time.
550 Discard any low-order digits. */ 933 Discard any low-order (sub-ns) resolution.
934 If SPECIFIED_TIME is nil, use the current time.
935 Signal an error if SPECIFIED_TIME does not represent a timespec. */
551struct timespec 936struct timespec
552lisp_time_argument (Lisp_Object specified_time) 937lisp_time_argument (Lisp_Object specified_time)
553{ 938{
554 int len; 939 struct lisp_time lt = lisp_time_struct (specified_time, 0);
555 struct lisp_time lt = lisp_time_struct (specified_time, &len);
556 struct timespec t = lisp_to_timespec (lt); 940 struct timespec t = lisp_to_timespec (lt);
557 if (! timespec_valid_p (t)) 941 if (! timespec_valid_p (t))
558 time_overflow (); 942 time_overflow ();
559 return t; 943 return t;
560} 944}
561 945
562/* Like lisp_time_argument, except decode only the seconds part, 946/* Like lisp_time_argument, except decode only the seconds part, and
563 and do not check the subseconds part. */ 947 do not check the subseconds part. */
564static time_t 948static time_t
565lisp_seconds_argument (Lisp_Object specified_time) 949lisp_seconds_argument (Lisp_Object specified_time)
566{ 950{
567 Lisp_Object high, low, usec, psec; 951 int flags = WARN_OBSOLETE_TIMESTAMPS | DECODE_SECS_ONLY;
568 struct lisp_time t; 952 struct lisp_time lt;
569 953 if (! decode_lisp_time (specified_time, flags, 0, &lt, 0))
570 int val = disassemble_lisp_time (specified_time, &high, &low, &usec, &psec); 954 invalid_time ();
571 if (val != 0) 955 struct timespec t = lisp_to_timespec (lt);
572 { 956 if (! timespec_valid_p (t))
573 val = decode_time_components (high, low, make_fixnum (0), 957 time_overflow ();
574 make_fixnum (0), &t, 0); 958 return t.tv_sec;
575 if (0 < val
576 && ! ((TYPE_SIGNED (time_t)
577 ? TIME_T_MIN >> LO_TIME_BITS <= t.hi
578 : 0 <= t.hi)
579 && t.hi <= TIME_T_MAX >> LO_TIME_BITS))
580 val = -1;
581 }
582 check_time_validity (val);
583 return (t.hi << LO_TIME_BITS) + t.lo;
584}
585
586static struct lisp_time
587time_add (struct lisp_time ta, struct lisp_time tb)
588{
589 EMACS_INT hi = ta.hi + tb.hi;
590 int lo = ta.lo + tb.lo;
591 int us = ta.us + tb.us;
592 int ps = ta.ps + tb.ps;
593 us += (1000000 <= ps);
594 ps -= (1000000 <= ps) * 1000000;
595 lo += (1000000 <= us);
596 us -= (1000000 <= us) * 1000000;
597 hi += (1 << LO_TIME_BITS <= lo);
598 lo -= (1 << LO_TIME_BITS <= lo) << LO_TIME_BITS;
599 return (struct lisp_time) { hi, lo, us, ps };
600}
601
602static struct lisp_time
603time_subtract (struct lisp_time ta, struct lisp_time tb)
604{
605 EMACS_INT hi = ta.hi - tb.hi;
606 int lo = ta.lo - tb.lo;
607 int us = ta.us - tb.us;
608 int ps = ta.ps - tb.ps;
609 us -= (ps < 0);
610 ps += (ps < 0) * 1000000;
611 lo -= (us < 0);
612 us += (us < 0) * 1000000;
613 hi -= (lo < 0);
614 lo += (lo < 0) << LO_TIME_BITS;
615 return (struct lisp_time) { hi, lo, us, ps };
616} 959}
617 960
961/* Given Lisp operands A and B, add their values, and return the
962 result as a Lisp timestamp that is in (TICKS . HZ) form if either A
963 or B are in that form, (HI LO US PS) form otherwise. Subtract
964 instead of adding if SUBTRACT. */
618static Lisp_Object 965static Lisp_Object
619time_arith (Lisp_Object a, Lisp_Object b, bool subtract) 966time_arith (Lisp_Object a, Lisp_Object b, bool subtract)
620{ 967{
@@ -627,45 +974,80 @@ time_arith (Lisp_Object a, Lisp_Object b, bool subtract)
627 if (FLOATP (b) && !isfinite (XFLOAT_DATA (b))) 974 if (FLOATP (b) && !isfinite (XFLOAT_DATA (b)))
628 return subtract ? make_float (-XFLOAT_DATA (b)) : b; 975 return subtract ? make_float (-XFLOAT_DATA (b)) : b;
629 976
630 int alen, blen; 977 enum timeform aform, bform;
631 struct lisp_time ta = lisp_time_struct (a, &alen); 978 struct lisp_time ta = lisp_time_struct (a, &aform);
632 struct lisp_time tb = lisp_time_struct (b, &blen); 979 struct lisp_time tb = lisp_time_struct (b, &bform);
633 struct lisp_time t = (subtract ? time_subtract : time_add) (ta, tb); 980 Lisp_Object ticks, hz;
634 if (FIXNUM_OVERFLOW_P (t.hi))
635 time_overflow ();
636 Lisp_Object val = Qnil;
637 981
638 switch (max (alen, blen)) 982 if (FASTER_TIMEFNS && EQ (ta.hz, tb.hz))
639 { 983 {
640 default: 984 hz = ta.hz;
641 val = Fcons (make_fixnum (t.ps), val); 985 if (FIXNUMP (ta.ticks) && FIXNUMP (tb.ticks))
642 FALLTHROUGH; 986 ticks = make_int (subtract
643 case 3: 987 ? XFIXNUM (ta.ticks) - XFIXNUM (tb.ticks)
644 val = Fcons (make_fixnum (t.us), val); 988 : XFIXNUM (ta.ticks) + XFIXNUM (tb.ticks));
645 FALLTHROUGH; 989 else
646 case 2: 990 {
647 val = Fcons (make_fixnum (t.lo), val); 991 (subtract ? mpz_sub : mpz_add)
648 val = Fcons (make_fixnum (t.hi), val); 992 (mpz[0],
649 break; 993 *bignum_integer (&mpz[0], ta.ticks),
994 *bignum_integer (&mpz[1], tb.ticks));
995 ticks = make_integer_mpz ();
996 }
997 }
998 else
999 {
1000 /* The plan is to decompose ta into na/da and tb into nb/db.
1001 Start by computing da and db. */
1002 mpz_t *da = bignum_integer (&mpz[1], ta.hz);
1003 mpz_t *db = bignum_integer (&mpz[2], tb.hz);
1004
1005 /* The plan is to compute (na * (db/g) + nb * (da/g)) / lcm (da, db)
1006 where g = gcd (da, db). Start by computing g. */
1007 mpz_t *g = &mpz[3];
1008 mpz_gcd (*g, *da, *db);
1009
1010 /* fa = da/g, fb = db/g. */
1011 mpz_t *fa = &mpz[1], *fb = &mpz[3];
1012 mpz_tdiv_q (*fa, *da, *g);
1013 mpz_tdiv_q (*fb, *db, *g);
1014
1015 /* FIXME: Maybe omit need for extra temp by computing fa * db here? */
1016
1017 /* hz = fa * db. This is equal to lcm (da, db). */
1018 mpz_mul (mpz[0], *fa, *db);
1019 hz = make_integer_mpz ();
1020
1021 /* ticks = (fb * na) OPER (fa * nb), where OPER is + or -.
1022 OP is the multiply-add or multiply-sub form of OPER. */
1023 mpz_t *na = bignum_integer (&mpz[0], ta.ticks);
1024 mpz_mul (mpz[0], *fb, *na);
1025 mpz_t *nb = bignum_integer (&mpz[3], tb.ticks);
1026 (subtract ? mpz_submul : mpz_addmul) (mpz[0], *fa, *nb);
1027 ticks = make_integer_mpz ();
650 } 1028 }
651 1029
652 return val; 1030 /* Return the (TICKS . HZ) form if either argument is that way,
1031 otherwise the (HI LO US PS) form for backward compatibility. */
1032 return (aform == TIMEFORM_TICKS_HZ || bform == TIMEFORM_TICKS_HZ
1033 ? Fcons (ticks, hz)
1034 : ticks_hz_list4 (ticks, hz));
653} 1035}
654 1036
655DEFUN ("time-add", Ftime_add, Stime_add, 2, 2, 0, 1037DEFUN ("time-add", Ftime_add, Stime_add, 2, 2, 0,
656 doc: /* Return the sum of two time values A and B, as a time value. 1038 doc: /* Return the sum of two time values A and B, as a timestamp.
657A nil value for either argument stands for the current time. 1039See Info node `(elisp)Time of Day' for time value formats.
658See `current-time-string' for the various forms of a time value. */) 1040For example, nil stands for the current time. */)
659 (Lisp_Object a, Lisp_Object b) 1041 (Lisp_Object a, Lisp_Object b)
660{ 1042{
661 return time_arith (a, b, false); 1043 return time_arith (a, b, false);
662} 1044}
663 1045
664DEFUN ("time-subtract", Ftime_subtract, Stime_subtract, 2, 2, 0, 1046DEFUN ("time-subtract", Ftime_subtract, Stime_subtract, 2, 2, 0,
665 doc: /* Return the difference between two time values A and B, as a time value. 1047 doc: /* Return the difference between two time values A and B, as a timestamp.
666Use `float-time' to convert the difference into elapsed seconds. 1048You can use `float-time' to convert the difference into elapsed seconds.
667A nil value for either argument stands for the current time. 1049See Info node `(elisp)Time of Day' for time value formats.
668See `current-time-string' for the various forms of a time value. */) 1050For example, nil stands for the current time. */)
669 (Lisp_Object a, Lisp_Object b) 1051 (Lisp_Object a, Lisp_Object b)
670{ 1052{
671 return time_arith (a, b, true); 1053 return time_arith (a, b, true);
@@ -685,54 +1067,52 @@ time_cmp (Lisp_Object a, Lisp_Object b)
685 return da < db ? -1 : da != db; 1067 return da < db ? -1 : da != db;
686 } 1068 }
687 1069
688 int alen, blen; 1070 struct lisp_time ta = lisp_time_struct (a, 0);
689 struct lisp_time ta = lisp_time_struct (a, &alen); 1071
690 struct lisp_time tb = lisp_time_struct (b, &blen); 1072 /* Compare nil to nil correctly, and other eq values while we're at it.
691 return (ta.hi != tb.hi ? (ta.hi < tb.hi ? -1 : 1) 1073 Compare here rather than earlier, to handle NaNs and check formats. */
692 : ta.lo != tb.lo ? (ta.lo < tb.lo ? -1 : 1) 1074 if (EQ (a, b))
693 : ta.us != tb.us ? (ta.us < tb.us ? -1 : 1) 1075 return 0;
694 : ta.ps < tb.ps ? -1 : ta.ps != tb.ps); 1076
1077 struct lisp_time tb = lisp_time_struct (b, 0);
1078 mpz_t *za = bignum_integer (&mpz[0], ta.ticks);
1079 mpz_t *zb = bignum_integer (&mpz[1], tb.ticks);
1080 if (! (FASTER_TIMEFNS && EQ (ta.hz, tb.hz)))
1081 {
1082 /* This could be sped up by looking at the signs, sizes, and
1083 number of bits of the two sides; see how GMP does mpq_cmp.
1084 It may not be worth the trouble here, though. */
1085 mpz_mul (mpz[0], *za, *bignum_integer (&mpz[2], tb.hz));
1086 mpz_mul (mpz[1], *zb, *bignum_integer (&mpz[2], ta.hz));
1087 za = &mpz[0];
1088 zb = &mpz[1];
1089 }
1090 return mpz_cmp (*za, *zb);
695} 1091}
696 1092
697DEFUN ("time-less-p", Ftime_less_p, Stime_less_p, 2, 2, 0, 1093DEFUN ("time-less-p", Ftime_less_p, Stime_less_p, 2, 2, 0,
698 doc: /* Return non-nil if time value T1 is earlier than time value T2. 1094 doc: /* Return non-nil if time value A is less than time value B.
699A nil value for either argument stands for the current time. 1095See Info node `(elisp)Time of Day' for time value formats.
700See `current-time-string' for the various forms of a time value. */) 1096For example, nil stands for the current time. */)
701 (Lisp_Object t1, Lisp_Object t2) 1097 (Lisp_Object a, Lisp_Object b)
702{ 1098{
703 return time_cmp (t1, t2) < 0 ? Qt : Qnil; 1099 return time_cmp (a, b) < 0 ? Qt : Qnil;
704} 1100}
705 1101
706DEFUN ("time-equal-p", Ftime_equal_p, Stime_equal_p, 2, 2, 0, 1102DEFUN ("time-equal-p", Ftime_equal_p, Stime_equal_p, 2, 2, 0,
707 doc: /* Return non-nil if T1 and T2 are equal time values. 1103 doc: /* Return non-nil if A and B are equal time values.
708A nil value for either argument stands for the current time. 1104See Info node `(elisp)Time of Day' for time value formats. */)
709See `current-time-string' for the various forms of a time value. */) 1105 (Lisp_Object a, Lisp_Object b)
710 (Lisp_Object t1, Lisp_Object t2)
711{ 1106{
712 return time_cmp (t1, t2) == 0 ? Qt : Qnil; 1107 return time_cmp (a, b) == 0 ? Qt : Qnil;
713} 1108}
714 1109
715 1110
716/* Make a Lisp list that represents the Emacs time T. T may be an
717 invalid time, with a slightly negative tv_nsec value such as
718 UNKNOWN_MODTIME_NSECS; in that case, the Lisp list contains a
719 correspondingly negative picosecond count. */
720Lisp_Object
721make_lisp_time (struct timespec t)
722{
723 time_t s = t.tv_sec;
724 int ns = t.tv_nsec;
725 return list4i (hi_time (s), lo_time (s), ns / 1000, ns % 1000 * 1000);
726}
727
728DEFUN ("float-time", Ffloat_time, Sfloat_time, 0, 1, 0, 1111DEFUN ("float-time", Ffloat_time, Sfloat_time, 0, 1, 0,
729 doc: /* Return the current time, as a float number of seconds since the epoch. 1112 doc: /* Return the current time, as a float number of seconds since the epoch.
730If SPECIFIED-TIME is given, it is the time to convert to float 1113If SPECIFIED-TIME is given, it is a Lisp time value to convert to
731instead of the current time. The argument should have the form 1114float instead of the current time. See Info node `(elisp)Time of Day'
732\(HIGH LOW) or (HIGH LOW USEC) or (HIGH LOW USEC PSEC). Thus, 1115for time value formats.
733you can use times from `current-time' and from `file-attributes'.
734SPECIFIED-TIME can also have the form (HIGH . LOW), but this is
735considered obsolete.
736 1116
737WARNING: Since the result is floating point, it may not be exact. 1117WARNING: Since the result is floating point, it may not be exact.
738If precise time stamps are required, use either `current-time', 1118If precise time stamps are required, use either `current-time',
@@ -740,9 +1120,7 @@ or (if you need time as a string) `format-time-string'. */)
740 (Lisp_Object specified_time) 1120 (Lisp_Object specified_time)
741{ 1121{
742 double t; 1122 double t;
743 Lisp_Object high, low, usec, psec; 1123 if (! decode_lisp_time (specified_time, 0, 0, 0, &t))
744 if (! (disassemble_lisp_time (specified_time, &high, &low, &usec, &psec)
745 && decode_time_components (high, low, usec, psec, 0, &t)))
746 invalid_time (); 1124 invalid_time ();
747 return make_float (t); 1125 return make_float (t);
748} 1126}
@@ -849,10 +1227,7 @@ format_time_string (char const *format, ptrdiff_t formatlen,
849 1227
850DEFUN ("format-time-string", Fformat_time_string, Sformat_time_string, 1, 3, 0, 1228DEFUN ("format-time-string", Fformat_time_string, Sformat_time_string, 1, 3, 0,
851 doc: /* Use FORMAT-STRING to format the time TIME, or now if omitted or nil. 1229 doc: /* Use FORMAT-STRING to format the time TIME, or now if omitted or nil.
852TIME is specified as (HIGH LOW USEC PSEC), as returned by 1230TIME is a Lisp time value; see Info node `(elisp)Time of Day'.
853`current-time' or `file-attributes'. It can also be a single integer
854number of seconds since the epoch. The obsolete form (HIGH . LOW) is
855also still accepted.
856 1231
857The optional ZONE is omitted or nil for Emacs local time, t for 1232The optional ZONE is omitted or nil for Emacs local time, t for
858Universal Time, `wall' for system wall clock time, or a string as in 1233Universal Time, `wall' for system wall clock time, or a string as in
@@ -925,10 +1300,8 @@ usage: (format-time-string FORMAT-STRING &optional TIME ZONE) */)
925 1300
926DEFUN ("decode-time", Fdecode_time, Sdecode_time, 0, 2, 0, 1301DEFUN ("decode-time", Fdecode_time, Sdecode_time, 0, 2, 0,
927 doc: /* Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST UTCOFF). 1302 doc: /* Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST UTCOFF).
928The optional TIME should be a list of (HIGH LOW . IGNORED), 1303The optional TIME is the Lisp time value to convert. See Info node
929as from `current-time' and `file-attributes', or nil to use the 1304`(elisp)Time of Day' for time value formats.
930current time. It can also be a single integer number of seconds since
931the epoch. The obsolete form (HIGH . LOW) is also still accepted.
932 1305
933The optional ZONE is omitted or nil for Emacs local time, t for 1306The optional ZONE is omitted or nil for Emacs local time, t for
934Universal Time, `wall' for system wall clock time, or a string as in 1307Universal Time, `wall' for system wall clock time, or a string as in
@@ -983,32 +1356,71 @@ usage: (decode-time &optional TIME ZONE) */)
983} 1356}
984 1357
985/* Return OBJ - OFFSET, checking that OBJ is a valid fixnum and that 1358/* Return OBJ - OFFSET, checking that OBJ is a valid fixnum and that
986 the result is representable as an int. */ 1359 the result is representable as an int. 0 <= OFFSET <= TM_YEAR_BASE. */
987static int 1360static int
988check_tm_member (Lisp_Object obj, int offset) 1361check_tm_member (Lisp_Object obj, int offset)
989{ 1362{
990 CHECK_FIXNUM (obj); 1363 if (FASTER_TIMEFNS && INT_MAX <= MOST_POSITIVE_FIXNUM - TM_YEAR_BASE)
991 EMACS_INT n = XFIXNUM (obj); 1364 {
992 int result; 1365 CHECK_FIXNUM (obj);
993 if (INT_SUBTRACT_WRAPV (n, offset, &result)) 1366 EMACS_INT n = XFIXNUM (obj);
994 time_overflow (); 1367 int i;
995 return result; 1368 if (INT_SUBTRACT_WRAPV (n, offset, &i))
1369 time_overflow ();
1370 return i;
1371 }
1372 else
1373 {
1374 CHECK_INTEGER (obj);
1375 mpz_sub_ui (mpz[0], *bignum_integer (&mpz[0], obj), offset);
1376 intmax_t i;
1377 if (! (mpz_to_intmax (mpz[0], &i) && INT_MIN <= i && i <= INT_MAX))
1378 time_overflow ();
1379 return i;
1380 }
996} 1381}
997 1382
998DEFUN ("encode-time", Fencode_time, Sencode_time, 6, MANY, 0, 1383DEFUN ("encode-time", Fencode_time, Sencode_time, 1, MANY, 0,
999 doc: /* Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time. 1384 doc: /* Convert TIME to a timestamp.
1000This is the reverse operation of `decode-time', which see. 1385Optional FORM specifies how the returned value should be encoded.
1001 1386This can act as the reverse operation of `decode-time', which see.
1002The optional ZONE is omitted or nil for Emacs local time, t for 1387
1003Universal Time, `wall' for system wall clock time, or a string as in 1388If TIME is a list (SECOND MINUTE HOUR DAY MONTH YEAR IGNORED DST ZONE)
1004the TZ environment variable. It can also be a list (as from 1389it a decoded time in the style of `decode-time', so that (encode-time
1390(decode-time ...)) works. TIME can also be a Lisp time value; see
1391Info node `(elisp)Time of Day'.
1392
1393If FORM is a positive integer, the time is returned as a pair of
1394integers (TICKS . FORM), where TICKS is the number of clock ticks and FORM
1395is the clock frequency in ticks per second. (Currently the positive
1396integer should be at least 65536 if the returned value is expected to
1397be given to standard functions expecting Lisp timestamps.) If FORM is
1398t, the time is returned as (TICKS . PHZ), where PHZ is a
1399platform-dependent clock frequency. If FORM is `integer', the time is
1400returned as an integer count of seconds. If FORM is `list', the time is
1401returned as an integer list (HIGH LOW USEC PSEC), where HIGH has the
1402most significant bits of the seconds, LOW has the least significant 16
1403bits, and USEC and PSEC are the microsecond and picosecond counts.
1404Returned values are rounded toward minus infinity. Although an
1405omitted or nil FORM currently acts like `list', this is planned to
1406change, so callers requiring list timestamps should specify `list'.
1407
1408As an obsolescent calling convention, the first 6 arguments SECOND,
1409MINUTE, HOUR, DAY, MONTH, and YEAR specify the components of a decoded
1410time, where DST assumed to be -1 and FORM is omitted. If there are more
1411than 6 arguments the *last* argument is used as ZONE and any other
1412extra arguments are ignored, so that (apply \\='encode-time
1413(decode-time ...)) works; otherwise ZONE is assumed to be nil.
1414
1415If the input is a decoded time, ZONE is nil for Emacs local time, t
1416for Universal Time, `wall' for system wall clock time, or a string as
1417in the TZ environment variable. It can also be a list (as from
1005`current-time-zone') or an integer (as from `decode-time') applied 1418`current-time-zone') or an integer (as from `decode-time') applied
1006without consideration for daylight saving time. 1419without consideration for daylight saving time.
1007 1420
1008You can pass more than 7 arguments; then the first six arguments 1421If the input is a decoded time and ZONE specifies a time zone with
1009are used as SECOND through YEAR, and the *last* argument is used as ZONE. 1422daylight-saving transitions, DST is t for daylight saving time and nil
1010The intervening arguments are ignored. 1423for standard time. If DST is -1, the daylight saving flag is guessed.
1011This feature lets (apply \\='encode-time (decode-time ...)) work.
1012 1424
1013Out-of-range values for SECOND, MINUTE, HOUR, DAY, or MONTH are allowed; 1425Out-of-range values for SECOND, MINUTE, HOUR, DAY, or MONTH are allowed;
1014for example, a DAY of 0 means the day preceding the given month. 1426for example, a DAY of 0 means the day preceding the given month.
@@ -1018,21 +1430,55 @@ If you want them to stand for years in this century, you must do that yourself.
1018Years before 1970 are not guaranteed to work. On some systems, 1430Years before 1970 are not guaranteed to work. On some systems,
1019year values as low as 1901 do work. 1431year values as low as 1901 do work.
1020 1432
1021usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */) 1433usage: (encode-time TIME &optional FORM) */)
1022 (ptrdiff_t nargs, Lisp_Object *args) 1434 (ptrdiff_t nargs, Lisp_Object *args)
1023{ 1435{
1024 time_t value; 1436 time_t value;
1025 struct tm tm; 1437 struct tm tm;
1026 Lisp_Object zone = (nargs > 6 ? args[nargs - 1] : Qnil); 1438 Lisp_Object form = Qnil, zone = Qnil;
1027 1439 Lisp_Object a = args[0];
1028 tm.tm_sec = check_tm_member (args[0], 0);
1029 tm.tm_min = check_tm_member (args[1], 0);
1030 tm.tm_hour = check_tm_member (args[2], 0);
1031 tm.tm_mday = check_tm_member (args[3], 0);
1032 tm.tm_mon = check_tm_member (args[4], 1);
1033 tm.tm_year = check_tm_member (args[5], TM_YEAR_BASE);
1034 tm.tm_isdst = -1; 1440 tm.tm_isdst = -1;
1035 1441
1442 if (nargs <= 2)
1443 {
1444 if (nargs == 2)
1445 form = args[1];
1446 Lisp_Object tail = a;
1447 for (int i = 0; i < 9; i++, tail = XCDR (tail))
1448 if (! CONSP (tail))
1449 {
1450 struct lisp_time t;
1451 if (! decode_lisp_time (a, 0, 0, &t, 0))
1452 invalid_time ();
1453 return lisp_time_form_stamp (t, form);
1454 }
1455 tm.tm_sec = check_tm_member (XCAR (a), 0); a = XCDR (a);
1456 tm.tm_min = check_tm_member (XCAR (a), 0); a = XCDR (a);
1457 tm.tm_hour = check_tm_member (XCAR (a), 0); a = XCDR (a);
1458 tm.tm_mday = check_tm_member (XCAR (a), 0); a = XCDR (a);
1459 tm.tm_mon = check_tm_member (XCAR (a), 1); a = XCDR (a);
1460 tm.tm_year = check_tm_member (XCAR (a), TM_YEAR_BASE); a = XCDR (a);
1461 a = XCDR (a);
1462 if (SYMBOLP (XCAR (a)))
1463 tm.tm_isdst = !NILP (XCAR (a));
1464 a = XCDR (a);
1465 zone = XCAR (a);
1466 }
1467 else if (nargs < 6)
1468 xsignal2 (Qwrong_number_of_arguments, Qencode_time, make_fixnum (nargs));
1469 else
1470 {
1471 if (6 < nargs)
1472 zone = args[nargs - 1];
1473 form = Qnil;
1474 tm.tm_sec = check_tm_member (a, 0);
1475 tm.tm_min = check_tm_member (args[1], 0);
1476 tm.tm_hour = check_tm_member (args[2], 0);
1477 tm.tm_mday = check_tm_member (args[3], 0);
1478 tm.tm_mon = check_tm_member (args[4], 1);
1479 tm.tm_year = check_tm_member (args[5], TM_YEAR_BASE);
1480 }
1481
1036 timezone_t tz = tzlookup (zone, false); 1482 timezone_t tz = tzlookup (zone, false);
1037 value = emacs_mktime_z (tz, &tm); 1483 value = emacs_mktime_z (tz, &tm);
1038 xtzfree (tz); 1484 xtzfree (tz);
@@ -1040,15 +1486,17 @@ usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */)
1040 if (value == (time_t) -1) 1486 if (value == (time_t) -1)
1041 time_overflow (); 1487 time_overflow ();
1042 1488
1043 return list2i (hi_time (value), lo_time (value)); 1489 return time_form_stamp (value, form);
1044} 1490}
1045 1491
1046DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0, 1492DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0,
1047 doc: /* Return the current time, as the number of seconds since 1970-01-01 00:00:00. 1493 doc: /* Return the current time, counting the number of seconds since the epoch.
1048The time is returned as a list of integers (HIGH LOW USEC PSEC). 1494
1049HIGH has the most significant bits of the seconds, while LOW has the 1495See Info node `(elisp)Time of Day' for the format of the returned
1050least significant 16 bits. USEC and PSEC are the microsecond and 1496timestamp. Although this is currently list format, it may change in
1051picosecond counts. */) 1497future versions of Emacs. Use `encode-time' if you need a particular
1498form; for example, (encode-time nil \\='list) returns the current time
1499in list form. */)
1052 (void) 1500 (void)
1053{ 1501{
1054 return make_lisp_time (current_timespec ()); 1502 return make_lisp_time (current_timespec ());
@@ -1064,12 +1512,9 @@ The format is `Sun Sep 16 01:03:52 1973'.
1064However, see also the functions `decode-time' and `format-time-string' 1512However, see also the functions `decode-time' and `format-time-string'
1065which provide a much more powerful and general facility. 1513which provide a much more powerful and general facility.
1066 1514
1067If SPECIFIED-TIME is given, it is a time to format instead of the 1515If SPECIFIED-TIME is given, it is the Lisp time value to format
1068current time. The argument should have the form (HIGH LOW . IGNORED). 1516instead of the current time. See Info node `(elisp)Time of Day' for
1069Thus, you can use times obtained from `current-time' and from 1517time value formats.
1070`file-attributes'. SPECIFIED-TIME can also be a single integer number
1071of seconds since the epoch. The obsolete form (HIGH . LOW) is also
1072still accepted.
1073 1518
1074The optional ZONE is omitted or nil for Emacs local time, t for 1519The optional ZONE is omitted or nil for Emacs local time, t for
1075Universal Time, `wall' for system wall clock time, or a string as in 1520Universal Time, `wall' for system wall clock time, or a string as in
@@ -1113,11 +1558,8 @@ OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
1113 A negative value means west of Greenwich. 1558 A negative value means west of Greenwich.
1114NAME is a string giving the name of the time zone. 1559NAME is a string giving the name of the time zone.
1115If SPECIFIED-TIME is given, the time zone offset is determined from it 1560If SPECIFIED-TIME is given, the time zone offset is determined from it
1116instead of using the current time. The argument should have the form 1561instead of using the current time. The argument should be a Lisp
1117\(HIGH LOW . IGNORED). Thus, you can use times obtained from 1562time value; see Info node `(elisp)Time of Day'.
1118`current-time' and from `file-attributes'. SPECIFIED-TIME can also be
1119a single integer number of seconds since the epoch. The obsolete form
1120(HIGH . LOW) is also still accepted.
1121 1563
1122The optional ZONE is omitted or nil for Emacs local time, t for 1564The optional ZONE is omitted or nil for Emacs local time, t for
1123Universal Time, `wall' for system wall clock time, or a string as in 1565Universal Time, `wall' for system wall clock time, or a string as in
@@ -1272,6 +1714,21 @@ emacs_setenv_TZ (const char *tzstring)
1272void 1714void
1273syms_of_timefns (void) 1715syms_of_timefns (void)
1274{ 1716{
1717#ifndef timespec_hz
1718 timespec_hz = make_int (TIMESPEC_HZ);
1719 staticpro (&timespec_hz);
1720#endif
1721#ifndef trillion
1722 trillion = make_int (1000000000000);
1723 staticpro (&trillion);
1724#endif
1725#if (ULONG_MAX < TRILLION || !FASTER_TIMEFNS) && !defined ztrillion
1726 mpz_init_set_ui (ztrillion, 1000000);
1727 mpz_mul_ui (ztrillion, ztrillion, 1000000);
1728#endif
1729
1730 DEFSYM (Qencode_time, "encode-time");
1731
1275 defsubr (&Scurrent_time); 1732 defsubr (&Scurrent_time);
1276 defsubr (&Stime_add); 1733 defsubr (&Stime_add);
1277 defsubr (&Stime_subtract); 1734 defsubr (&Stime_subtract);