diff options
| author | Paul Eggert | 2018-10-03 09:10:01 -0700 |
|---|---|---|
| committer | Paul Eggert | 2018-10-06 23:31:04 -0700 |
| commit | 93fe420942c08111a6048af7c4d7807c61d80a09 (patch) | |
| tree | 9ec406b06d09cde9573e757574e9e626e86d7a77 /src | |
| parent | 84f39d3389209e566dde9acbdd78f5572f0c6751 (diff) | |
| download | emacs-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.c | 2 | ||||
| -rw-r--r-- | src/keyboard.c | 11 | ||||
| -rw-r--r-- | src/systime.h | 15 | ||||
| -rw-r--r-- | src/timefns.c | 1137 |
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 | ||
| 36 | mpz_t mpz[4]; | 36 | mpz_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. */ |
| 76 | enum { LO_TIME_BITS = 16 }; | 76 | enum { 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. */ |
| 79 | struct lisp_time | 79 | struct 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 */ |
| 86 | extern struct timeval make_timeval (struct timespec) ATTRIBUTE_CONST; | 90 | extern struct timeval make_timeval (struct timespec) ATTRIBUTE_CONST; |
| 87 | extern Lisp_Object make_lisp_time (struct timespec); | 91 | extern Lisp_Object make_lisp_time (struct timespec); |
| 88 | extern int decode_time_components (Lisp_Object, Lisp_Object, Lisp_Object, | 92 | extern bool list4_to_timespec (Lisp_Object, Lisp_Object, Lisp_Object, |
| 89 | Lisp_Object, struct lisp_time *, double *); | 93 | Lisp_Object, struct timespec *); |
| 90 | extern struct timespec lisp_to_timespec (struct lisp_time); | ||
| 91 | extern struct timespec lisp_time_argument (Lisp_Object); | 94 | extern struct timespec lisp_time_argument (Lisp_Object); |
| 92 | extern _Noreturn void time_overflow (void); | 95 | extern _Noreturn void time_overflow (void); |
| 93 | extern void init_timefns (bool); | 96 | extern 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 | ||
| 73 | enum { 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 | ||
| 81 | enum { CURRENT_TIME_LIST = true }; | ||
| 82 | #endif | ||
| 83 | |||
| 84 | #if FIXNUM_OVERFLOW_P (1000000000) | ||
| 85 | static 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) | ||
| 92 | static Lisp_Object trillion; | ||
| 93 | # define ztrillion (XBIGNUM (trillion)->value) | ||
| 94 | #else | ||
| 95 | # define trillion make_fixnum (TRILLION) | ||
| 96 | # if ULONG_MAX < TRILLION || !FASTER_TIMEFNS | ||
| 97 | mpz_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. */ | 355 | static _Noreturn void |
| 313 | static void | 356 | invalid_hz (Lisp_Object hz) |
| 314 | check_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). */ |
| 326 | static EMACS_INT | 362 | static Lisp_Object |
| 327 | hi_time (time_t t) | 363 | hi_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. */ |
| 336 | static int | 369 | static Lisp_Object |
| 337 | lo_time (time_t t) | 370 | lo_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 | 377 | static bool |
| 345 | if successful, 0 if unsuccessful. */ | 378 | decode_float_time (double t, struct lisp_time *result) |
| 346 | static int | 379 | { |
| 347 | disassemble_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. */ | ||
| 394 | static double | ||
| 395 | s_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. */ | ||
| 402 | static Lisp_Object | ||
| 403 | ticks_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. */ | ||
| 431 | static void | ||
| 432 | mpz_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. */ | ||
| 442 | static void | ||
| 443 | timespec_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. */ | ||
| 451 | static Lisp_Object | ||
| 452 | timespec_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. */ | ||
| 465 | static Lisp_Object | ||
| 466 | time_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 | } | ||
| 483 | static Lisp_Object | ||
| 484 | lisp_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. */ | ||
| 509 | static Lisp_Object | ||
| 510 | lisp_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. */ | ||
| 524 | Lisp_Object | ||
| 525 | make_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. */ | ||
| 539 | static Lisp_Object | ||
| 540 | time_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 | } | ||
| 550 | static Lisp_Object | ||
| 551 | lisp_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. */ | ||
| 574 | static bool | ||
| 575 | decode_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. */ | ||
| 631 | enum 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. */ | ||
| 654 | static bool | ||
| 655 | decode_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 | |||
| 746 | enum { 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. */ | ||
| 763 | static bool | ||
| 764 | decode_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. */ | ||
| 402 | static bool | 827 | static bool |
| 403 | decode_float_time (double t, struct lisp_time *result) | 828 | mpz_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. | 849 | static struct timespec |
| 439 | 850 | lisp_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. */ | ||
| 446 | int | ||
| 447 | decode_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 | ||
| 520 | struct timespec | 904 | /* Convert (HIGH LOW USEC PSEC) to struct timespec. |
| 521 | lisp_to_timespec (struct lisp_time t) | 905 | Return true if successful. */ |
| 906 | bool | ||
| 907 | list4_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. */ |
| 535 | static struct lisp_time | 922 | static struct lisp_time |
| 536 | lisp_time_struct (Lisp_Object specified_time, int *plen) | 923 | lisp_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. */ | ||
| 551 | struct timespec | 936 | struct timespec |
| 552 | lisp_time_argument (Lisp_Object specified_time) | 937 | lisp_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. */ |
| 564 | static time_t | 948 | static time_t |
| 565 | lisp_seconds_argument (Lisp_Object specified_time) | 949 | lisp_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, <, 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 | |||
| 586 | static struct lisp_time | ||
| 587 | time_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 | |||
| 602 | static struct lisp_time | ||
| 603 | time_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. */ | ||
| 618 | static Lisp_Object | 965 | static Lisp_Object |
| 619 | time_arith (Lisp_Object a, Lisp_Object b, bool subtract) | 966 | time_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 | ||
| 655 | DEFUN ("time-add", Ftime_add, Stime_add, 2, 2, 0, | 1037 | DEFUN ("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. |
| 657 | A nil value for either argument stands for the current time. | 1039 | See Info node `(elisp)Time of Day' for time value formats. |
| 658 | See `current-time-string' for the various forms of a time value. */) | 1040 | For 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 | ||
| 664 | DEFUN ("time-subtract", Ftime_subtract, Stime_subtract, 2, 2, 0, | 1046 | DEFUN ("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. |
| 666 | Use `float-time' to convert the difference into elapsed seconds. | 1048 | You can use `float-time' to convert the difference into elapsed seconds. |
| 667 | A nil value for either argument stands for the current time. | 1049 | See Info node `(elisp)Time of Day' for time value formats. |
| 668 | See `current-time-string' for the various forms of a time value. */) | 1050 | For 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 | ||
| 697 | DEFUN ("time-less-p", Ftime_less_p, Stime_less_p, 2, 2, 0, | 1093 | DEFUN ("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. |
| 699 | A nil value for either argument stands for the current time. | 1095 | See Info node `(elisp)Time of Day' for time value formats. |
| 700 | See `current-time-string' for the various forms of a time value. */) | 1096 | For 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 | ||
| 706 | DEFUN ("time-equal-p", Ftime_equal_p, Stime_equal_p, 2, 2, 0, | 1102 | DEFUN ("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. |
| 708 | A nil value for either argument stands for the current time. | 1104 | See Info node `(elisp)Time of Day' for time value formats. */) |
| 709 | See `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. */ | ||
| 720 | Lisp_Object | ||
| 721 | make_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 | |||
| 728 | DEFUN ("float-time", Ffloat_time, Sfloat_time, 0, 1, 0, | 1111 | DEFUN ("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. |
| 730 | If SPECIFIED-TIME is given, it is the time to convert to float | 1113 | If SPECIFIED-TIME is given, it is a Lisp time value to convert to |
| 731 | instead of the current time. The argument should have the form | 1114 | float 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, | 1115 | for time value formats. |
| 733 | you can use times from `current-time' and from `file-attributes'. | ||
| 734 | SPECIFIED-TIME can also have the form (HIGH . LOW), but this is | ||
| 735 | considered obsolete. | ||
| 736 | 1116 | ||
| 737 | WARNING: Since the result is floating point, it may not be exact. | 1117 | WARNING: Since the result is floating point, it may not be exact. |
| 738 | If precise time stamps are required, use either `current-time', | 1118 | If 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 | ||
| 850 | DEFUN ("format-time-string", Fformat_time_string, Sformat_time_string, 1, 3, 0, | 1228 | DEFUN ("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. |
| 852 | TIME is specified as (HIGH LOW USEC PSEC), as returned by | 1230 | TIME 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 | ||
| 854 | number of seconds since the epoch. The obsolete form (HIGH . LOW) is | ||
| 855 | also still accepted. | ||
| 856 | 1231 | ||
| 857 | The optional ZONE is omitted or nil for Emacs local time, t for | 1232 | The optional ZONE is omitted or nil for Emacs local time, t for |
| 858 | Universal Time, `wall' for system wall clock time, or a string as in | 1233 | Universal 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 | ||
| 926 | DEFUN ("decode-time", Fdecode_time, Sdecode_time, 0, 2, 0, | 1301 | DEFUN ("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). |
| 928 | The optional TIME should be a list of (HIGH LOW . IGNORED), | 1303 | The optional TIME is the Lisp time value to convert. See Info node |
| 929 | as from `current-time' and `file-attributes', or nil to use the | 1304 | `(elisp)Time of Day' for time value formats. |
| 930 | current time. It can also be a single integer number of seconds since | ||
| 931 | the epoch. The obsolete form (HIGH . LOW) is also still accepted. | ||
| 932 | 1305 | ||
| 933 | The optional ZONE is omitted or nil for Emacs local time, t for | 1306 | The optional ZONE is omitted or nil for Emacs local time, t for |
| 934 | Universal Time, `wall' for system wall clock time, or a string as in | 1307 | Universal 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. */ |
| 987 | static int | 1360 | static int |
| 988 | check_tm_member (Lisp_Object obj, int offset) | 1361 | check_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 | ||
| 998 | DEFUN ("encode-time", Fencode_time, Sencode_time, 6, MANY, 0, | 1383 | DEFUN ("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. |
| 1000 | This is the reverse operation of `decode-time', which see. | 1385 | Optional FORM specifies how the returned value should be encoded. |
| 1001 | 1386 | This can act as the reverse operation of `decode-time', which see. | |
| 1002 | The optional ZONE is omitted or nil for Emacs local time, t for | 1387 | |
| 1003 | Universal Time, `wall' for system wall clock time, or a string as in | 1388 | If TIME is a list (SECOND MINUTE HOUR DAY MONTH YEAR IGNORED DST ZONE) |
| 1004 | the TZ environment variable. It can also be a list (as from | 1389 | it 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 | ||
| 1391 | Info node `(elisp)Time of Day'. | ||
| 1392 | |||
| 1393 | If FORM is a positive integer, the time is returned as a pair of | ||
| 1394 | integers (TICKS . FORM), where TICKS is the number of clock ticks and FORM | ||
| 1395 | is the clock frequency in ticks per second. (Currently the positive | ||
| 1396 | integer should be at least 65536 if the returned value is expected to | ||
| 1397 | be given to standard functions expecting Lisp timestamps.) If FORM is | ||
| 1398 | t, the time is returned as (TICKS . PHZ), where PHZ is a | ||
| 1399 | platform-dependent clock frequency. If FORM is `integer', the time is | ||
| 1400 | returned as an integer count of seconds. If FORM is `list', the time is | ||
| 1401 | returned as an integer list (HIGH LOW USEC PSEC), where HIGH has the | ||
| 1402 | most significant bits of the seconds, LOW has the least significant 16 | ||
| 1403 | bits, and USEC and PSEC are the microsecond and picosecond counts. | ||
| 1404 | Returned values are rounded toward minus infinity. Although an | ||
| 1405 | omitted or nil FORM currently acts like `list', this is planned to | ||
| 1406 | change, so callers requiring list timestamps should specify `list'. | ||
| 1407 | |||
| 1408 | As an obsolescent calling convention, the first 6 arguments SECOND, | ||
| 1409 | MINUTE, HOUR, DAY, MONTH, and YEAR specify the components of a decoded | ||
| 1410 | time, where DST assumed to be -1 and FORM is omitted. If there are more | ||
| 1411 | than 6 arguments the *last* argument is used as ZONE and any other | ||
| 1412 | extra arguments are ignored, so that (apply \\='encode-time | ||
| 1413 | (decode-time ...)) works; otherwise ZONE is assumed to be nil. | ||
| 1414 | |||
| 1415 | If the input is a decoded time, ZONE is nil for Emacs local time, t | ||
| 1416 | for Universal Time, `wall' for system wall clock time, or a string as | ||
| 1417 | in 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 |
| 1006 | without consideration for daylight saving time. | 1419 | without consideration for daylight saving time. |
| 1007 | 1420 | ||
| 1008 | You can pass more than 7 arguments; then the first six arguments | 1421 | If the input is a decoded time and ZONE specifies a time zone with |
| 1009 | are used as SECOND through YEAR, and the *last* argument is used as ZONE. | 1422 | daylight-saving transitions, DST is t for daylight saving time and nil |
| 1010 | The intervening arguments are ignored. | 1423 | for standard time. If DST is -1, the daylight saving flag is guessed. |
| 1011 | This feature lets (apply \\='encode-time (decode-time ...)) work. | ||
| 1012 | 1424 | ||
| 1013 | Out-of-range values for SECOND, MINUTE, HOUR, DAY, or MONTH are allowed; | 1425 | Out-of-range values for SECOND, MINUTE, HOUR, DAY, or MONTH are allowed; |
| 1014 | for example, a DAY of 0 means the day preceding the given month. | 1426 | for 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. | |||
| 1018 | Years before 1970 are not guaranteed to work. On some systems, | 1430 | Years before 1970 are not guaranteed to work. On some systems, |
| 1019 | year values as low as 1901 do work. | 1431 | year values as low as 1901 do work. |
| 1020 | 1432 | ||
| 1021 | usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */) | 1433 | usage: (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 | ||
| 1046 | DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0, | 1492 | DEFUN ("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. |
| 1048 | The time is returned as a list of integers (HIGH LOW USEC PSEC). | 1494 | |
| 1049 | HIGH has the most significant bits of the seconds, while LOW has the | 1495 | See Info node `(elisp)Time of Day' for the format of the returned |
| 1050 | least significant 16 bits. USEC and PSEC are the microsecond and | 1496 | timestamp. Although this is currently list format, it may change in |
| 1051 | picosecond counts. */) | 1497 | future versions of Emacs. Use `encode-time' if you need a particular |
| 1498 | form; for example, (encode-time nil \\='list) returns the current time | ||
| 1499 | in 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'. | |||
| 1064 | However, see also the functions `decode-time' and `format-time-string' | 1512 | However, see also the functions `decode-time' and `format-time-string' |
| 1065 | which provide a much more powerful and general facility. | 1513 | which provide a much more powerful and general facility. |
| 1066 | 1514 | ||
| 1067 | If SPECIFIED-TIME is given, it is a time to format instead of the | 1515 | If SPECIFIED-TIME is given, it is the Lisp time value to format |
| 1068 | current time. The argument should have the form (HIGH LOW . IGNORED). | 1516 | instead of the current time. See Info node `(elisp)Time of Day' for |
| 1069 | Thus, you can use times obtained from `current-time' and from | 1517 | time value formats. |
| 1070 | `file-attributes'. SPECIFIED-TIME can also be a single integer number | ||
| 1071 | of seconds since the epoch. The obsolete form (HIGH . LOW) is also | ||
| 1072 | still accepted. | ||
| 1073 | 1518 | ||
| 1074 | The optional ZONE is omitted or nil for Emacs local time, t for | 1519 | The optional ZONE is omitted or nil for Emacs local time, t for |
| 1075 | Universal Time, `wall' for system wall clock time, or a string as in | 1520 | Universal 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. |
| 1114 | NAME is a string giving the name of the time zone. | 1559 | NAME is a string giving the name of the time zone. |
| 1115 | If SPECIFIED-TIME is given, the time zone offset is determined from it | 1560 | If SPECIFIED-TIME is given, the time zone offset is determined from it |
| 1116 | instead of using the current time. The argument should have the form | 1561 | instead of using the current time. The argument should be a Lisp |
| 1117 | \(HIGH LOW . IGNORED). Thus, you can use times obtained from | 1562 | time value; see Info node `(elisp)Time of Day'. |
| 1118 | `current-time' and from `file-attributes'. SPECIFIED-TIME can also be | ||
| 1119 | a single integer number of seconds since the epoch. The obsolete form | ||
| 1120 | (HIGH . LOW) is also still accepted. | ||
| 1121 | 1563 | ||
| 1122 | The optional ZONE is omitted or nil for Emacs local time, t for | 1564 | The optional ZONE is omitted or nil for Emacs local time, t for |
| 1123 | Universal Time, `wall' for system wall clock time, or a string as in | 1565 | Universal Time, `wall' for system wall clock time, or a string as in |
| @@ -1272,6 +1714,21 @@ emacs_setenv_TZ (const char *tzstring) | |||
| 1272 | void | 1714 | void |
| 1273 | syms_of_timefns (void) | 1715 | syms_of_timefns (void) |
| 1274 | { | 1716 | { |
| 1717 | #ifndef timespec_hz | ||
| 1718 | timespec_hz = make_int (TIMESPEC_HZ); | ||
| 1719 | staticpro (×pec_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); |