root/src/timefns.c

/* [<][>][^][v][top][bottom][index][help] */

DEFINITIONS

This source file includes following definitions.
  1. trillion_factor
  2. make_timeval
  3. tm_gmtoff
  4. tm_diff
  5. emacs_localtime_rz
  6. invalid_time_zone_specification
  7. xtzfree
  8. tzlookup
  9. init_timefns
  10. time_overflow
  11. time_error
  12. invalid_hz
  13. hi_time
  14. lo_time
  15. decode_float_time
  16. ticks_hz_list4
  17. mpz_set_time
  18. timespec_mpz
  19. timespec_ticks
  20. lisp_time_hz_ticks
  21. lisp_time_seconds
  22. make_lisp_time
  23. timespec_to_lisp
  24. frac_to_double
  25. decode_ticks_hz
  26. decode_time_components
  27. decode_lisp_time
  28. float_time
  29. mpz_time
  30. lisp_to_timespec
  31. list4_to_timespec
  32. lisp_time_struct
  33. lisp_time_argument
  34. lisp_seconds_argument
  35. lispint_arith
  36. time_arith
  37. time_cmp
  38. DEFUN
  39. emacs_nmemftime
  40. format_time_string
  41. check_tm_member
  42. DEFUN
  43. DEFUN
  44. DEFUN
  45. emacs_getenv_TZ
  46. emacs_setenv_TZ
  47. syms_of_timefns_for_pdumper
  48. syms_of_timefns

     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       && !ckd_mul (&accum, t.tv_sec, TIMESPEC_HZ)
   518       && !ckd_add (&accum, accum, t.tv_nsec))
   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           && !ckd_mul (&ticks, XFIXNUM (t.ticks), XFIXNUM (hz)))
   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, &lt, 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           && !ckd_mul (&n, XFIXNUM (hz), local_tm.tm_sec)
  1561           && !ckd_add (&n, n, (XFIXNUM (lt.ticks) % XFIXNUM (hz)
  1562                                + (XFIXNUM (lt.ticks) % XFIXNUM (hz) < 0
  1563                                   ? XFIXNUM (hz) : 0))))
  1564         ticks = make_int (n);
  1565       else
  1566         {
  1567           mpz_fdiv_r (mpz[0],
  1568                       *bignum_integer (&mpz[0], lt.ticks),
  1569                       *bignum_integer (&mpz[1], hz));
  1570           mpz_addmul_ui (mpz[0], *bignum_integer (&mpz[1], hz),
  1571                          local_tm.tm_sec);
  1572           ticks = make_integer_mpz ();
  1573         }
  1574       sec = Fcons (ticks, hz);
  1575     }
  1576 
  1577   return CALLN (Flist,
  1578                 sec,
  1579                 make_fixnum (local_tm.tm_min),
  1580                 make_fixnum (local_tm.tm_hour),
  1581                 make_fixnum (local_tm.tm_mday),
  1582                 make_fixnum (local_tm.tm_mon + 1),
  1583                 year,
  1584                 make_fixnum (local_tm.tm_wday),
  1585                 (local_tm.tm_isdst < 0 ? make_fixnum (-1)
  1586                  : local_tm.tm_isdst == 0 ? Qnil : Qt),
  1587                 (HAVE_TM_GMTOFF
  1588                  ? make_fixnum (tm_gmtoff (&local_tm))
  1589                  : gmtime_r (&time_spec, &gmt_tm)
  1590                  ? make_fixnum (tm_diff (&local_tm, &gmt_tm))
  1591                  : Qnil));
  1592 }
  1593 
  1594 /* Return OBJ - OFFSET, checking that OBJ is a valid integer and that
  1595    the result is representable as an int.  0 <= OFFSET <= TM_YEAR_BASE.  */
  1596 static int
  1597 check_tm_member (Lisp_Object obj, int offset)
  1598 {
  1599   if (FASTER_TIMEFNS && INT_MAX <= MOST_POSITIVE_FIXNUM - TM_YEAR_BASE)
  1600     {
  1601       CHECK_FIXNUM (obj);
  1602       EMACS_INT n = XFIXNUM (obj);
  1603       int i;
  1604       if (ckd_sub (&i, n, offset))
  1605         time_overflow ();
  1606       return i;
  1607     }
  1608   else
  1609     {
  1610       CHECK_INTEGER (obj);
  1611       mpz_sub_ui (mpz[0], *bignum_integer (&mpz[0], obj), offset);
  1612       intmax_t i;
  1613       if (! (mpz_to_intmax (mpz[0], &i) && INT_MIN <= i && i <= INT_MAX))
  1614         time_overflow ();
  1615       return i;
  1616     }
  1617 }
  1618 
  1619 DEFUN ("encode-time", Fencode_time, Sencode_time, 1, MANY, 0,
  1620        doc: /* Convert TIME to a timestamp.
  1621 
  1622 TIME is a list (SECOND MINUTE HOUR DAY MONTH YEAR IGNORED DST ZONE)
  1623 in the style of `decode-time', so that (encode-time (decode-time ...)) works.
  1624 In this list, ZONE can be nil for Emacs local time, t for Universal
  1625 Time, `wall' for system wall clock time, or a string as in the TZ
  1626 environment variable.  ZONE can also be a list (as from
  1627 `current-time-zone') or an integer (as from `decode-time') applied
  1628 without consideration for daylight saving time.  If ZONE specifies a
  1629 time zone with daylight-saving transitions, DST is t for daylight
  1630 saving time, nil for standard time, and -1 to cause the daylight
  1631 saving flag to be guessed.
  1632 
  1633 TIME can also be a list (SECOND MINUTE HOUR DAY MONTH YEAR), which is
  1634 equivalent to (SECOND MINUTE HOUR DAY MONTH YEAR nil -1 nil).
  1635 
  1636 As an obsolescent calling convention, if this function is called with
  1637 6 or more arguments, the first 6 arguments are SECOND, MINUTE, HOUR,
  1638 DAY, MONTH, and YEAR, and specify the components of a decoded time.
  1639 If there are more than 6 arguments the *last* argument is used as ZONE
  1640 and any other extra arguments are ignored, so that (apply
  1641 #\\='encode-time (decode-time ...)) works.  In this obsolescent
  1642 convention, DST is -1 and ZONE defaults to nil.
  1643 
  1644 The range of supported years is at least 1970 to the near future.
  1645 Out-of-range values for SECOND through MONTH are brought into range
  1646 via date arithmetic.  This can be tricky especially when combined with
  1647 DST; see Info node `(elisp)Time Conversion' for details and caveats.
  1648 
  1649 usage: (encode-time TIME &rest OBSOLESCENT-ARGUMENTS)  */)
  1650   (ptrdiff_t nargs, Lisp_Object *args)
  1651 {
  1652   struct tm tm;
  1653   Lisp_Object zone = Qnil;
  1654   Lisp_Object a = args[0];
  1655   Lisp_Object secarg, minarg, hourarg, mdayarg, monarg, yeararg;
  1656   tm.tm_isdst = -1;
  1657 
  1658   if (nargs == 1)
  1659     {
  1660       Lisp_Object tail = a;
  1661       for (int i = 0; i < 6; i++, tail = XCDR (tail))
  1662         CHECK_CONS (tail);
  1663       secarg = XCAR (a); a = XCDR (a);
  1664       minarg = XCAR (a); a = XCDR (a);
  1665       hourarg = XCAR (a); a = XCDR (a);
  1666       mdayarg = XCAR (a); a = XCDR (a);
  1667       monarg = XCAR (a); a = XCDR (a);
  1668       yeararg = XCAR (a); a = XCDR (a);
  1669       if (! NILP (a))
  1670         {
  1671           CHECK_CONS (a);
  1672           a = XCDR (a);
  1673           CHECK_CONS (a);
  1674           Lisp_Object dstflag = XCAR (a); a = XCDR (a);
  1675           CHECK_CONS (a);
  1676           zone = XCAR (a);
  1677           if (SYMBOLP (dstflag) && !FIXNUMP (zone) && !CONSP (zone))
  1678             tm.tm_isdst = !NILP (dstflag);
  1679         }
  1680     }
  1681   else if (nargs < 6)
  1682     xsignal2 (Qwrong_number_of_arguments, Qencode_time, make_fixnum (nargs));
  1683   else
  1684     {
  1685       if (6 < nargs)
  1686         zone = args[nargs - 1];
  1687       secarg = a;
  1688       minarg = args[1];
  1689       hourarg = args[2];
  1690       mdayarg = args[3];
  1691       monarg = args[4];
  1692       yeararg = args[5];
  1693     }
  1694 
  1695   /* Let SEC = floor (LT.ticks / HZ), with SUBSECTICKS the remainder.  */
  1696   struct lisp_time lt;
  1697   decode_lisp_time (secarg, false, &lt, 0);
  1698   Lisp_Object hz = lt.hz, sec, subsecticks;
  1699   if (FASTER_TIMEFNS && BASE_EQ (hz, make_fixnum (1)))
  1700     {
  1701       sec = lt.ticks;
  1702       subsecticks = make_fixnum (0);
  1703     }
  1704   else
  1705     {
  1706       mpz_fdiv_qr (mpz[0], mpz[1],
  1707                    *bignum_integer (&mpz[0], lt.ticks),
  1708                    *bignum_integer (&mpz[1], hz));
  1709       sec = make_integer_mpz ();
  1710       mpz_swap (mpz[0], mpz[1]);
  1711       subsecticks = make_integer_mpz ();
  1712     }
  1713   tm.tm_sec  = check_tm_member (sec, 0);
  1714   tm.tm_min  = check_tm_member (minarg, 0);
  1715   tm.tm_hour = check_tm_member (hourarg, 0);
  1716   tm.tm_mday = check_tm_member (mdayarg, 0);
  1717   tm.tm_mon  = check_tm_member (monarg, 1);
  1718   tm.tm_year = check_tm_member (yeararg, TM_YEAR_BASE);
  1719 
  1720   timezone_t tz = tzlookup (zone, false);
  1721   tm.tm_wday = -1;
  1722   time_t value = mktime_z (tz, &tm);
  1723   int mktime_errno = errno;
  1724   xtzfree (tz);
  1725 
  1726   if (tm.tm_wday < 0)
  1727     time_error (mktime_errno);
  1728 
  1729   if (BASE_EQ (hz, make_fixnum (1)))
  1730     return (current_time_list
  1731             ? list2 (hi_time (value), lo_time (value))
  1732             : INT_TO_INTEGER (value));
  1733   else
  1734     {
  1735       struct lisp_time val1 = { INT_TO_INTEGER (value), make_fixnum (1) };
  1736       Lisp_Object secticks = lisp_time_hz_ticks (val1, hz);
  1737       Lisp_Object ticks = lispint_arith (secticks, subsecticks, false);
  1738       return Fcons (ticks, hz);
  1739     }
  1740 }
  1741 
  1742 DEFUN ("time-convert", Ftime_convert, Stime_convert, 1, 2, 0,
  1743        doc: /* Convert TIME value to a Lisp timestamp of the given FORM.
  1744 Truncate the returned value toward minus infinity.
  1745 
  1746 If FORM is a positive integer, return a pair of integers (TICKS . FORM),
  1747 where TICKS is the number of clock ticks and FORM is the clock frequency
  1748 in ticks per second.
  1749 
  1750 If FORM is t, return (TICKS . PHZ), where PHZ is a suitable clock
  1751 frequency in ticks per second.
  1752 
  1753 If FORM is `integer', return an integer count of seconds.
  1754 
  1755 If FORM is `list', return an integer list (HIGH LOW USEC PSEC), where
  1756 HIGH has the most significant bits of the seconds, LOW has the least
  1757 significant 16 bits, and USEC and PSEC are the microsecond and
  1758 picosecond counts.
  1759 
  1760 If FORM is nil, the behavior depends on `current-time-list',
  1761 but new code should not rely on it.  */)
  1762      (Lisp_Object time, Lisp_Object form)
  1763 {
  1764   /* FIXME: Any reason why we don't offer a `float` output format option as
  1765      well, since we accept it as input?  */
  1766   struct lisp_time t;
  1767   enum timeform input_form = decode_lisp_time (time, false, &t, 0);
  1768   if (NILP (form))
  1769     form = current_time_list ? Qlist : Qt;
  1770   if (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (form))
  1771     form = SYMBOL_WITH_POS_SYM (form);
  1772   if (BASE_EQ (form, Qlist))
  1773     return ticks_hz_list4 (t.ticks, t.hz);
  1774   if (BASE_EQ (form, Qinteger))
  1775     return FASTER_TIMEFNS && INTEGERP (time) ? time : lisp_time_seconds (t);
  1776   if (BASE_EQ (form, Qt))
  1777     form = t.hz;
  1778   if (FASTER_TIMEFNS
  1779       && input_form == TIMEFORM_TICKS_HZ && BASE_EQ (form, XCDR (time)))
  1780     return time;
  1781   return Fcons (lisp_time_hz_ticks (t, form), form);
  1782 }
  1783 
  1784 DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0,
  1785        doc: /* Return the current time, as the number of seconds since 1970-01-01 00:00:00.
  1786 If the variable `current-time-list' is nil, the time is returned as a
  1787 pair of integers (TICKS . HZ), where TICKS counts clock ticks and HZ
  1788 is the clock ticks per second.  Otherwise, the time is returned as a
  1789 list of integers (HIGH LOW USEC PSEC) where HIGH has the most
  1790 significant bits of the seconds, LOW has the least significant 16
  1791 bits, and USEC and PSEC are the microsecond and picosecond counts.
  1792 
  1793 You can use `time-convert' to get a particular timestamp form
  1794 regardless of the value of `current-time-list'.  */)
  1795   (void)
  1796 {
  1797   return make_lisp_time (current_timespec ());
  1798 }
  1799 
  1800 #ifdef CLOCKS_PER_SEC
  1801 DEFUN ("current-cpu-time", Fcurrent_cpu_time, Scurrent_cpu_time, 0, 0, 0,
  1802        doc: /* Return the current CPU time along with its resolution.
  1803 The return value is a pair (CPU-TICKS . TICKS-PER-SEC).
  1804 The CPU-TICKS counter can wrap around, so values cannot be meaningfully
  1805 compared if too much time has passed between them.  */)
  1806   (void)
  1807 {
  1808   return Fcons (make_int (clock ()), make_int (CLOCKS_PER_SEC));
  1809 }
  1810 #endif
  1811 
  1812 DEFUN ("current-time-string", Fcurrent_time_string, Scurrent_time_string,
  1813        0, 2, 0,
  1814        doc: /* Return the current local time, as a human-readable string.
  1815 Programs can use this function to decode a time,
  1816 since the number of columns in each field is fixed
  1817 if the year is in the range 1000-9999.
  1818 The format is `Sun Sep 16 01:03:52 1973'.
  1819 However, see also the functions `decode-time' and `format-time-string'
  1820 which provide a much more powerful and general facility.
  1821 
  1822 If SPECIFIED-TIME is given, it is the time value to format instead of
  1823 the current time.  See `format-time-string' for the various forms of a
  1824 time value.
  1825 
  1826 The optional ZONE is omitted or nil for Emacs local time, t for
  1827 Universal Time, `wall' for system wall clock time, or a string as in
  1828 the TZ environment variable.  It can also be a list (as from
  1829 `current-time-zone') or an integer (as from `decode-time') applied
  1830 without consideration for daylight saving time.  */)
  1831   (Lisp_Object specified_time, Lisp_Object zone)
  1832 {
  1833   time_t value = lisp_seconds_argument (specified_time);
  1834   timezone_t tz = tzlookup (zone, false);
  1835 
  1836   /* Convert to a string in ctime format, except without the trailing
  1837      newline, and without the 4-digit year limit.  Don't use asctime
  1838      or ctime, as they might dump core if the year is outside the
  1839      range -999 .. 9999.  */
  1840   struct tm tm;
  1841   struct tm *tmp = emacs_localtime_rz (tz, &value, &tm);
  1842   int localtime_errno = errno;
  1843   xtzfree (tz);
  1844   if (! tmp)
  1845     time_error (localtime_errno);
  1846 
  1847   static char const wday_name[][4] =
  1848     { "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" };
  1849   static char const mon_name[][4] =
  1850     { "Jan", "Feb", "Mar", "Apr", "May", "Jun",
  1851       "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" };
  1852   intmax_t year_base = TM_YEAR_BASE;
  1853   char buf[sizeof "Mon Apr 30 12:49:17 " + INT_STRLEN_BOUND (int) + 1];
  1854   int len = sprintf (buf, "%s %s%3d %02d:%02d:%02d %"PRIdMAX,
  1855                      wday_name[tm.tm_wday], mon_name[tm.tm_mon], tm.tm_mday,
  1856                      tm.tm_hour, tm.tm_min, tm.tm_sec,
  1857                      tm.tm_year + year_base);
  1858 
  1859   return make_unibyte_string (buf, len);
  1860 }
  1861 
  1862 DEFUN ("current-time-zone", Fcurrent_time_zone, Scurrent_time_zone, 0, 2, 0,
  1863        doc: /* Return the offset and name for the local time zone.
  1864 This returns a list of the form (OFFSET NAME).
  1865 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
  1866     A negative value means west of Greenwich.
  1867 NAME is a string giving the name of the time zone.
  1868 If SPECIFIED-TIME is given, the time zone offset is determined from it
  1869 instead of using the current time.  The argument should be a Lisp
  1870 time value; see `format-time-string' for the various forms of a time
  1871 value.
  1872 
  1873 The optional ZONE is omitted or nil for Emacs local time, t for
  1874 Universal Time, `wall' for system wall clock time, or a string as in
  1875 the TZ environment variable.  It can also be a list (as from
  1876 `current-time-zone') or an integer (as from `decode-time') applied
  1877 without consideration for daylight saving time.
  1878 
  1879 Some operating systems cannot provide all this information to Emacs;
  1880 in this case, `current-time-zone' returns a list containing nil for
  1881 the data it can't find.  */)
  1882   (Lisp_Object specified_time, Lisp_Object zone)
  1883 {
  1884   struct timespec value;
  1885   struct tm local_tm, gmt_tm;
  1886   Lisp_Object zone_offset, zone_name;
  1887 
  1888   zone_offset = Qnil;
  1889   value = make_timespec (lisp_seconds_argument (specified_time), 0);
  1890   zone_name = format_time_string ("%Z", sizeof "%Z" - 1, value,
  1891                                   zone, &local_tm);
  1892 
  1893   /* gmtime_r expects a pointer to time_t, but tv_sec of struct
  1894      timespec on some systems (MinGW) is a 64-bit field.  */
  1895   time_t tsec = value.tv_sec;
  1896   if (HAVE_TM_GMTOFF || gmtime_r (&tsec, &gmt_tm))
  1897     {
  1898       long int offset = (HAVE_TM_GMTOFF
  1899                          ? tm_gmtoff (&local_tm)
  1900                          : tm_diff (&local_tm, &gmt_tm));
  1901       zone_offset = make_fixnum (offset);
  1902       if (SCHARS (zone_name) == 0)
  1903         {
  1904           /* No local time zone name is available; use numeric zone instead.  */
  1905           long int hour = offset / 3600;
  1906           int min_sec = offset % 3600;
  1907           int amin_sec = min_sec < 0 ? - min_sec : min_sec;
  1908           int min = amin_sec / 60;
  1909           int sec = amin_sec % 60;
  1910           int min_prec = min_sec ? 2 : 0;
  1911           int sec_prec = sec ? 2 : 0;
  1912           char buf[sizeof "+0000" + INT_STRLEN_BOUND (long int)];
  1913           zone_name = make_formatted_string (buf, "%c%.2ld%.*d%.*d",
  1914                                              (offset < 0 ? '-' : '+'),
  1915                                              hour, min_prec, min, sec_prec, sec);
  1916         }
  1917     }
  1918 
  1919   return list2 (zone_offset, zone_name);
  1920 }
  1921 
  1922 DEFUN ("set-time-zone-rule", Fset_time_zone_rule, Sset_time_zone_rule, 1, 1, 0,
  1923        doc: /* Set the Emacs local time zone using TZ, a string specifying a time zone rule.
  1924 If TZ is nil or `wall', use system wall clock time; this differs from
  1925 the usual Emacs convention where nil means current local time.  If TZ
  1926 is t, use Universal Time.  If TZ is a list (as from
  1927 `current-time-zone') or an integer (as from `decode-time'), use the
  1928 specified time zone without consideration for daylight saving time.
  1929 
  1930 Instead of calling this function, you typically want something else.
  1931 To temporarily use a different time zone rule for just one invocation
  1932 of `decode-time', `encode-time', or `format-time-string', pass the
  1933 function a ZONE argument.  To change local time consistently
  1934 throughout Emacs, call (setenv "TZ" TZ): this changes both the
  1935 environment of the Emacs process and the variable
  1936 `process-environment', whereas `set-time-zone-rule' affects only the
  1937 former.  */)
  1938   (Lisp_Object tz)
  1939 {
  1940   tzlookup (NILP (tz) ? Qwall : tz, true);
  1941   return Qnil;
  1942 }
  1943 
  1944 /* A buffer holding a string of the form "TZ=value", intended
  1945    to be part of the environment.  If TZ is supposed to be unset,
  1946    the buffer string is "tZ=".  */
  1947  static char *tzvalbuf;
  1948 
  1949 /* Get the local time zone rule.  */
  1950 char *
  1951 emacs_getenv_TZ (void)
  1952 {
  1953   return tzvalbuf[0] == 'T' ? tzvalbuf + tzeqlen : 0;
  1954 }
  1955 
  1956 /* Set the local time zone rule to TZSTRING, which can be null to
  1957    denote wall clock time.  Do not record the setting in LOCAL_TZ.
  1958 
  1959    This function is not thread-safe, in theory because putenv is not,
  1960    but mostly because of the static storage it updates.  Other threads
  1961    that invoke localtime etc. may be adversely affected while this
  1962    function is executing.  */
  1963 
  1964 int
  1965 emacs_setenv_TZ (const char *tzstring)
  1966 {
  1967   static ptrdiff_t tzvalbufsize;
  1968   ptrdiff_t tzstringlen = tzstring ? strlen (tzstring) : 0;
  1969   char *tzval = tzvalbuf;
  1970   bool new_tzvalbuf = tzvalbufsize <= tzeqlen + tzstringlen;
  1971 
  1972   if (new_tzvalbuf)
  1973     {
  1974       /* Do not attempt to free the old tzvalbuf, since another thread
  1975          may be using it.  In practice, the first allocation is large
  1976          enough and memory does not leak.  */
  1977       tzval = xpalloc (NULL, &tzvalbufsize,
  1978                        tzeqlen + tzstringlen - tzvalbufsize + 1, -1, 1);
  1979       tzvalbuf = tzval;
  1980       tzval[1] = 'Z';
  1981       tzval[2] = '=';
  1982     }
  1983 
  1984   if (tzstring)
  1985     {
  1986       /* Modify TZVAL in place.  Although this is dicey in a
  1987          multithreaded environment, we know of no portable alternative.
  1988          Calling putenv or setenv could crash some other thread.  */
  1989       tzval[0] = 'T';
  1990       strcpy (tzval + tzeqlen, tzstring);
  1991     }
  1992   else
  1993     {
  1994       /* Turn 'TZ=whatever' into an empty environment variable 'tZ='.
  1995          Although this is also dicey, calling unsetenv here can crash Emacs.
  1996          See Bug#8705.  */
  1997       tzval[0] = 't';
  1998       tzval[tzeqlen] = 0;
  1999     }
  2000 
  2001 
  2002 #ifndef WINDOWSNT
  2003   /* Modifying *TZVAL merely requires calling tzset (which is the
  2004      caller's responsibility).  However, modifying TZVAL requires
  2005      calling putenv; although this is not thread-safe, in practice this
  2006      runs only on startup when there is only one thread.  */
  2007   bool need_putenv = new_tzvalbuf;
  2008 #else
  2009   /* MS-Windows 'putenv' copies the argument string into a block it
  2010      allocates, so modifying *TZVAL will not change the environment.
  2011      However, the other threads run by Emacs on MS-Windows never call
  2012      'xputenv' or 'putenv' or 'unsetenv', so the original cause for the
  2013      dicey in-place modification technique doesn't exist there in the
  2014      first place.  */
  2015   bool need_putenv = true;
  2016 #endif
  2017   if (need_putenv)
  2018     xputenv (tzval);
  2019 
  2020   return 0;
  2021 }
  2022 
  2023 #if (ULONG_MAX < TRILLION || !FASTER_TIMEFNS) && !defined ztrillion
  2024 # define NEED_ZTRILLION_INIT 1
  2025 #endif
  2026 
  2027 #ifdef NEED_ZTRILLION_INIT
  2028 static void
  2029 syms_of_timefns_for_pdumper (void)
  2030 {
  2031   mpz_init_set_ui (ztrillion, 1000000);
  2032   mpz_mul_ui (ztrillion, ztrillion, 1000000);
  2033 }
  2034 #endif
  2035 
  2036 void
  2037 syms_of_timefns (void)
  2038 {
  2039 #ifndef timespec_hz
  2040   timespec_hz = make_int (TIMESPEC_HZ);
  2041   staticpro (&timespec_hz);
  2042 #endif
  2043 #ifndef trillion
  2044   trillion = make_int (1000000000000);
  2045   staticpro (&trillion);
  2046 #endif
  2047 
  2048   DEFSYM (Qencode_time, "encode-time");
  2049 
  2050   DEFVAR_BOOL ("current-time-list", current_time_list,
  2051                doc: /* Whether `current-time' should return list or (TICKS . HZ) form.
  2052 
  2053 This boolean variable is a transition aid.  If t, `current-time' and
  2054 related functions return timestamps in list form, typically
  2055 \(HIGH LOW USEC PSEC); otherwise, they use (TICKS . HZ) form.
  2056 Currently this variable defaults to t, for behavior compatible with
  2057 previous Emacs versions.  Developers are encouraged to test
  2058 timestamp-related code with this variable set to nil, as it will
  2059 default to nil in a future Emacs version, and will be removed in some
  2060 version after that.  */);
  2061   current_time_list = CURRENT_TIME_LIST;
  2062 
  2063   defsubr (&Scurrent_time);
  2064 #ifdef CLOCKS_PER_SEC
  2065   defsubr (&Scurrent_cpu_time);
  2066 #endif
  2067   defsubr (&Stime_convert);
  2068   defsubr (&Stime_add);
  2069   defsubr (&Stime_subtract);
  2070   defsubr (&Stime_less_p);
  2071   defsubr (&Stime_equal_p);
  2072   defsubr (&Sformat_time_string);
  2073   defsubr (&Sfloat_time);
  2074   defsubr (&Sdecode_time);
  2075   defsubr (&Sencode_time);
  2076   defsubr (&Scurrent_time_string);
  2077   defsubr (&Scurrent_time_zone);
  2078   defsubr (&Sset_time_zone_rule);
  2079 
  2080   flt_radix_power = make_nil_vector (flt_radix_power_size);
  2081   staticpro (&flt_radix_power);
  2082 
  2083 #ifdef NEED_ZTRILLION_INIT
  2084   pdumper_do_now_and_after_load (syms_of_timefns_for_pdumper);
  2085 #endif
  2086 }

/* [<][>][^][v][top][bottom][index][help] */