1 /* Timestamp functions for Emacs
2
3 Copyright (C) 1985-1987, 1989, 1993-2023 Free Software Foundation, Inc.
4
5 This file is part of GNU Emacs.
6
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or (at
10 your option) any later version.
11
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
19
20 #include <config.h>
21
22 /* Work around GCC bug 102671. */
23 #if 10 <= __GNUC__
24 # pragma GCC diagnostic ignored "-Wanalyzer-null-dereference"
25 #endif
26
27 #include "systime.h"
28
29 #include "blockinput.h"
30 #include "bignum.h"
31 #include "coding.h"
32 #include "lisp.h"
33 #include "pdumper.h"
34
35 #include <strftime.h>
36
37 #include <errno.h>
38 #include <limits.h>
39 #include <math.h>
40 #include <stdio.h>
41 #include <stdlib.h>
42
43 #ifdef WINDOWSNT
44 extern clock_t sys_clock (void);
45 #endif
46
47 #ifdef HAVE_TIMEZONE_T
48 # include <sys/param.h>
49 # if defined __NetBSD_Version__ && __NetBSD_Version__ < 700000000
50 # define HAVE_TZALLOC_BUG true
51 # endif
52 #endif
53 #ifndef HAVE_TZALLOC_BUG
54 # define HAVE_TZALLOC_BUG false
55 #endif
56
57 enum { TM_YEAR_BASE = 1900 };
58
59 #ifndef HAVE_TM_GMTOFF
60 # define HAVE_TM_GMTOFF false
61 #endif
62
63 #ifndef TIME_T_MIN
64 # define TIME_T_MIN TYPE_MINIMUM (time_t)
65 #endif
66 #ifndef TIME_T_MAX
67 # define TIME_T_MAX TYPE_MAXIMUM (time_t)
68 #endif
69
70 /* Compile with -DFASTER_TIMEFNS=0 to disable common optimizations and
71 allow easier testing of some slow-path code. */
72 #ifndef FASTER_TIMEFNS
73 # define FASTER_TIMEFNS 1
74 #endif
75
76 /* current-time-list defaults to t, typically generating (HI LO US PS)
77 timestamps. To change the default to nil, generating (TICKS . HZ)
78 timestamps, compile with -DCURRENT_TIME_LIST=0. */
79 #ifndef CURRENT_TIME_LIST
80 enum { CURRENT_TIME_LIST = true };
81 #endif
82
83 #if FIXNUM_OVERFLOW_P (1000000000)
84 static Lisp_Object timespec_hz;
85 #else
86 # define timespec_hz make_fixnum (TIMESPEC_HZ)
87 #endif
88
89 #define TRILLION 1000000000000
90 #if FIXNUM_OVERFLOW_P (TRILLION)
91 static Lisp_Object trillion;
92 # define ztrillion (*xbignum_val (trillion))
93 #else
94 # define trillion make_fixnum (TRILLION)
95 # if ULONG_MAX < TRILLION || !FASTER_TIMEFNS
96 mpz_t ztrillion;
97 # endif
98 #endif
99
100 /* True if the nonzero Lisp integer HZ divides evenly into a trillion. */
101 static bool
102 trillion_factor (Lisp_Object hz)
103 {
104 if (FASTER_TIMEFNS)
105 {
106 if (FIXNUMP (hz))
107 return TRILLION % XFIXNUM (hz) == 0;
108 if (!FIXNUM_OVERFLOW_P (TRILLION))
109 return false;
110 }
111 verify (TRILLION <= INTMAX_MAX);
112 intmax_t ihz;
113 return integer_to_intmax (hz, &ihz) && TRILLION % ihz == 0;
114 }
115
116 /* Return a struct timeval that is roughly equivalent to T.
117 Use the least timeval not less than T.
118 Return an extremal value if the result would overflow. */
119 struct timeval
120 make_timeval (struct timespec t)
121 {
122 struct timeval tv;
123 tv.tv_sec = t.tv_sec;
124 tv.tv_usec = t.tv_nsec / 1000;
125
126 if (t.tv_nsec % 1000 != 0)
127 {
128 if (tv.tv_usec < 999999)
129 tv.tv_usec++;
130 else if (tv.tv_sec < TIME_T_MAX)
131 {
132 tv.tv_sec++;
133 tv.tv_usec = 0;
134 }
135 }
136
137 return tv;
138 }
139
140 /* Yield A's UTC offset, or an unspecified value if unknown. */
141 static long int
142 tm_gmtoff (struct tm *a)
143 {
144 #if HAVE_TM_GMTOFF
145 return a->tm_gmtoff;
146 #else
147 return 0;
148 #endif
149 }
150
151 /* Yield A - B, measured in seconds.
152 This function is copied from the GNU C Library. */
153 static int
154 tm_diff (struct tm *a, struct tm *b)
155 {
156 /* Compute intervening leap days correctly even if year is negative.
157 Take care to avoid int overflow in leap day calculations,
158 but it's OK to assume that A and B are close to each other. */
159 int a4 = (a->tm_year >> 2) + (TM_YEAR_BASE >> 2) - ! (a->tm_year & 3);
160 int b4 = (b->tm_year >> 2) + (TM_YEAR_BASE >> 2) - ! (b->tm_year & 3);
161 int a100 = a4 / 25 - (a4 % 25 < 0);
162 int b100 = b4 / 25 - (b4 % 25 < 0);
163 int a400 = a100 >> 2;
164 int b400 = b100 >> 2;
165 int intervening_leap_days = (a4 - b4) - (a100 - b100) + (a400 - b400);
166 int years = a->tm_year - b->tm_year;
167 int days = (365 * years + intervening_leap_days
168 + (a->tm_yday - b->tm_yday));
169 return (60 * (60 * (24 * days + (a->tm_hour - b->tm_hour))
170 + (a->tm_min - b->tm_min))
171 + (a->tm_sec - b->tm_sec));
172 }
173
174 enum { tzeqlen = sizeof "TZ=" - 1 };
175
176 /* Time zones equivalent to current local time and to UTC, respectively. */
177 static timezone_t local_tz;
178 static timezone_t const utc_tz = 0;
179
180 static struct tm *
181 emacs_localtime_rz (timezone_t tz, time_t const *t, struct tm *tm)
182 {
183 #ifdef WINDOWSNT
184 /* The Windows CRT functions are "optimized for speed", so they don't
185 check for timezone and DST changes if they were last called less
186 than 1 minute ago (see http://support.microsoft.com/kb/821231).
187 So all Emacs features that repeatedly call time functions (e.g.,
188 display-time) are in real danger of missing timezone and DST
189 changes. Calling tzset before each localtime call fixes that. */
190 tzset ();
191 #endif
192 tm = localtime_rz (tz, t, tm);
193 if (!tm && errno == ENOMEM)
194 memory_full (SIZE_MAX);
195 return tm;
196 }
197
198 static AVOID
199 invalid_time_zone_specification (Lisp_Object zone)
200 {
201 xsignal2 (Qerror, build_string ("Invalid time zone specification"), zone);
202 }
203
204 /* Free a timezone, except do not free the time zone for local time.
205 Freeing utc_tz is also a no-op. */
206 static void
207 xtzfree (timezone_t tz)
208 {
209 if (tz != local_tz)
210 tzfree (tz);
211 }
212
213 /* Convert the Lisp time zone rule ZONE to a timezone_t object.
214 The returned value either is 0, or is LOCAL_TZ, or is newly allocated.
215 If SETTZ, set Emacs local time to the time zone rule; otherwise,
216 the caller should eventually pass the returned value to xtzfree. */
217 static timezone_t
218 tzlookup (Lisp_Object zone, bool settz)
219 {
220 static char const tzbuf_format[] = "<%+.*"pI"d>%s%"pI"d:%02d:%02d";
221 char const *trailing_tzbuf_format = tzbuf_format + sizeof "<%+.*"pI"d" - 1;
222 char tzbuf[sizeof tzbuf_format + 2 * INT_STRLEN_BOUND (EMACS_INT)];
223 char const *zone_string;
224 timezone_t new_tz;
225
226 if (NILP (zone))
227 return local_tz;
228 else if (BASE_EQ (zone, make_fixnum (0)) || BASE2_EQ (zone, Qt))
229 {
230 zone_string = "UTC0";
231 new_tz = utc_tz;
232 }
233 else
234 {
235 bool plain_integer = FIXNUMP (zone);
236
237 if (BASE2_EQ (zone, Qwall))
238 zone_string = 0;
239 else if (STRINGP (zone))
240 zone_string = SSDATA (ENCODE_SYSTEM (zone));
241 else if (plain_integer || (CONSP (zone) && FIXNUMP (XCAR (zone))
242 && CONSP (XCDR (zone))))
243 {
244 Lisp_Object abbr UNINIT;
245 if (!plain_integer)
246 {
247 abbr = XCAR (XCDR (zone));
248 zone = XCAR (zone);
249 }
250
251 EMACS_INT abszone = eabs (XFIXNUM (zone)), hour = abszone / (60 * 60);
252 int hour_remainder = abszone % (60 * 60);
253 int min = hour_remainder / 60, sec = hour_remainder % 60;
254
255 if (plain_integer)
256 {
257 int prec = 2;
258 EMACS_INT numzone = hour;
259 if (hour_remainder != 0)
260 {
261 prec += 2, numzone = 100 * numzone + min;
262 if (sec != 0)
263 prec += 2, numzone = 100 * numzone + sec;
264 }
265 sprintf (tzbuf, tzbuf_format, prec,
266 XFIXNUM (zone) < 0 ? -numzone : numzone,
267 &"-"[XFIXNUM (zone) < 0], hour, min, sec);
268 zone_string = tzbuf;
269 }
270 else
271 {
272 AUTO_STRING (leading, "<");
273 AUTO_STRING_WITH_LEN (trailing, tzbuf,
274 sprintf (tzbuf, trailing_tzbuf_format,
275 &"-"[XFIXNUM (zone) < 0],
276 hour, min, sec));
277 zone_string = SSDATA (concat3 (leading, ENCODE_SYSTEM (abbr),
278 trailing));
279 }
280 }
281 else
282 invalid_time_zone_specification (zone);
283
284 new_tz = tzalloc (zone_string);
285
286 if (HAVE_TZALLOC_BUG && !new_tz && errno != ENOMEM && plain_integer
287 && XFIXNUM (zone) % (60 * 60) == 0)
288 {
289 /* tzalloc mishandles POSIX strings; fall back on tzdb if
290 possible (Bug#30738). */
291 sprintf (tzbuf, "Etc/GMT%+"pI"d", - (XFIXNUM (zone) / (60 * 60)));
292 new_tz = tzalloc (zone_string);
293 }
294
295 if (!new_tz)
296 {
297 if (errno == ENOMEM)
298 memory_full (SIZE_MAX);
299 invalid_time_zone_specification (zone);
300 }
301 }
302
303 if (settz)
304 {
305 block_input ();
306 emacs_setenv_TZ (zone_string);
307 tzset ();
308 timezone_t old_tz = local_tz;
309 local_tz = new_tz;
310 tzfree (old_tz);
311 unblock_input ();
312 }
313
314 return new_tz;
315 }
316
317 void
318 init_timefns (void)
319 {
320 #ifdef HAVE_UNEXEC
321 /* A valid but unlikely setting for the TZ environment variable.
322 It is OK (though a bit slower) if the user chooses this value. */
323 static char dump_tz_string[] = "TZ=UtC0";
324
325 /* When just dumping out, set the time zone to a known unlikely value
326 and skip the rest of this function. */
327 if (will_dump_with_unexec_p ())
328 {
329 xputenv (dump_tz_string);
330 tzset ();
331 return;
332 }
333 #endif
334
335 char *tz = getenv ("TZ");
336
337 #ifdef HAVE_UNEXEC
338 /* If the execution TZ happens to be the same as the dump TZ,
339 change it to some other value and then change it back,
340 to force the underlying implementation to reload the TZ info.
341 This is needed on implementations that load TZ info from files,
342 since the TZ file contents may differ between dump and execution. */
343 if (tz && strcmp (tz, &dump_tz_string[tzeqlen]) == 0)
344 {
345 ++*tz;
346 tzset ();
347 --*tz;
348 }
349 #endif
350
351 /* Set the time zone rule now, so that the call to putenv is done
352 before multiple threads are active. */
353 tzlookup (tz ? build_string (tz) : Qwall, true);
354 }
355
356 /* Report that a time value is out of range for Emacs. */
357 static AVOID
358 time_overflow (void)
359 {
360 error ("Specified time is not representable");
361 }
362
363 static AVOID
364 time_error (int err)
365 {
366 switch (err)
367 {
368 case ENOMEM: memory_full (SIZE_MAX);
369 case EOVERFLOW: time_overflow ();
370 default: error ("Invalid time specification");
371 }
372 }
373
374 static AVOID
375 invalid_hz (Lisp_Object hz)
376 {
377 xsignal2 (Qerror, build_string ("Invalid time frequency"), hz);
378 }
379
380 /* Return the upper part of the time T (everything but the bottom 16 bits). */
381 static Lisp_Object
382 hi_time (time_t t)
383 {
384 return INT_TO_INTEGER (t >> LO_TIME_BITS);
385 }
386
387 /* Return the bottom bits of the time T. */
388 static Lisp_Object
389 lo_time (time_t t)
390 {
391 return make_fixnum (t & ((1 << LO_TIME_BITS) - 1));
392 }
393
394 /* When converting a double to a fraction TICKS / HZ, HZ is equal to
395 FLT_RADIX * P where 0 <= P < FLT_RADIX_POWER_SIZE. The tiniest
396 nonzero double uses the maximum P. */
397 enum { flt_radix_power_size = DBL_MANT_DIG - DBL_MIN_EXP + 1 };
398
399 /* A integer vector of size flt_radix_power_size. The Pth entry
400 equals FLT_RADIX**P. */
401 static Lisp_Object flt_radix_power;
402
403 /* Convert the finite number T into an Emacs time *RESULT, truncating
404 toward minus infinity. Signal an error if unsuccessful. */
405 static void
406 decode_float_time (double t, struct lisp_time *result)
407 {
408 Lisp_Object ticks, hz;
409 if (t == 0)
410 {
411 ticks = make_fixnum (0);
412 hz = make_fixnum (1);
413 }
414 else
415 {
416 int scale = double_integer_scale (t);
417 /* FIXME: `double_integer_scale` often returns values that are
418 "pessimistic" (i.e. larger than necessary), so 3.5 gets converted
419 to (7881299347898368 . 2251799813685248) rather than (7 . 2).
420 On 64bit systems, this should not matter very much, tho. */
421 eassume (scale < flt_radix_power_size);
422
423 if (scale < 0)
424 {
425 /* T is finite but so large that HZ would be less than 1 if
426 T's precision were represented exactly. SCALE must be
427 nonnegative, as the (TICKS . HZ) representation requires
428 HZ to be at least 1. So use SCALE = 0, which converts T to
429 (T . 1), which is the exact numeric value with too-large HZ,
430 which is typically better than signaling overflow. */
431 scale = 0;
432 }
433
434 /* Compute TICKS, HZ such that TICKS / HZ exactly equals T, where HZ is
435 T's frequency or 1, whichever is greater. Here, “frequency” means
436 1/precision. Cache HZ values in flt_radix_power. */
437 double scaled = scalbn (t, scale);
438 eassert (trunc (scaled) == scaled);
439 ticks = double_to_integer (scaled);
440 hz = AREF (flt_radix_power, scale);
441 if (NILP (hz))
442 {
443 mpz_ui_pow_ui (mpz[0], FLT_RADIX, scale);
444 hz = make_integer_mpz ();
445 ASET (flt_radix_power, scale, hz);
446 }
447 }
448 result->ticks = ticks;
449 result->hz = hz;
450 }
451
452 /* Make a 4-element timestamp (HI LO US PS) from TICKS and HZ.
453 Drop any excess precision. */
454 static Lisp_Object
455 ticks_hz_list4 (Lisp_Object ticks, Lisp_Object hz)
456 {
457 /* mpz[0] = floor ((ticks * trillion) / hz). */
458 mpz_t const *zticks = bignum_integer (&mpz[0], ticks);
459 #if FASTER_TIMEFNS && TRILLION <= ULONG_MAX
460 mpz_mul_ui (mpz[0], *zticks, TRILLION);
461 #else
462 mpz_mul (mpz[0], *zticks, ztrillion);
463 #endif
464 mpz_fdiv_q (mpz[0], mpz[0], *bignum_integer (&mpz[1], hz));
465
466 /* mpz[0] = floor (mpz[0] / trillion), with US = the high six digits of the
467 12-digit remainder, and PS = the low six digits. */
468 #if FASTER_TIMEFNS && TRILLION <= ULONG_MAX
469 unsigned long int fullps = mpz_fdiv_q_ui (mpz[0], mpz[0], TRILLION);
470 int us = fullps / 1000000;
471 int ps = fullps % 1000000;
472 #else
473 mpz_fdiv_qr (mpz[0], mpz[1], mpz[0], ztrillion);
474 int ps = mpz_fdiv_q_ui (mpz[1], mpz[1], 1000000);
475 int us = mpz_get_ui (mpz[1]);
476 #endif
477
478 /* mpz[0] = floor (mpz[0] / 1 << LO_TIME_BITS), with lo = remainder. */
479 unsigned long ulo = mpz_get_ui (mpz[0]);
480 if (mpz_sgn (mpz[0]) < 0)
481 ulo = -ulo;
482 int lo = ulo & ((1 << LO_TIME_BITS) - 1);
483 mpz_fdiv_q_2exp (mpz[0], mpz[0], LO_TIME_BITS);
484
485 return list4 (make_integer_mpz (), make_fixnum (lo),
486 make_fixnum (us), make_fixnum (ps));
487 }
488
489 /* Set ROP to T. */
490 static void
491 mpz_set_time (mpz_t rop, time_t t)
492 {
493 if (EXPR_SIGNED (t))
494 mpz_set_intmax (rop, t);
495 else
496 mpz_set_uintmax (rop, t);
497 }
498
499 /* Store into mpz[0] a clock tick count for T, assuming a
500 TIMESPEC_HZ-frequency clock. Use mpz[1] as a temp. */
501 static void
502 timespec_mpz (struct timespec t)
503 {
504 /* mpz[0] = sec * TIMESPEC_HZ + nsec. */
505 mpz_set_ui (mpz[0], t.tv_nsec);
506 mpz_set_time (mpz[1], t.tv_sec);
507 mpz_addmul_ui (mpz[0], mpz[1], TIMESPEC_HZ);
508 }
509
510 /* Convert T to a Lisp integer counting TIMESPEC_HZ ticks. */
511 static Lisp_Object
512 timespec_ticks (struct timespec t)
513 {
514 /* For speed, use intmax_t arithmetic if it will do. */
515 intmax_t accum;
516 if (FASTER_TIMEFNS
517 && !INT_MULTIPLY_WRAPV (t.tv_sec, TIMESPEC_HZ, &accum)
518 && !INT_ADD_WRAPV (t.tv_nsec, accum, &accum))
519 return make_int (accum);
520
521 /* Fall back on bignum arithmetic. */
522 timespec_mpz (t);
523 return make_integer_mpz ();
524 }
525
526 /* Convert T to a Lisp integer counting HZ ticks, taking the floor.
527 Assume T is valid, but check HZ. */
528 static Lisp_Object
529 lisp_time_hz_ticks (struct lisp_time t, Lisp_Object hz)
530 {
531 /* The idea is to return the floor of ((T.ticks * HZ) / T.hz). */
532
533 /* For speed, just return T.ticks if T.hz == HZ. */
534 if (FASTER_TIMEFNS && BASE_EQ (t.hz, hz))
535 return t.ticks;
536
537 /* Check HZ for validity. */
538 if (FIXNUMP (hz))
539 {
540 if (XFIXNUM (hz) <= 0)
541 invalid_hz (hz);
542
543 /* For speed, use intmax_t arithmetic if it will do. */
544 intmax_t ticks;
545 if (FASTER_TIMEFNS && FIXNUMP (t.ticks) && FIXNUMP (t.hz)
546 && !INT_MULTIPLY_WRAPV (XFIXNUM (t.ticks), XFIXNUM (hz), &ticks))
547 return make_int (ticks / XFIXNUM (t.hz)
548 - (ticks % XFIXNUM (t.hz) < 0));
549 }
550 else if (! (BIGNUMP (hz) && 0 < mpz_sgn (*xbignum_val (hz))))
551 invalid_hz (hz);
552
553 /* Fall back on bignum arithmetic. */
554 mpz_mul (mpz[0],
555 *bignum_integer (&mpz[0], t.ticks),
556 *bignum_integer (&mpz[1], hz));
557 mpz_fdiv_q (mpz[0], mpz[0], *bignum_integer (&mpz[1], t.hz));
558 return make_integer_mpz ();
559 }
560
561 /* Convert T to a Lisp integer counting seconds, taking the floor. */
562 static Lisp_Object
563 lisp_time_seconds (struct lisp_time t)
564 {
565 /* The idea is to return the floor of T.ticks / T.hz. */
566
567 if (!FASTER_TIMEFNS)
568 return lisp_time_hz_ticks (t, make_fixnum (1));
569
570 /* For speed, use EMACS_INT arithmetic if it will do. */
571 if (FIXNUMP (t.ticks) && FIXNUMP (t.hz))
572 return make_fixnum (XFIXNUM (t.ticks) / XFIXNUM (t.hz)
573 - (XFIXNUM (t.ticks) % XFIXNUM (t.hz) < 0));
574
575 /* For speed, inline what lisp_time_hz_ticks would do. */
576 mpz_fdiv_q (mpz[0],
577 *bignum_integer (&mpz[0], t.ticks),
578 *bignum_integer (&mpz[1], t.hz));
579 return make_integer_mpz ();
580 }
581
582 /* Convert T to a Lisp timestamp. */
583 Lisp_Object
584 make_lisp_time (struct timespec t)
585 {
586 if (current_time_list)
587 {
588 time_t s = t.tv_sec;
589 int ns = t.tv_nsec;
590 return list4 (hi_time (s), lo_time (s),
591 make_fixnum (ns / 1000), make_fixnum (ns % 1000 * 1000));
592 }
593 else
594 return timespec_to_lisp (t);
595 }
596
597 /* Return (TICKS . HZ) for time T. */
598 Lisp_Object
599 timespec_to_lisp (struct timespec t)
600 {
601 return Fcons (timespec_ticks (t), timespec_hz);
602 }
603
604 /* Return NUMERATOR / DENOMINATOR, rounded to the nearest double.
605 Arguments must be Lisp integers, and DENOMINATOR must be positive. */
606 static double
607 frac_to_double (Lisp_Object numerator, Lisp_Object denominator)
608 {
609 intmax_t intmax_numerator, intmax_denominator;
610 if (FASTER_TIMEFNS
611 && integer_to_intmax (numerator, &intmax_numerator)
612 && integer_to_intmax (denominator, &intmax_denominator)
613 && intmax_numerator % intmax_denominator == 0)
614 return intmax_numerator / intmax_denominator;
615
616 /* Compute number of base-FLT_RADIX digits in numerator and denominator. */
617 mpz_t const *n = bignum_integer (&mpz[0], numerator);
618 mpz_t const *d = bignum_integer (&mpz[1], denominator);
619 ptrdiff_t ndig = mpz_sizeinbase (*n, FLT_RADIX);
620 ptrdiff_t ddig = mpz_sizeinbase (*d, FLT_RADIX);
621
622 /* Scale with SCALE when doing integer division. That is, compute
623 (N * FLT_RADIX**SCALE) / D [or, if SCALE is negative, N / (D *
624 FLT_RADIX**-SCALE)] as a bignum, convert the bignum to double,
625 then divide the double by FLT_RADIX**SCALE. First scale N
626 (or scale D, if SCALE is negative) ... */
627 ptrdiff_t scale = ddig - ndig + DBL_MANT_DIG;
628 if (scale < 0)
629 {
630 mpz_mul_2exp (mpz[1], *d, - (scale * LOG2_FLT_RADIX));
631 d = &mpz[1];
632 }
633 else
634 {
635 /* min so we don't scale tiny numbers as if they were normalized. */
636 scale = min (scale, flt_radix_power_size - 1);
637
638 mpz_mul_2exp (mpz[0], *n, scale * LOG2_FLT_RADIX);
639 n = &mpz[0];
640 }
641 /* ... and then divide, with quotient Q and remainder R. */
642 mpz_t *q = &mpz[2];
643 mpz_t *r = &mpz[3];
644 mpz_tdiv_qr (*q, *r, *n, *d);
645
646 /* The amount to add to the absolute value of Q so that truncating
647 it to double will round correctly. */
648 int incr;
649
650 /* Round the quotient before converting it to double.
651 If the quotient is less than FLT_RADIX ** DBL_MANT_DIG,
652 round to the nearest integer; otherwise, it is less than
653 FLT_RADIX ** (DBL_MANT_DIG + 1) and round it to the nearest
654 multiple of FLT_RADIX. Break ties to even. */
655 if (mpz_sizeinbase (*q, FLT_RADIX) <= DBL_MANT_DIG)
656 {
657 /* Converting to double will use the whole quotient so add 1 to
658 its absolute value as per round-to-even; i.e., if the doubled
659 remainder exceeds the denominator, or exactly equals the
660 denominator and adding 1 would make the quotient even. */
661 mpz_mul_2exp (*r, *r, 1);
662 int cmp = mpz_cmpabs (*r, *d);
663 incr = cmp > 0 || (cmp == 0 && (FASTER_TIMEFNS && FLT_RADIX == 2
664 ? mpz_odd_p (*q)
665 : mpz_tdiv_ui (*q, FLT_RADIX) & 1));
666 }
667 else
668 {
669 /* Converting to double will discard the quotient's low-order digit,
670 so add FLT_RADIX to its absolute value as per round-to-even. */
671 int lo_2digits = mpz_tdiv_ui (*q, FLT_RADIX * FLT_RADIX);
672 eassume (0 <= lo_2digits && lo_2digits < FLT_RADIX * FLT_RADIX);
673 int lo_digit = lo_2digits % FLT_RADIX;
674 incr = ((lo_digit > FLT_RADIX / 2
675 || (lo_digit == FLT_RADIX / 2 && FLT_RADIX % 2 == 0
676 && ((lo_2digits / FLT_RADIX) & 1
677 || mpz_sgn (*r) != 0)))
678 ? FLT_RADIX : 0);
679 }
680
681 /* Increment the absolute value of the quotient by INCR. */
682 if (!FASTER_TIMEFNS || incr != 0)
683 (mpz_sgn (*n) < 0 ? mpz_sub_ui : mpz_add_ui) (*q, *q, incr);
684
685 /* Rescale the integer Q back to double. This step does not round. */
686 return scalbn (mpz_get_d (*q), -scale);
687 }
688
689 /* From a valid timestamp (TICKS . HZ), generate the corresponding
690 time values.
691
692 If RESULT is not null, store into *RESULT the converted time.
693 Otherwise, store into *DRESULT the number of seconds since the
694 start of the POSIX Epoch.
695
696 Return zero, which indicates success. */
697 static int
698 decode_ticks_hz (Lisp_Object ticks, Lisp_Object hz,
699 struct lisp_time *result, double *dresult)
700 {
701 if (result)
702 {
703 result->ticks = ticks;
704 result->hz = hz;
705 }
706 else
707 *dresult = frac_to_double (ticks, hz);
708 return 0;
709 }
710
711 /* Lisp timestamp classification. */
712 enum timeform
713 {
714 TIMEFORM_INVALID = 0,
715 TIMEFORM_HI_LO, /* seconds in the form (HI << LO_TIME_BITS) + LO. */
716 TIMEFORM_HI_LO_US, /* seconds plus microseconds (HI LO US) */
717 TIMEFORM_NIL, /* current time in nanoseconds */
718 TIMEFORM_HI_LO_US_PS, /* seconds plus micro and picoseconds (HI LO US PS) */
719 TIMEFORM_FLOAT, /* time as a float */
720 TIMEFORM_TICKS_HZ /* fractional time: HI is ticks, LO is ticks per second */
721 };
722
723 /* From the non-float form FORM and the time components HIGH, LOW, USEC
724 and PSEC, generate the corresponding time value. If LOW is
725 floating point, the other components should be zero and FORM should
726 not be TIMEFORM_TICKS_HZ.
727
728 If RESULT is not null, store into *RESULT the converted time.
729 Otherwise, store into *DRESULT the number of seconds since the
730 start of the POSIX Epoch. Unsuccessful calls may or may not store
731 results.
732
733 Return zero if successful, an error number otherwise. */
734 static int
735 decode_time_components (enum timeform form,
736 Lisp_Object high, Lisp_Object low,
737 Lisp_Object usec, Lisp_Object psec,
738 struct lisp_time *result, double *dresult)
739 {
740 switch (form)
741 {
742 case TIMEFORM_INVALID:
743 return EINVAL;
744
745 case TIMEFORM_TICKS_HZ:
746 if (INTEGERP (high)
747 && !NILP (Fnatnump (low)) && !BASE_EQ (low, make_fixnum (0)))
748 return decode_ticks_hz (high, low, result, dresult);
749 return EINVAL;
750
751 case TIMEFORM_FLOAT:
752 eassume (false);
753
754 case TIMEFORM_NIL:
755 return decode_ticks_hz (timespec_ticks (current_timespec ()),
756 timespec_hz, result, dresult);
757
758 default:
759 break;
760 }
761
762 if (! (INTEGERP (high) && INTEGERP (low)
763 && FIXNUMP (usec) && FIXNUMP (psec)))
764 return EINVAL;
765 EMACS_INT us = XFIXNUM (usec);
766 EMACS_INT ps = XFIXNUM (psec);
767
768 /* Normalize out-of-range lower-order components by carrying
769 each overflow into the next higher-order component. */
770 us += ps / 1000000 - (ps % 1000000 < 0);
771 mpz_t *s = &mpz[1];
772 mpz_set_intmax (*s, us / 1000000 - (us % 1000000 < 0));
773 mpz_add (*s, *s, *bignum_integer (&mpz[0], low));
774 mpz_addmul_ui (*s, *bignum_integer (&mpz[0], high), 1 << LO_TIME_BITS);
775 ps = ps % 1000000 + 1000000 * (ps % 1000000 < 0);
776 us = us % 1000000 + 1000000 * (us % 1000000 < 0);
777
778 Lisp_Object hz;
779 switch (form)
780 {
781 case TIMEFORM_HI_LO:
782 /* Floats and nil were handled above, so it was an integer. */
783 mpz_swap (mpz[0], *s);
784 hz = make_fixnum (1);
785 break;
786
787 case TIMEFORM_HI_LO_US:
788 mpz_set_ui (mpz[0], us);
789 mpz_addmul_ui (mpz[0], *s, 1000000);
790 hz = make_fixnum (1000000);
791 break;
792
793 case TIMEFORM_HI_LO_US_PS:
794 {
795 #if FASTER_TIMEFNS && TRILLION <= ULONG_MAX
796 unsigned long i = us;
797 mpz_set_ui (mpz[0], i * 1000000 + ps);
798 mpz_addmul_ui (mpz[0], *s, TRILLION);
799 #else
800 intmax_t i = us;
801 mpz_set_intmax (mpz[0], i * 1000000 + ps);
802 mpz_addmul (mpz[0], *s, ztrillion);
803 #endif
804 hz = trillion;
805 }
806 break;
807
808 default:
809 eassume (false);
810 }
811
812 return decode_ticks_hz (make_integer_mpz (), hz, result, dresult);
813 }
814
815 /* Decode a Lisp timestamp SPECIFIED_TIME that represents a time.
816
817 If DECODE_SECS_ONLY, ignore and do not validate any sub-second
818 components of an old-format SPECIFIED_TIME.
819
820 If RESULT is not null, store into *RESULT the converted time;
821 otherwise, store into *DRESULT the number of seconds since the
822 start of the POSIX Epoch. Unsuccessful calls may or may not store
823 results.
824
825 Return the form of SPECIFIED-TIME. Signal an error if unsuccessful. */
826 static enum timeform
827 decode_lisp_time (Lisp_Object specified_time, bool decode_secs_only,
828 struct lisp_time *result, double *dresult)
829 {
830 Lisp_Object high = make_fixnum (0);
831 Lisp_Object low = specified_time;
832 Lisp_Object usec = make_fixnum (0);
833 Lisp_Object psec = make_fixnum (0);
834 enum timeform form = TIMEFORM_HI_LO;
835
836 if (NILP (specified_time))
837 form = TIMEFORM_NIL;
838 else if (CONSP (specified_time))
839 {
840 high = XCAR (specified_time);
841 low = XCDR (specified_time);
842 if (CONSP (low))
843 {
844 Lisp_Object low_tail = XCDR (low);
845 low = XCAR (low);
846 if (! decode_secs_only)
847 {
848 if (CONSP (low_tail))
849 {
850 usec = XCAR (low_tail);
851 low_tail = XCDR (low_tail);
852 if (CONSP (low_tail))
853 {
854 psec = XCAR (low_tail);
855 form = TIMEFORM_HI_LO_US_PS;
856 }
857 else
858 form = TIMEFORM_HI_LO_US;
859 }
860 else if (!NILP (low_tail))
861 {
862 usec = low_tail;
863 form = TIMEFORM_HI_LO_US;
864 }
865 }
866 }
867 else
868 {
869 form = TIMEFORM_TICKS_HZ;
870 }
871
872 /* Require LOW to be an integer, as otherwise the computation
873 would be considerably trickier. */
874 if (! INTEGERP (low))
875 form = TIMEFORM_INVALID;
876 }
877 else if (FASTER_TIMEFNS && INTEGERP (specified_time))
878 {
879 decode_ticks_hz (specified_time, make_fixnum (1), result, dresult);
880 return form;
881 }
882 else if (FLOATP (specified_time))
883 {
884 double d = XFLOAT_DATA (specified_time);
885 if (!isfinite (d))
886 time_error (isnan (d) ? EDOM : EOVERFLOW);
887 if (result)
888 decode_float_time (d, result);
889 else
890 *dresult = d;
891 return TIMEFORM_FLOAT;
892 }
893
894 int err = decode_time_components (form, high, low, usec, psec,
895 result, dresult);
896 if (err)
897 time_error (err);
898 return form;
899 }
900
901 /* Convert a non-float Lisp timestamp SPECIFIED_TIME to double.
902 Signal an error if unsuccessful. */
903 double
904 float_time (Lisp_Object specified_time)
905 {
906 double t;
907 decode_lisp_time (specified_time, false, 0, &t);
908 return t;
909 }
910
911 /* Convert Z to time_t, returning true if it fits. */
912 static bool
913 mpz_time (mpz_t const z, time_t *t)
914 {
915 if (TYPE_SIGNED (time_t))
916 {
917 intmax_t i;
918 if (! (mpz_to_intmax (z, &i) && TIME_T_MIN <= i && i <= TIME_T_MAX))
919 return false;
920 *t = i;
921 }
922 else
923 {
924 uintmax_t i;
925 if (! (mpz_to_uintmax (z, &i) && i <= TIME_T_MAX))
926 return false;
927 *t = i;
928 }
929 return true;
930 }
931
932 /* Convert T to struct timespec, returning an invalid timespec
933 if T does not fit. */
934 static struct timespec
935 lisp_to_timespec (struct lisp_time t)
936 {
937 struct timespec result = invalid_timespec ();
938 int ns;
939 mpz_t *q = &mpz[0];
940 mpz_t const *qt = q;
941
942 /* Floor-divide (T.ticks * TIMESPEC_HZ) by T.hz,
943 yielding quotient Q (tv_sec) and remainder NS (tv_nsec).
944 Return an invalid timespec if Q does not fit in time_t.
945 For speed, prefer fixnum arithmetic if it works. */
946 if (FASTER_TIMEFNS && BASE_EQ (t.hz, timespec_hz))
947 {
948 if (FIXNUMP (t.ticks))
949 {
950 EMACS_INT s = XFIXNUM (t.ticks) / TIMESPEC_HZ;
951 ns = XFIXNUM (t.ticks) % TIMESPEC_HZ;
952 if (ns < 0)
953 s--, ns += TIMESPEC_HZ;
954 if ((TYPE_SIGNED (time_t) ? TIME_T_MIN <= s : 0 <= s)
955 && s <= TIME_T_MAX)
956 {
957 result.tv_sec = s;
958 result.tv_nsec = ns;
959 }
960 return result;
961 }
962 else
963 ns = mpz_fdiv_q_ui (*q, *xbignum_val (t.ticks), TIMESPEC_HZ);
964 }
965 else if (FASTER_TIMEFNS && BASE_EQ (t.hz, make_fixnum (1)))
966 {
967 ns = 0;
968 if (FIXNUMP (t.ticks))
969 {
970 EMACS_INT s = XFIXNUM (t.ticks);
971 if ((TYPE_SIGNED (time_t) ? TIME_T_MIN <= s : 0 <= s)
972 && s <= TIME_T_MAX)
973 {
974 result.tv_sec = s;
975 result.tv_nsec = ns;
976 }
977 return result;
978 }
979 else
980 qt = xbignum_val (t.ticks);
981 }
982 else
983 {
984 mpz_mul_ui (*q, *bignum_integer (q, t.ticks), TIMESPEC_HZ);
985 mpz_fdiv_q (*q, *q, *bignum_integer (&mpz[1], t.hz));
986 ns = mpz_fdiv_q_ui (*q, *q, TIMESPEC_HZ);
987 }
988
989 /* Check that Q fits in time_t, not merely in T.tv_sec. With some versions
990 of MinGW, tv_sec is a 64-bit type, whereas time_t is a 32-bit type. */
991 time_t sec;
992 if (mpz_time (*qt, &sec))
993 {
994 result.tv_sec = sec;
995 result.tv_nsec = ns;
996 }
997 return result;
998 }
999
1000 /* Convert (HIGH LOW USEC PSEC) to struct timespec.
1001 Return true if successful. */
1002 bool
1003 list4_to_timespec (Lisp_Object high, Lisp_Object low,
1004 Lisp_Object usec, Lisp_Object psec,
1005 struct timespec *result)
1006 {
1007 struct lisp_time t;
1008 if (decode_time_components (TIMEFORM_HI_LO_US_PS, high, low, usec, psec,
1009 &t, 0))
1010 return false;
1011 *result = lisp_to_timespec (t);
1012 return timespec_valid_p (*result);
1013 }
1014
1015 /* Decode a Lisp list SPECIFIED_TIME that represents a time.
1016 If SPECIFIED_TIME is nil, use the current time.
1017 Signal an error if SPECIFIED_TIME does not represent a time.
1018 If PFORM, store the time's form into *PFORM. */
1019 static struct lisp_time
1020 lisp_time_struct (Lisp_Object specified_time, enum timeform *pform)
1021 {
1022 struct lisp_time t;
1023 enum timeform form = decode_lisp_time (specified_time, false, &t, 0);
1024 if (pform)
1025 *pform = form;
1026 return t;
1027 }
1028
1029 /* Decode a Lisp list SPECIFIED_TIME that represents a time.
1030 Discard any low-order (sub-ns) resolution.
1031 If SPECIFIED_TIME is nil, use the current time.
1032 Signal an error if SPECIFIED_TIME does not represent a timespec. */
1033 struct timespec
1034 lisp_time_argument (Lisp_Object specified_time)
1035 {
1036 struct lisp_time lt = lisp_time_struct (specified_time, 0);
1037 struct timespec t = lisp_to_timespec (lt);
1038 if (! timespec_valid_p (t))
1039 time_overflow ();
1040 return t;
1041 }
1042
1043 /* Like lisp_time_argument, except decode only the seconds part, and
1044 do not check the subseconds part. */
1045 static time_t
1046 lisp_seconds_argument (Lisp_Object specified_time)
1047 {
1048 struct lisp_time lt;
1049 decode_lisp_time (specified_time, true, <, 0);
1050 struct timespec t = lisp_to_timespec (lt);
1051 if (! timespec_valid_p (t))
1052 time_overflow ();
1053 return t.tv_sec;
1054 }
1055
1056 /* Return the sum of the Lisp integers A and B.
1057 Subtract instead of adding if SUBTRACT.
1058 This function is tuned for small B. */
1059 static Lisp_Object
1060 lispint_arith (Lisp_Object a, Lisp_Object b, bool subtract)
1061 {
1062 bool mpz_done = false;
1063
1064 if (FASTER_TIMEFNS && FIXNUMP (b))
1065 {
1066 if (BASE_EQ (b, make_fixnum (0)))
1067 return a;
1068
1069 /* For speed, use EMACS_INT arithmetic if it will do. */
1070 if (FIXNUMP (a))
1071 return make_int (subtract
1072 ? XFIXNUM (a) - XFIXNUM (b)
1073 : XFIXNUM (a) + XFIXNUM (b));
1074
1075 /* For speed, use mpz_add_ui/mpz_sub_ui if it will do. */
1076 if (eabs (XFIXNUM (b)) <= ULONG_MAX)
1077 {
1078 ((XFIXNUM (b) < 0) == subtract ? mpz_add_ui : mpz_sub_ui)
1079 (mpz[0], *xbignum_val (a), eabs (XFIXNUM (b)));
1080 mpz_done = true;
1081 }
1082 }
1083
1084 /* Fall back on bignum arithmetic if necessary. */
1085 if (!mpz_done)
1086 (subtract ? mpz_sub : mpz_add) (mpz[0],
1087 *bignum_integer (&mpz[0], a),
1088 *bignum_integer (&mpz[1], b));
1089 return make_integer_mpz ();
1090 }
1091
1092 /* Given Lisp operands A and B, add their values, and return the
1093 result as a Lisp timestamp. Subtract instead of adding if SUBTRACT. */
1094 static Lisp_Object
1095 time_arith (Lisp_Object a, Lisp_Object b, bool subtract)
1096 {
1097 enum timeform aform, bform;
1098 struct lisp_time ta = lisp_time_struct (a, &aform);
1099 struct lisp_time tb = lisp_time_struct (b, &bform);
1100 Lisp_Object ticks, hz;
1101
1102 if (FASTER_TIMEFNS && BASE_EQ (ta.hz, tb.hz))
1103 {
1104 hz = ta.hz;
1105 ticks = lispint_arith (ta.ticks, tb.ticks, subtract);
1106 }
1107 else
1108 {
1109 /* The plan is to decompose ta into na/da and tb into nb/db.
1110 Start by computing da and db, their minimum (which will be
1111 needed later) and the iticks temporary that will become
1112 available once only their minimum is needed. */
1113 mpz_t const *da = bignum_integer (&mpz[1], ta.hz);
1114 mpz_t const *db = bignum_integer (&mpz[2], tb.hz);
1115 bool da_lt_db = mpz_cmp (*da, *db) < 0;
1116 mpz_t const *hzmin = da_lt_db ? da : db;
1117 mpz_t *iticks = &mpz[da_lt_db + 1];
1118
1119 /* The plan is to compute (na * (db/g) + nb * (da/g)) / lcm (da, db)
1120 where g = gcd (da, db). Start by computing g. */
1121 mpz_t *g = &mpz[3];
1122 mpz_gcd (*g, *da, *db);
1123
1124 /* fa = da/g, fb = db/g. */
1125 mpz_t *fa = &mpz[4], *fb = &mpz[3];
1126 mpz_divexact (*fa, *da, *g);
1127 mpz_divexact (*fb, *db, *g);
1128
1129 /* ihz = fa * db. This is equal to lcm (da, db). */
1130 mpz_t *ihz = &mpz[0];
1131 mpz_mul (*ihz, *fa, *db);
1132
1133 /* iticks = (fb * na) OP (fa * nb), where OP is + or -. */
1134 mpz_t const *na = bignum_integer (iticks, ta.ticks);
1135 mpz_mul (*iticks, *fb, *na);
1136 mpz_t const *nb = bignum_integer (&mpz[3], tb.ticks);
1137 (subtract ? mpz_submul : mpz_addmul) (*iticks, *fa, *nb);
1138
1139 /* Normalize iticks/ihz by dividing both numerator and
1140 denominator by ig = gcd (iticks, ihz). For speed, though,
1141 skip this division if ihz = 1. */
1142 mpz_t *ig = &mpz[3];
1143 mpz_gcd (*ig, *iticks, *ihz);
1144 if (!FASTER_TIMEFNS || mpz_cmp_ui (*ig, 1) > 0)
1145 {
1146 mpz_divexact (*iticks, *iticks, *ig);
1147 mpz_divexact (*ihz, *ihz, *ig);
1148
1149 /* However, if dividing the denominator by ig would cause the
1150 denominator to become less than hzmin, rescale the denominator
1151 upwards by multiplying the normalized numerator and denominator
1152 so that the resulting denominator becomes at least hzmin.
1153 This rescaling avoids returning a timestamp that is less precise
1154 than both a and b. */
1155 if (!FASTER_TIMEFNS || mpz_cmp (*ihz, *hzmin) < 0)
1156 {
1157 /* Rescale straightforwardly. Although this might not
1158 yield the minimal denominator that preserves numeric
1159 value and is at least hzmin, calculating such a
1160 denominator would be too expensive because it would
1161 require testing multisets of factors of lcm (da, db). */
1162 mpz_t *rescale = &mpz[3];
1163 mpz_cdiv_q (*rescale, *hzmin, *ihz);
1164 mpz_mul (*iticks, *iticks, *rescale);
1165 mpz_mul (*ihz, *ihz, *rescale);
1166 }
1167 }
1168
1169 /* mpz[0] and iticks now correspond to the (HZ . TICKS) pair. */
1170 hz = make_integer_mpz ();
1171 mpz_swap (mpz[0], *iticks);
1172 ticks = make_integer_mpz ();
1173 }
1174
1175 /* Return an integer if the timestamp resolution is 1,
1176 otherwise the (TICKS . HZ) form if !current_time_list or if
1177 either input used (TICKS . HZ) form or the result can't be expressed
1178 exactly in (HI LO US PS) form, otherwise the (HI LO US PS) form
1179 for backward compatibility. */
1180 return (BASE_EQ (hz, make_fixnum (1))
1181 ? ticks
1182 : (!current_time_list
1183 || aform == TIMEFORM_TICKS_HZ
1184 || bform == TIMEFORM_TICKS_HZ
1185 || !trillion_factor (hz))
1186 ? Fcons (ticks, hz)
1187 : ticks_hz_list4 (ticks, hz));
1188 }
1189
1190 DEFUN ("time-add", Ftime_add, Stime_add, 2, 2, 0,
1191 doc: /* Return the sum of two time values A and B, as a time value.
1192 See `format-time-string' for the various forms of a time value.
1193 For example, nil stands for the current time. */)
1194 (Lisp_Object a, Lisp_Object b)
1195 {
1196 return time_arith (a, b, false);
1197 }
1198
1199 DEFUN ("time-subtract", Ftime_subtract, Stime_subtract, 2, 2, 0,
1200 doc: /* Return the difference between two time values A and B, as a time value.
1201 You can use `float-time' to convert the difference into elapsed seconds.
1202 See `format-time-string' for the various forms of a time value.
1203 For example, nil stands for the current time. */)
1204 (Lisp_Object a, Lisp_Object b)
1205 {
1206 /* Subtract nil from nil correctly, and handle other eq values
1207 quicker while we're at it. This means (time-subtract X X) does
1208 not signal an error if X is not a valid time value, but that's OK. */
1209 if (BASE_EQ (a, b))
1210 return make_lisp_time ((struct timespec) {0});
1211
1212 return time_arith (a, b, true);
1213 }
1214
1215 /* Return negative, 0, positive if A < B, A == B, A > B respectively.
1216 A and B should be Lisp time values. */
1217 static EMACS_INT
1218 time_cmp (Lisp_Object a, Lisp_Object b)
1219 {
1220 /* Compare nil to nil correctly, and handle other eq values quicker
1221 while we're at it. This means (time-equal-p X X) does not signal
1222 an error if X is not a valid time value, but that's OK. */
1223 if (BASE_EQ (a, b))
1224 return 0;
1225
1226 /* Compare (X . Z) to (Y . Z) quickly if X and Y are fixnums.
1227 Do not inspect Z, as it is OK to not signal if A and B are invalid.
1228 Also, compare X to Y quickly if X and Y are fixnums. */
1229 if (FASTER_TIMEFNS)
1230 {
1231 Lisp_Object x = a, y = b;
1232 if (CONSP (a) && CONSP (b) && BASE_EQ (XCDR (a), XCDR (b)))
1233 x = XCAR (a), y = XCAR (b);
1234 if (FIXNUMP (x) && FIXNUMP (y))
1235 return XFIXNUM (x) - XFIXNUM (y);
1236 }
1237
1238 /* Compare (ATICKS . AZ) to (BTICKS . BHZ) by comparing
1239 ATICKS * BHZ to BTICKS * AHZ. */
1240 struct lisp_time ta = lisp_time_struct (a, 0);
1241 struct lisp_time tb = lisp_time_struct (b, 0);
1242 mpz_t const *za = bignum_integer (&mpz[0], ta.ticks);
1243 mpz_t const *zb = bignum_integer (&mpz[1], tb.ticks);
1244 if (! (FASTER_TIMEFNS && BASE_EQ (ta.hz, tb.hz)))
1245 {
1246 /* This could be sped up by looking at the signs, sizes, and
1247 number of bits of the two sides; see how GMP does mpq_cmp.
1248 It may not be worth the trouble here, though. */
1249 mpz_mul (mpz[0], *za, *bignum_integer (&mpz[2], tb.hz));
1250 mpz_mul (mpz[1], *zb, *bignum_integer (&mpz[2], ta.hz));
1251 za = &mpz[0];
1252 zb = &mpz[1];
1253 }
1254 return mpz_cmp (*za, *zb);
1255 }
1256
1257 DEFUN ("time-less-p", Ftime_less_p, Stime_less_p, 2, 2, 0,
1258 doc: /* Return non-nil if time value A is less than time value B.
1259 See `format-time-string' for the various forms of a time value.
1260 For example, nil stands for the current time. */)
1261 (Lisp_Object a, Lisp_Object b)
1262 {
1263 return time_cmp (a, b) < 0 ? Qt : Qnil;
1264 }
1265
1266 DEFUN ("time-equal-p", Ftime_equal_p, Stime_equal_p, 2, 2, 0,
1267 doc: /* Return non-nil if A and B are equal time values.
1268 See `format-time-string' for the various forms of a time value. */)
1269 (Lisp_Object a, Lisp_Object b)
1270 {
1271 /* A nil arg compares unequal to a non-nil arg. This also saves the
1272 expense of current_timespec if either arg is nil. */
1273 return NILP (a) == NILP (b) && time_cmp (a, b) == 0 ? Qt : Qnil;
1274 }
1275
1276
1277 DEFUN ("float-time", Ffloat_time, Sfloat_time, 0, 1, 0,
1278 doc: /* Return the current time, as a float number of seconds since the epoch.
1279 If SPECIFIED-TIME is given, it is a time value to convert to float
1280 instead of the current time. See `format-time-string' for the various
1281 forms of a time value.
1282
1283 WARNING: Since the result is floating point, it may not be exact.
1284 If precise time stamps are required, use either `time-convert',
1285 or (if you need time as a string) `format-time-string'. */)
1286 (Lisp_Object specified_time)
1287 {
1288 return (FLOATP (specified_time) ? specified_time
1289 : make_float (float_time (specified_time)));
1290 }
1291
1292 /* Write information into buffer S of size MAXSIZE, according to the
1293 FORMAT of length FORMAT_LEN, using time information taken from *TP.
1294 Use the time zone specified by TZ.
1295 Use NS as the number of nanoseconds in the %N directive.
1296 Return the number of bytes written, not including the terminating
1297 '\0'. If S is NULL, nothing will be written anywhere; so to
1298 determine how many bytes would be written, use NULL for S and
1299 ((size_t) -1) for MAXSIZE.
1300
1301 This function behaves like nstrftime, except it allows null
1302 bytes in FORMAT. */
1303 static size_t
1304 emacs_nmemftime (char *s, size_t maxsize, const char *format,
1305 size_t format_len, const struct tm *tp, timezone_t tz, int ns)
1306 {
1307 int saved_errno = errno;
1308 size_t total = 0;
1309
1310 /* Loop through all the null-terminated strings in the format
1311 argument. Normally there's just one null-terminated string, but
1312 there can be arbitrarily many, concatenated together, if the
1313 format contains '\0' bytes. nstrftime stops at the first
1314 '\0' byte so we must invoke it separately for each such string. */
1315 for (;;)
1316 {
1317 errno = 0;
1318 size_t result = nstrftime (s, maxsize, format, tp, tz, ns);
1319 if (result == 0 && errno != 0)
1320 return result;
1321 if (s)
1322 s += result + 1;
1323
1324 maxsize -= result + 1;
1325 total += result;
1326 size_t len = strlen (format);
1327 if (len == format_len)
1328 break;
1329 total++;
1330 format += len + 1;
1331 format_len -= len + 1;
1332 }
1333
1334 errno = saved_errno;
1335 return total;
1336 }
1337
1338 static Lisp_Object
1339 format_time_string (char const *format, ptrdiff_t formatlen,
1340 struct timespec t, Lisp_Object zone, struct tm *tmp)
1341 {
1342 char buffer[4000];
1343 char *buf = buffer;
1344 ptrdiff_t size = sizeof buffer;
1345 size_t len;
1346 int ns = t.tv_nsec;
1347 USE_SAFE_ALLOCA;
1348
1349 timezone_t tz = tzlookup (zone, false);
1350 /* On some systems, like 32-bit MinGW, tv_sec of struct timespec is
1351 a 64-bit type, but time_t is a 32-bit type. emacs_localtime_rz
1352 expects a pointer to time_t value. */
1353 time_t tsec = t.tv_sec;
1354 tmp = emacs_localtime_rz (tz, &tsec, tmp);
1355 if (! tmp)
1356 {
1357 int localtime_errno = errno;
1358 xtzfree (tz);
1359 time_error (localtime_errno);
1360 }
1361 synchronize_system_time_locale ();
1362
1363 while (true)
1364 {
1365 errno = 0;
1366 len = emacs_nmemftime (buf, size, format, formatlen, tmp, tz, ns);
1367 if (len != 0 || errno == 0)
1368 break;
1369 eassert (errno == ERANGE);
1370
1371 /* Buffer was too small, so make it bigger and try again. */
1372 len = emacs_nmemftime (NULL, SIZE_MAX, format, formatlen, tmp, tz, ns);
1373 if (STRING_BYTES_BOUND <= len)
1374 {
1375 xtzfree (tz);
1376 string_overflow ();
1377 }
1378 size = len + 1;
1379 buf = SAFE_ALLOCA (size);
1380 }
1381
1382 xtzfree (tz);
1383 AUTO_STRING_WITH_LEN (bufstring, buf, len);
1384 Lisp_Object result = code_convert_string_norecord (bufstring,
1385 Vlocale_coding_system, 0);
1386 SAFE_FREE ();
1387 return result;
1388 }
1389
1390 DEFUN ("format-time-string", Fformat_time_string, Sformat_time_string, 1, 3, 0,
1391 doc: /* Use FORMAT-STRING to format the time value TIME.
1392 A time value that is omitted or nil stands for the current time,
1393 a number stands for that many seconds, an integer pair (TICKS . HZ)
1394 stands for TICKS/HZ seconds, and an integer list (HI LO US PS) stands
1395 for HI*2**16 + LO + US/10**6 + PS/10**12 seconds. This function
1396 treats seconds as time since the epoch of 1970-01-01 00:00:00 UTC.
1397
1398 The optional ZONE is omitted or nil for Emacs local time, t for
1399 Universal Time, `wall' for system wall clock time, or a string as in
1400 the TZ environment variable. It can also be a list (as from
1401 `current-time-zone') or an integer (as from `decode-time') applied
1402 without consideration for daylight saving time.
1403
1404 The value is a copy of FORMAT-STRING, but with certain constructs replaced
1405 by text that describes the specified date and time in TIME:
1406
1407 %Y is the year, %y year without century, %C the century.
1408 %G is the year corresponding to the ISO week, %g year corresponding
1409 to the ISO week, without century.
1410 %m is the numeric month.
1411 %b and %h are the locale's abbreviated month name, %B the full name.
1412 (%h is not supported on MS-Windows.)
1413 %d is the day of the month, zero-padded, %e is blank-padded.
1414 %u is the numeric day of week from 1 (Monday) to 7, %w from 0 (Sunday) to 6.
1415 %a is the locale's abbreviated name of the day of week, %A the full name.
1416 %U is the week number starting on Sunday, %W starting on Monday,
1417 %V the week number according to ISO 8601.
1418 %j is the day of the year.
1419
1420 %H is the hour on a 24-hour clock, %I is on a 12-hour clock, %k is like %H
1421 only blank-padded, %l is like %I blank-padded.
1422 %p is the locale's equivalent of either AM or PM.
1423 %q is the calendar quarter (1–4).
1424 %M is the minute (00-59).
1425 %S is the second (00-59; 00-60 on platforms with leap seconds)
1426 %s is the number of seconds since 1970-01-01 00:00:00 +0000.
1427 %N is the nanosecond, %6N the microsecond, %3N the millisecond, etc.
1428 %Z is the time zone abbreviation, %z is the numeric form.
1429
1430 %c is the locale's date and time format.
1431 %x is the locale's "preferred" date format.
1432 %D is like "%m/%d/%y".
1433 %F is the ISO 8601 date format (like "%+4Y-%m-%d").
1434
1435 %R is like "%H:%M", %T is like "%H:%M:%S", %r is like "%I:%M:%S %p".
1436 %X is the locale's "preferred" time format.
1437
1438 Finally, %n is a newline, %t is a tab, %% is a literal %, and
1439 unrecognized %-sequences stand for themselves.
1440
1441 A %-sequence can contain optional flags, field width, and a modifier
1442 (in that order) after the `%'. The flags are:
1443
1444 `-' Do not pad the field.
1445 `_' Pad with spaces.
1446 `0' Pad with zeros.
1447 `+' Pad with zeros and put `+' before nonnegative year numbers with >4 digits.
1448 `^' Use upper case characters if possible.
1449 `#' Use opposite case characters if possible.
1450
1451 A field width N is an unsigned decimal integer with a leading digit
1452 nonzero. %NX is like %X, but takes up at least N positions. The
1453 field width is (on GNU/Linux and some other systems) in measured in
1454 bytes, not characters. It depends on the locale what the width (in
1455 characters) %NX will end up being, especially when there are non-ASCII
1456 characters in %X.
1457
1458 The modifiers are:
1459
1460 `E' Use the locale's alternative version.
1461 `O' Use the locale's number symbols.
1462
1463 For example, to produce full ISO 8601 format, use "%FT%T%z".
1464
1465 usage: (format-time-string FORMAT-STRING &optional TIME ZONE) */)
1466 (Lisp_Object format_string, Lisp_Object timeval, Lisp_Object zone)
1467 {
1468 struct timespec t = lisp_time_argument (timeval);
1469 struct tm tm;
1470
1471 CHECK_STRING (format_string);
1472 format_string = code_convert_string_norecord (format_string,
1473 Vlocale_coding_system, 1);
1474 return format_time_string (SSDATA (format_string), SBYTES (format_string),
1475 t, zone, &tm);
1476 }
1477
1478 DEFUN ("decode-time", Fdecode_time, Sdecode_time, 0, 3, 0,
1479 doc: /* Decode a timestamp into (SEC MINUTE HOUR DAY MONTH YEAR DOW DST UTCOFF).
1480 The optional TIME is the time value to convert. See
1481 `format-time-string' for the various forms of a time value.
1482
1483 The optional ZONE is omitted or nil for Emacs local time, t for
1484 Universal Time, `wall' for system wall clock time, or a string as in
1485 the TZ environment variable. It can also be a list (as from
1486 `current-time-zone') or an integer (the UTC offset in seconds) applied
1487 without consideration for daylight saving time.
1488
1489 The optional FORM specifies the form of the SEC member. If `integer',
1490 SEC is an integer; if t, SEC is an integer or (TICKS . HZ) timestamp
1491 with the same precision as TIME. An omitted or nil FORM is currently
1492 treated like `integer', but this may change in future Emacs versions.
1493
1494 To access (or alter) the elements in the time value, the
1495 `decoded-time-second', `decoded-time-minute', `decoded-time-hour',
1496 `decoded-time-day', `decoded-time-month', `decoded-time-year',
1497 `decoded-time-weekday', `decoded-time-dst' and `decoded-time-zone'
1498 accessors can be used.
1499
1500 The list has the following nine members: SEC is an integer or
1501 Lisp timestamp representing a nonnegative value less than 60
1502 \(or less than 61 if the operating system supports leap seconds).
1503 MINUTE is an integer between 0 and 59. HOUR is an integer
1504 between 0 and 23. DAY is an integer between 1 and 31. MONTH is an
1505 integer between 1 and 12. YEAR is the year number, an integer; 0
1506 represents 1 BC. DOW is the day of week, an integer between 0 and 6,
1507 where 0 is Sunday. DST is t if daylight saving time is in effect,
1508 nil if it is not in effect, and -1 if daylight saving information is
1509 not available. UTCOFF is an integer indicating the UTC offset in
1510 seconds, i.e., the number of seconds east of Greenwich. (Note that
1511 Common Lisp has different meanings for DOW and UTCOFF, and its
1512 SEC is always an integer between 0 and 59.)
1513
1514 usage: (decode-time &optional TIME ZONE FORM) */)
1515 (Lisp_Object specified_time, Lisp_Object zone, Lisp_Object form)
1516 {
1517 /* Compute broken-down local time LOCAL_TM from SPECIFIED_TIME and ZONE. */
1518 struct lisp_time lt = lisp_time_struct (specified_time, 0);
1519 struct timespec ts = lisp_to_timespec (lt);
1520 if (! timespec_valid_p (ts))
1521 time_overflow ();
1522 time_t time_spec = ts.tv_sec;
1523 struct tm local_tm, gmt_tm;
1524 timezone_t tz = tzlookup (zone, false);
1525 struct tm *tm = emacs_localtime_rz (tz, &time_spec, &local_tm);
1526 int localtime_errno = errno;
1527 xtzfree (tz);
1528
1529 if (!tm)
1530 time_error (localtime_errno);
1531
1532 /* Let YEAR = LOCAL_TM.tm_year + TM_YEAR_BASE. */
1533 Lisp_Object year;
1534 if (FASTER_TIMEFNS
1535 && MOST_NEGATIVE_FIXNUM - TM_YEAR_BASE <= local_tm.tm_year
1536 && local_tm.tm_year <= MOST_POSITIVE_FIXNUM - TM_YEAR_BASE)
1537 {
1538 /* Avoid overflow when INT_MAX - TM_YEAR_BASE < local_tm.tm_year. */
1539 EMACS_INT tm_year_base = TM_YEAR_BASE;
1540 year = make_fixnum (local_tm.tm_year + tm_year_base);
1541 }
1542 else
1543 {
1544 mpz_set_si (mpz[0], local_tm.tm_year);
1545 mpz_add_ui (mpz[0], mpz[0], TM_YEAR_BASE);
1546 year = make_integer_mpz ();
1547 }
1548
1549 /* Compute SEC from LOCAL_TM.tm_sec and HZ. */
1550 Lisp_Object hz = lt.hz, sec;
1551 if (BASE_EQ (hz, make_fixnum (1)) || !BASE2_EQ (form, Qt))
1552 sec = make_fixnum (local_tm.tm_sec);
1553 else
1554 {
1555 /* Let TICKS = HZ * LOCAL_TM.tm_sec + mod (LT.ticks, HZ)
1556 and SEC = (TICKS . HZ). */
1557 Lisp_Object ticks;
1558 intmax_t n;
1559 if (FASTER_TIMEFNS && FIXNUMP (lt.ticks) && FIXNUMP (hz)
1560 && !INT_MULTIPLY_WRAPV (XFIXNUM (hz), local_tm.tm_sec, &n)
1561 && ! (INT_ADD_WRAPV
1562 (n, (XFIXNUM (lt.ticks) % XFIXNUM (hz)
1563 + (XFIXNUM (lt.ticks) % XFIXNUM (hz) < 0
1564 ? XFIXNUM (hz) : 0)),
1565 &n)))
1566 ticks = make_int (n);
1567 else
1568 {
1569 mpz_fdiv_r (mpz[0],
1570 *bignum_integer (&mpz[0], lt.ticks),
1571 *bignum_integer (&mpz[1], hz));
1572 mpz_addmul_ui (mpz[0], *bignum_integer (&mpz[1], hz),
1573 local_tm.tm_sec);
1574 ticks = make_integer_mpz ();
1575 }
1576 sec = Fcons (ticks, hz);
1577 }
1578
1579 return CALLN (Flist,
1580 sec,
1581 make_fixnum (local_tm.tm_min),
1582 make_fixnum (local_tm.tm_hour),
1583 make_fixnum (local_tm.tm_mday),
1584 make_fixnum (local_tm.tm_mon + 1),
1585 year,
1586 make_fixnum (local_tm.tm_wday),
1587 (local_tm.tm_isdst < 0 ? make_fixnum (-1)
1588 : local_tm.tm_isdst == 0 ? Qnil : Qt),
1589 (HAVE_TM_GMTOFF
1590 ? make_fixnum (tm_gmtoff (&local_tm))
1591 : gmtime_r (&time_spec, &gmt_tm)
1592 ? make_fixnum (tm_diff (&local_tm, &gmt_tm))
1593 : Qnil));
1594 }
1595
1596 /* Return OBJ - OFFSET, checking that OBJ is a valid integer and that
1597 the result is representable as an int. 0 <= OFFSET <= TM_YEAR_BASE. */
1598 static int
1599 check_tm_member (Lisp_Object obj, int offset)
1600 {
1601 if (FASTER_TIMEFNS && INT_MAX <= MOST_POSITIVE_FIXNUM - TM_YEAR_BASE)
1602 {
1603 CHECK_FIXNUM (obj);
1604 EMACS_INT n = XFIXNUM (obj);
1605 int i;
1606 if (INT_SUBTRACT_WRAPV (n, offset, &i))
1607 time_overflow ();
1608 return i;
1609 }
1610 else
1611 {
1612 CHECK_INTEGER (obj);
1613 mpz_sub_ui (mpz[0], *bignum_integer (&mpz[0], obj), offset);
1614 intmax_t i;
1615 if (! (mpz_to_intmax (mpz[0], &i) && INT_MIN <= i && i <= INT_MAX))
1616 time_overflow ();
1617 return i;
1618 }
1619 }
1620
1621 DEFUN ("encode-time", Fencode_time, Sencode_time, 1, MANY, 0,
1622 doc: /* Convert TIME to a timestamp.
1623
1624 TIME is a list (SECOND MINUTE HOUR DAY MONTH YEAR IGNORED DST ZONE)
1625 in the style of `decode-time', so that (encode-time (decode-time ...)) works.
1626 In this list, ZONE can be nil for Emacs local time, t for Universal
1627 Time, `wall' for system wall clock time, or a string as in the TZ
1628 environment variable. ZONE can also be a list (as from
1629 `current-time-zone') or an integer (as from `decode-time') applied
1630 without consideration for daylight saving time. If ZONE specifies a
1631 time zone with daylight-saving transitions, DST is t for daylight
1632 saving time, nil for standard time, and -1 to cause the daylight
1633 saving flag to be guessed.
1634
1635 TIME can also be a list (SECOND MINUTE HOUR DAY MONTH YEAR), which is
1636 equivalent to (SECOND MINUTE HOUR DAY MONTH YEAR nil -1 nil).
1637
1638 As an obsolescent calling convention, if this function is called with
1639 6 or more arguments, the first 6 arguments are SECOND, MINUTE, HOUR,
1640 DAY, MONTH, and YEAR, and specify the components of a decoded time.
1641 If there are more than 6 arguments the *last* argument is used as ZONE
1642 and any other extra arguments are ignored, so that (apply
1643 #\\='encode-time (decode-time ...)) works. In this obsolescent
1644 convention, DST is -1 and ZONE defaults to nil.
1645
1646 The range of supported years is at least 1970 to the near future.
1647 Out-of-range values for SECOND through MONTH are brought into range
1648 via date arithmetic. This can be tricky especially when combined with
1649 DST; see Info node `(elisp)Time Conversion' for details and caveats.
1650
1651 usage: (encode-time TIME &rest OBSOLESCENT-ARGUMENTS) */)
1652 (ptrdiff_t nargs, Lisp_Object *args)
1653 {
1654 struct tm tm;
1655 Lisp_Object zone = Qnil;
1656 Lisp_Object a = args[0];
1657 Lisp_Object secarg, minarg, hourarg, mdayarg, monarg, yeararg;
1658 tm.tm_isdst = -1;
1659
1660 if (nargs == 1)
1661 {
1662 Lisp_Object tail = a;
1663 for (int i = 0; i < 6; i++, tail = XCDR (tail))
1664 CHECK_CONS (tail);
1665 secarg = XCAR (a); a = XCDR (a);
1666 minarg = XCAR (a); a = XCDR (a);
1667 hourarg = XCAR (a); a = XCDR (a);
1668 mdayarg = XCAR (a); a = XCDR (a);
1669 monarg = XCAR (a); a = XCDR (a);
1670 yeararg = XCAR (a); a = XCDR (a);
1671 if (! NILP (a))
1672 {
1673 CHECK_CONS (a);
1674 a = XCDR (a);
1675 CHECK_CONS (a);
1676 Lisp_Object dstflag = XCAR (a); a = XCDR (a);
1677 CHECK_CONS (a);
1678 zone = XCAR (a);
1679 if (SYMBOLP (dstflag) && !FIXNUMP (zone) && !CONSP (zone))
1680 tm.tm_isdst = !NILP (dstflag);
1681 }
1682 }
1683 else if (nargs < 6)
1684 xsignal2 (Qwrong_number_of_arguments, Qencode_time, make_fixnum (nargs));
1685 else
1686 {
1687 if (6 < nargs)
1688 zone = args[nargs - 1];
1689 secarg = a;
1690 minarg = args[1];
1691 hourarg = args[2];
1692 mdayarg = args[3];
1693 monarg = args[4];
1694 yeararg = args[5];
1695 }
1696
1697 /* Let SEC = floor (LT.ticks / HZ), with SUBSECTICKS the remainder. */
1698 struct lisp_time lt;
1699 decode_lisp_time (secarg, false, <, 0);
1700 Lisp_Object hz = lt.hz, sec, subsecticks;
1701 if (FASTER_TIMEFNS && BASE_EQ (hz, make_fixnum (1)))
1702 {
1703 sec = lt.ticks;
1704 subsecticks = make_fixnum (0);
1705 }
1706 else
1707 {
1708 mpz_fdiv_qr (mpz[0], mpz[1],
1709 *bignum_integer (&mpz[0], lt.ticks),
1710 *bignum_integer (&mpz[1], hz));
1711 sec = make_integer_mpz ();
1712 mpz_swap (mpz[0], mpz[1]);
1713 subsecticks = make_integer_mpz ();
1714 }
1715 tm.tm_sec = check_tm_member (sec, 0);
1716 tm.tm_min = check_tm_member (minarg, 0);
1717 tm.tm_hour = check_tm_member (hourarg, 0);
1718 tm.tm_mday = check_tm_member (mdayarg, 0);
1719 tm.tm_mon = check_tm_member (monarg, 1);
1720 tm.tm_year = check_tm_member (yeararg, TM_YEAR_BASE);
1721
1722 timezone_t tz = tzlookup (zone, false);
1723 tm.tm_wday = -1;
1724 time_t value = mktime_z (tz, &tm);
1725 int mktime_errno = errno;
1726 xtzfree (tz);
1727
1728 if (tm.tm_wday < 0)
1729 time_error (mktime_errno);
1730
1731 if (BASE_EQ (hz, make_fixnum (1)))
1732 return (current_time_list
1733 ? list2 (hi_time (value), lo_time (value))
1734 : INT_TO_INTEGER (value));
1735 else
1736 {
1737 struct lisp_time val1 = { INT_TO_INTEGER (value), make_fixnum (1) };
1738 Lisp_Object secticks = lisp_time_hz_ticks (val1, hz);
1739 Lisp_Object ticks = lispint_arith (secticks, subsecticks, false);
1740 return Fcons (ticks, hz);
1741 }
1742 }
1743
1744 DEFUN ("time-convert", Ftime_convert, Stime_convert, 1, 2, 0,
1745 doc: /* Convert TIME value to a Lisp timestamp of the given FORM.
1746 Truncate the returned value toward minus infinity.
1747
1748 If FORM is a positive integer, return a pair of integers (TICKS . FORM),
1749 where TICKS is the number of clock ticks and FORM is the clock frequency
1750 in ticks per second.
1751
1752 If FORM is t, return (TICKS . PHZ), where PHZ is a suitable clock
1753 frequency in ticks per second.
1754
1755 If FORM is `integer', return an integer count of seconds.
1756
1757 If FORM is `list', return an integer list (HIGH LOW USEC PSEC), where
1758 HIGH has the most significant bits of the seconds, LOW has the least
1759 significant 16 bits, and USEC and PSEC are the microsecond and
1760 picosecond counts.
1761
1762 If FORM is nil, the behavior depends on `current-time-list',
1763 but new code should not rely on it. */)
1764 (Lisp_Object time, Lisp_Object form)
1765 {
1766 /* FIXME: Any reason why we don't offer a `float` output format option as
1767 well, since we accept it as input? */
1768 struct lisp_time t;
1769 enum timeform input_form = decode_lisp_time (time, false, &t, 0);
1770 if (NILP (form))
1771 form = current_time_list ? Qlist : Qt;
1772 if (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (form))
1773 form = SYMBOL_WITH_POS_SYM (form);
1774 if (BASE_EQ (form, Qlist))
1775 return ticks_hz_list4 (t.ticks, t.hz);
1776 if (BASE_EQ (form, Qinteger))
1777 return FASTER_TIMEFNS && INTEGERP (time) ? time : lisp_time_seconds (t);
1778 if (BASE_EQ (form, Qt))
1779 form = t.hz;
1780 if (FASTER_TIMEFNS
1781 && input_form == TIMEFORM_TICKS_HZ && BASE_EQ (form, XCDR (time)))
1782 return time;
1783 return Fcons (lisp_time_hz_ticks (t, form), form);
1784 }
1785
1786 DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0,
1787 doc: /* Return the current time, as the number of seconds since 1970-01-01 00:00:00.
1788 If the variable `current-time-list' is nil, the time is returned as a
1789 pair of integers (TICKS . HZ), where TICKS counts clock ticks and HZ
1790 is the clock ticks per second. Otherwise, the time is returned as a
1791 list of integers (HIGH LOW USEC PSEC) where HIGH has the most
1792 significant bits of the seconds, LOW has the least significant 16
1793 bits, and USEC and PSEC are the microsecond and picosecond counts.
1794
1795 You can use `time-convert' to get a particular timestamp form
1796 regardless of the value of `current-time-list'. */)
1797 (void)
1798 {
1799 return make_lisp_time (current_timespec ());
1800 }
1801
1802 #ifdef CLOCKS_PER_SEC
1803 DEFUN ("current-cpu-time", Fcurrent_cpu_time, Scurrent_cpu_time, 0, 0, 0,
1804 doc: /* Return the current CPU time along with its resolution.
1805 The return value is a pair (CPU-TICKS . TICKS-PER-SEC).
1806 The CPU-TICKS counter can wrap around, so values cannot be meaningfully
1807 compared if too much time has passed between them. */)
1808 (void)
1809 {
1810 return Fcons (make_int (clock ()), make_int (CLOCKS_PER_SEC));
1811 }
1812 #endif
1813
1814 DEFUN ("current-time-string", Fcurrent_time_string, Scurrent_time_string,
1815 0, 2, 0,
1816 doc: /* Return the current local time, as a human-readable string.
1817 Programs can use this function to decode a time,
1818 since the number of columns in each field is fixed
1819 if the year is in the range 1000-9999.
1820 The format is `Sun Sep 16 01:03:52 1973'.
1821 However, see also the functions `decode-time' and `format-time-string'
1822 which provide a much more powerful and general facility.
1823
1824 If SPECIFIED-TIME is given, it is the time value to format instead of
1825 the current time. See `format-time-string' for the various forms of a
1826 time value.
1827
1828 The optional ZONE is omitted or nil for Emacs local time, t for
1829 Universal Time, `wall' for system wall clock time, or a string as in
1830 the TZ environment variable. It can also be a list (as from
1831 `current-time-zone') or an integer (as from `decode-time') applied
1832 without consideration for daylight saving time. */)
1833 (Lisp_Object specified_time, Lisp_Object zone)
1834 {
1835 time_t value = lisp_seconds_argument (specified_time);
1836 timezone_t tz = tzlookup (zone, false);
1837
1838 /* Convert to a string in ctime format, except without the trailing
1839 newline, and without the 4-digit year limit. Don't use asctime
1840 or ctime, as they might dump core if the year is outside the
1841 range -999 .. 9999. */
1842 struct tm tm;
1843 struct tm *tmp = emacs_localtime_rz (tz, &value, &tm);
1844 int localtime_errno = errno;
1845 xtzfree (tz);
1846 if (! tmp)
1847 time_error (localtime_errno);
1848
1849 static char const wday_name[][4] =
1850 { "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" };
1851 static char const mon_name[][4] =
1852 { "Jan", "Feb", "Mar", "Apr", "May", "Jun",
1853 "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" };
1854 intmax_t year_base = TM_YEAR_BASE;
1855 char buf[sizeof "Mon Apr 30 12:49:17 " + INT_STRLEN_BOUND (int) + 1];
1856 int len = sprintf (buf, "%s %s%3d %02d:%02d:%02d %"PRIdMAX,
1857 wday_name[tm.tm_wday], mon_name[tm.tm_mon], tm.tm_mday,
1858 tm.tm_hour, tm.tm_min, tm.tm_sec,
1859 tm.tm_year + year_base);
1860
1861 return make_unibyte_string (buf, len);
1862 }
1863
1864 DEFUN ("current-time-zone", Fcurrent_time_zone, Scurrent_time_zone, 0, 2, 0,
1865 doc: /* Return the offset and name for the local time zone.
1866 This returns a list of the form (OFFSET NAME).
1867 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
1868 A negative value means west of Greenwich.
1869 NAME is a string giving the name of the time zone.
1870 If SPECIFIED-TIME is given, the time zone offset is determined from it
1871 instead of using the current time. The argument should be a Lisp
1872 time value; see `format-time-string' for the various forms of a time
1873 value.
1874
1875 The optional ZONE is omitted or nil for Emacs local time, t for
1876 Universal Time, `wall' for system wall clock time, or a string as in
1877 the TZ environment variable. It can also be a list (as from
1878 `current-time-zone') or an integer (as from `decode-time') applied
1879 without consideration for daylight saving time.
1880
1881 Some operating systems cannot provide all this information to Emacs;
1882 in this case, `current-time-zone' returns a list containing nil for
1883 the data it can't find. */)
1884 (Lisp_Object specified_time, Lisp_Object zone)
1885 {
1886 struct timespec value;
1887 struct tm local_tm, gmt_tm;
1888 Lisp_Object zone_offset, zone_name;
1889
1890 zone_offset = Qnil;
1891 value = make_timespec (lisp_seconds_argument (specified_time), 0);
1892 zone_name = format_time_string ("%Z", sizeof "%Z" - 1, value,
1893 zone, &local_tm);
1894
1895 /* gmtime_r expects a pointer to time_t, but tv_sec of struct
1896 timespec on some systems (MinGW) is a 64-bit field. */
1897 time_t tsec = value.tv_sec;
1898 if (HAVE_TM_GMTOFF || gmtime_r (&tsec, &gmt_tm))
1899 {
1900 long int offset = (HAVE_TM_GMTOFF
1901 ? tm_gmtoff (&local_tm)
1902 : tm_diff (&local_tm, &gmt_tm));
1903 zone_offset = make_fixnum (offset);
1904 if (SCHARS (zone_name) == 0)
1905 {
1906 /* No local time zone name is available; use numeric zone instead. */
1907 long int hour = offset / 3600;
1908 int min_sec = offset % 3600;
1909 int amin_sec = min_sec < 0 ? - min_sec : min_sec;
1910 int min = amin_sec / 60;
1911 int sec = amin_sec % 60;
1912 int min_prec = min_sec ? 2 : 0;
1913 int sec_prec = sec ? 2 : 0;
1914 char buf[sizeof "+0000" + INT_STRLEN_BOUND (long int)];
1915 zone_name = make_formatted_string (buf, "%c%.2ld%.*d%.*d",
1916 (offset < 0 ? '-' : '+'),
1917 hour, min_prec, min, sec_prec, sec);
1918 }
1919 }
1920
1921 return list2 (zone_offset, zone_name);
1922 }
1923
1924 DEFUN ("set-time-zone-rule", Fset_time_zone_rule, Sset_time_zone_rule, 1, 1, 0,
1925 doc: /* Set the Emacs local time zone using TZ, a string specifying a time zone rule.
1926 If TZ is nil or `wall', use system wall clock time; this differs from
1927 the usual Emacs convention where nil means current local time. If TZ
1928 is t, use Universal Time. If TZ is a list (as from
1929 `current-time-zone') or an integer (as from `decode-time'), use the
1930 specified time zone without consideration for daylight saving time.
1931
1932 Instead of calling this function, you typically want something else.
1933 To temporarily use a different time zone rule for just one invocation
1934 of `decode-time', `encode-time', or `format-time-string', pass the
1935 function a ZONE argument. To change local time consistently
1936 throughout Emacs, call (setenv "TZ" TZ): this changes both the
1937 environment of the Emacs process and the variable
1938 `process-environment', whereas `set-time-zone-rule' affects only the
1939 former. */)
1940 (Lisp_Object tz)
1941 {
1942 tzlookup (NILP (tz) ? Qwall : tz, true);
1943 return Qnil;
1944 }
1945
1946 /* A buffer holding a string of the form "TZ=value", intended
1947 to be part of the environment. If TZ is supposed to be unset,
1948 the buffer string is "tZ=". */
1949 static char *tzvalbuf;
1950
1951 /* Get the local time zone rule. */
1952 char *
1953 emacs_getenv_TZ (void)
1954 {
1955 return tzvalbuf[0] == 'T' ? tzvalbuf + tzeqlen : 0;
1956 }
1957
1958 /* Set the local time zone rule to TZSTRING, which can be null to
1959 denote wall clock time. Do not record the setting in LOCAL_TZ.
1960
1961 This function is not thread-safe, in theory because putenv is not,
1962 but mostly because of the static storage it updates. Other threads
1963 that invoke localtime etc. may be adversely affected while this
1964 function is executing. */
1965
1966 int
1967 emacs_setenv_TZ (const char *tzstring)
1968 {
1969 static ptrdiff_t tzvalbufsize;
1970 ptrdiff_t tzstringlen = tzstring ? strlen (tzstring) : 0;
1971 char *tzval = tzvalbuf;
1972 bool new_tzvalbuf = tzvalbufsize <= tzeqlen + tzstringlen;
1973
1974 if (new_tzvalbuf)
1975 {
1976 /* Do not attempt to free the old tzvalbuf, since another thread
1977 may be using it. In practice, the first allocation is large
1978 enough and memory does not leak. */
1979 tzval = xpalloc (NULL, &tzvalbufsize,
1980 tzeqlen + tzstringlen - tzvalbufsize + 1, -1, 1);
1981 tzvalbuf = tzval;
1982 tzval[1] = 'Z';
1983 tzval[2] = '=';
1984 }
1985
1986 if (tzstring)
1987 {
1988 /* Modify TZVAL in place. Although this is dicey in a
1989 multithreaded environment, we know of no portable alternative.
1990 Calling putenv or setenv could crash some other thread. */
1991 tzval[0] = 'T';
1992 strcpy (tzval + tzeqlen, tzstring);
1993 }
1994 else
1995 {
1996 /* Turn 'TZ=whatever' into an empty environment variable 'tZ='.
1997 Although this is also dicey, calling unsetenv here can crash Emacs.
1998 See Bug#8705. */
1999 tzval[0] = 't';
2000 tzval[tzeqlen] = 0;
2001 }
2002
2003
2004 #ifndef WINDOWSNT
2005 /* Modifying *TZVAL merely requires calling tzset (which is the
2006 caller's responsibility). However, modifying TZVAL requires
2007 calling putenv; although this is not thread-safe, in practice this
2008 runs only on startup when there is only one thread. */
2009 bool need_putenv = new_tzvalbuf;
2010 #else
2011 /* MS-Windows 'putenv' copies the argument string into a block it
2012 allocates, so modifying *TZVAL will not change the environment.
2013 However, the other threads run by Emacs on MS-Windows never call
2014 'xputenv' or 'putenv' or 'unsetenv', so the original cause for the
2015 dicey in-place modification technique doesn't exist there in the
2016 first place. */
2017 bool need_putenv = true;
2018 #endif
2019 if (need_putenv)
2020 xputenv (tzval);
2021
2022 return 0;
2023 }
2024
2025 #if (ULONG_MAX < TRILLION || !FASTER_TIMEFNS) && !defined ztrillion
2026 # define NEED_ZTRILLION_INIT 1
2027 #endif
2028
2029 #ifdef NEED_ZTRILLION_INIT
2030 static void
2031 syms_of_timefns_for_pdumper (void)
2032 {
2033 mpz_init_set_ui (ztrillion, 1000000);
2034 mpz_mul_ui (ztrillion, ztrillion, 1000000);
2035 }
2036 #endif
2037
2038 void
2039 syms_of_timefns (void)
2040 {
2041 #ifndef timespec_hz
2042 timespec_hz = make_int (TIMESPEC_HZ);
2043 staticpro (×pec_hz);
2044 #endif
2045 #ifndef trillion
2046 trillion = make_int (1000000000000);
2047 staticpro (&trillion);
2048 #endif
2049
2050 DEFSYM (Qencode_time, "encode-time");
2051
2052 DEFVAR_BOOL ("current-time-list", current_time_list,
2053 doc: /* Whether `current-time' should return list or (TICKS . HZ) form.
2054
2055 This boolean variable is a transition aid. If t, `current-time' and
2056 related functions return timestamps in list form, typically
2057 \(HIGH LOW USEC PSEC); otherwise, they use (TICKS . HZ) form.
2058 Currently this variable defaults to t, for behavior compatible with
2059 previous Emacs versions. Developers are encouraged to test
2060 timestamp-related code with this variable set to nil, as it will
2061 default to nil in a future Emacs version, and will be removed in some
2062 version after that. */);
2063 current_time_list = CURRENT_TIME_LIST;
2064
2065 defsubr (&Scurrent_time);
2066 #ifdef CLOCKS_PER_SEC
2067 defsubr (&Scurrent_cpu_time);
2068 #endif
2069 defsubr (&Stime_convert);
2070 defsubr (&Stime_add);
2071 defsubr (&Stime_subtract);
2072 defsubr (&Stime_less_p);
2073 defsubr (&Stime_equal_p);
2074 defsubr (&Sformat_time_string);
2075 defsubr (&Sfloat_time);
2076 defsubr (&Sdecode_time);
2077 defsubr (&Sencode_time);
2078 defsubr (&Scurrent_time_string);
2079 defsubr (&Scurrent_time_zone);
2080 defsubr (&Sset_time_zone_rule);
2081
2082 flt_radix_power = make_nil_vector (flt_radix_power_size);
2083 staticpro (&flt_radix_power);
2084
2085 #ifdef NEED_ZTRILLION_INIT
2086 pdumper_do_now_and_after_load (syms_of_timefns_for_pdumper);
2087 #endif
2088 }