X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/79a90058ec11dbb56665e85a6631e4b8b5e7a6c6..6ffb560b2a940d19419ac5afe11418588ef8c61f:/src/editfns.c diff --git a/src/editfns.c b/src/editfns.c index e7c960dfff..621e841c3f 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -1,6 +1,6 @@ /* Lisp functions pertaining to editing. -Copyright (C) 1985-1987, 1989, 1993-2014 Free Software Foundation, Inc. +Copyright (C) 1985-1987, 1989, 1993-2015 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -64,30 +64,35 @@ along with GNU Emacs. If not, see . */ extern Lisp_Object w32_get_internal_run_time (void); #endif +static struct lisp_time lisp_time_struct (Lisp_Object, int *); +static void set_time_zone_rule (char const *); static Lisp_Object format_time_string (char const *, ptrdiff_t, struct timespec, bool, struct tm *); +static long int tm_gmtoff (struct tm *); static int tm_diff (struct tm *, struct tm *); static void update_buffer_properties (ptrdiff_t, ptrdiff_t); -static Lisp_Object Qbuffer_access_fontify_functions; - -/* Symbol for the text property used to mark fields. */ - -Lisp_Object Qfield; - -/* A special value for Qfield properties. */ - -static Lisp_Object Qboundary; +#ifndef HAVE_TM_GMTOFF +# define HAVE_TM_GMTOFF false +#endif -/* The startup value of the TZ environment variable so it can be - restored if the user calls set-time-zone-rule with a nil - argument. If null, the TZ environment variable was unset. */ +/* The startup value of the TZ environment variable; null if unset. */ static char const *initial_tz; -/* True if the static variable tzvalbuf (defined in - set_time_zone_rule) is part of 'environ'. */ -static bool tzvalbuf_in_environ; +/* A valid but unlikely setting for the TZ environment variable. + It is OK (though a bit slower) if the user chooses this value. */ +static char dump_tz_string[] = "TZ=UtC0"; + +/* The cached value of Vsystem_name. This is used only to compare it + to Vsystem_name, so it need not be visible to the GC. */ +static Lisp_Object cached_system_name; +static void +init_and_cache_system_name (void) +{ + init_system_name (); + cached_system_name = Vsystem_name; +} void init_editfns (void) @@ -98,16 +103,41 @@ init_editfns (void) Lisp_Object tem; /* Set up system_name even when dumping. */ - init_system_name (); + init_and_cache_system_name (); #ifndef CANNOT_DUMP - /* Don't bother with this on initial start when just dumping out */ + /* When just dumping out, set the time zone to a known unlikely value + and skip the rest of this function. */ if (!initialized) - return; -#endif /* not CANNOT_DUMP */ + { +# ifdef HAVE_TZSET + xputenv (dump_tz_string); + tzset (); +# endif + return; + } +#endif + + char *tz = getenv ("TZ"); + initial_tz = tz; + +#if !defined CANNOT_DUMP && defined HAVE_TZSET + /* If the execution TZ happens to be the same as the dump TZ, + change it to some other value and then change it back, + to force the underlying implementation to reload the TZ info. + This is needed on implementations that load TZ info from files, + since the TZ file contents may differ between dump and execution. */ + if (tz && strcmp (tz, &dump_tz_string[sizeof "TZ=" - 1]) == 0) + { + ++*tz; + tzset (); + --*tz; + } +#endif - initial_tz = getenv ("TZ"); - tzvalbuf_in_environ = 0; + /* Call set_time_zone_rule now, so that its call to putenv is done + before multiple threads are active. */ + set_time_zone_rule (tz); pw = getpwuid (getuid ()); #ifdef MSDOS @@ -759,26 +789,17 @@ boundaries, bind `inhibit-field-text-motion' to t. This function does not move point. */) (Lisp_Object n) { - ptrdiff_t orig, orig_byte, end; - ptrdiff_t count = SPECPDL_INDEX (); - specbind (Qinhibit_point_motion_hooks, Qt); + ptrdiff_t charpos, bytepos; if (NILP (n)) XSETFASTINT (n, 1); else CHECK_NUMBER (n); - orig = PT; - orig_byte = PT_BYTE; - Fforward_line (make_number (XINT (n) - 1)); - end = PT; - - SET_PT_BOTH (orig, orig_byte); - - unbind_to (count, Qnil); + scan_newline_from_point (XINT (n) - 1, &charpos, &bytepos); /* Return END constrained to the current input field. */ - return Fconstrain_to_field (make_number (end), make_number (orig), + return Fconstrain_to_field (make_number (charpos), make_number (PT), XINT (n) != 1 ? Qt : Qnil, Qt, Qnil); } @@ -884,17 +905,11 @@ save_excursion_restore (Lisp_Object info) if (! NILP (tem)) { if (! EQ (omark, nmark)) - { - tem = intern ("activate-mark-hook"); - Frun_hooks (1, &tem); - } + run_hook (intern ("activate-mark-hook")); } /* If mark has ceased to be active, run deactivate hook. */ else if (! NILP (tem1)) - { - tem = intern ("deactivate-mark-hook"); - Frun_hooks (1, &tem); - } + run_hook (intern ("deactivate-mark-hook")); /* If buffer was visible in a window, and a different window was selected, and the old selected window is still showing this @@ -1330,10 +1345,9 @@ name, or nil if there is no such user. */) USE_SAFE_ALLOCA; char *r = SAFE_ALLOCA (strlen (p) + SBYTES (login) + 1); memcpy (r, p, q - p); - r[q - p] = 0; - strcat (r, SSDATA (login)); + char *s = lispstpcpy (&r[q - p], login); r[q - p] = upcase ((unsigned char) r[q - p]); - strcat (r, q + 1); + strcpy (s, q + 1); full = build_string (r); SAFE_FREE (); } @@ -1346,6 +1360,8 @@ DEFUN ("system-name", Fsystem_name, Ssystem_name, 0, 0, 0, doc: /* Return the host name of the machine you are running on, as a string. */) (void) { + if (EQ (Vsystem_name, cached_system_name)) + init_and_cache_system_name (); return Vsystem_name; } @@ -1373,30 +1389,60 @@ time_overflow (void) error ("Specified time is not representable"); } +static void +invalid_time (void) +{ + error ("Invalid time specification"); +} + +/* A substitute for mktime_z on platforms that lack it. It's not + thread-safe, but should be good enough for Emacs in typical use. */ +#ifndef HAVE_TZALLOC +time_t +mktime_z (timezone_t tz, struct tm *tm) +{ + char *oldtz = getenv ("TZ"); + USE_SAFE_ALLOCA; + if (oldtz) + { + size_t oldtzsize = strlen (oldtz) + 1; + char *oldtzcopy = SAFE_ALLOCA (oldtzsize); + oldtz = strcpy (oldtzcopy, oldtz); + } + block_input (); + set_time_zone_rule (tz); + time_t t = mktime (tm); + set_time_zone_rule (oldtz); + unblock_input (); + SAFE_FREE (); + return t; +} +#endif + /* Return the upper part of the time T (everything but the bottom 16 bits). */ static EMACS_INT hi_time (time_t t) { - time_t hi = t >> 16; + time_t hi = t >> LO_TIME_BITS; /* Check for overflow, helping the compiler for common cases where no runtime check is needed, and taking care not to convert negative numbers to unsigned before comparing them. */ if (! ((! TYPE_SIGNED (time_t) - || MOST_NEGATIVE_FIXNUM <= TIME_T_MIN >> 16 + || MOST_NEGATIVE_FIXNUM <= TIME_T_MIN >> LO_TIME_BITS || MOST_NEGATIVE_FIXNUM <= hi) - && (TIME_T_MAX >> 16 <= MOST_POSITIVE_FIXNUM + && (TIME_T_MAX >> LO_TIME_BITS <= MOST_POSITIVE_FIXNUM || hi <= MOST_POSITIVE_FIXNUM))) time_overflow (); return hi; } -/* Return the bottom 16 bits of the time T. */ +/* Return the bottom bits of the time T. */ static int lo_time (time_t t) { - return t & ((1 << 16) - 1); + return t & ((1 << LO_TIME_BITS) - 1); } DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0, @@ -1410,6 +1456,96 @@ picosecond counts. */) return make_lisp_time (current_timespec ()); } +static struct lisp_time +time_add (struct lisp_time ta, struct lisp_time tb) +{ + EMACS_INT hi = ta.hi + tb.hi; + int lo = ta.lo + tb.lo; + int us = ta.us + tb.us; + int ps = ta.ps + tb.ps; + us += (1000000 <= ps); + ps -= (1000000 <= ps) * 1000000; + lo += (1000000 <= us); + us -= (1000000 <= us) * 1000000; + hi += (1 << LO_TIME_BITS <= lo); + lo -= (1 << LO_TIME_BITS <= lo) << LO_TIME_BITS; + return (struct lisp_time) { hi, lo, us, ps }; +} + +static struct lisp_time +time_subtract (struct lisp_time ta, struct lisp_time tb) +{ + EMACS_INT hi = ta.hi - tb.hi; + int lo = ta.lo - tb.lo; + int us = ta.us - tb.us; + int ps = ta.ps - tb.ps; + us -= (ps < 0); + ps += (ps < 0) * 1000000; + lo -= (us < 0); + us += (us < 0) * 1000000; + hi -= (lo < 0); + lo += (lo < 0) << LO_TIME_BITS; + return (struct lisp_time) { hi, lo, us, ps }; +} + +static Lisp_Object +time_arith (Lisp_Object a, Lisp_Object b, + struct lisp_time (*op) (struct lisp_time, struct lisp_time)) +{ + int alen, blen; + struct lisp_time ta = lisp_time_struct (a, &alen); + struct lisp_time tb = lisp_time_struct (b, &blen); + struct lisp_time t = op (ta, tb); + if (! (MOST_NEGATIVE_FIXNUM <= t.hi && t.hi <= MOST_POSITIVE_FIXNUM)) + time_overflow (); + Lisp_Object val = Qnil; + + switch (max (alen, blen)) + { + default: + val = Fcons (make_number (t.ps), val); + /* Fall through. */ + case 3: + val = Fcons (make_number (t.us), val); + /* Fall through. */ + case 2: + val = Fcons (make_number (t.lo), val); + val = Fcons (make_number (t.hi), val); + break; + } + + return val; +} + +DEFUN ("time-add", Ftime_add, Stime_add, 2, 2, 0, + doc: /* Return the sum of two time values A and B, as a time value. */) + (Lisp_Object a, Lisp_Object b) +{ + return time_arith (a, b, time_add); +} + +DEFUN ("time-subtract", Ftime_subtract, Stime_subtract, 2, 2, 0, + doc: /* Return the difference between two time values A and B, as a time value. */) + (Lisp_Object a, Lisp_Object b) +{ + return time_arith (a, b, time_subtract); +} + +DEFUN ("time-less-p", Ftime_less_p, Stime_less_p, 2, 2, 0, + doc: /* Return non-nil if time value T1 is earlier than time value T2. */) + (Lisp_Object t1, Lisp_Object t2) +{ + int t1len, t2len; + struct lisp_time a = lisp_time_struct (t1, &t1len); + struct lisp_time b = lisp_time_struct (t2, &t2len); + return ((a.hi != b.hi ? a.hi < b.hi + : a.lo != b.lo ? a.lo < b.lo + : a.us != b.us ? a.us < b.us + : a.ps < b.ps) + ? Qt : Qnil); +} + + DEFUN ("get-internal-run-time", Fget_internal_run_time, Sget_internal_run_time, 0, 0, 0, doc: /* Return the current run time used by Emacs. @@ -1448,21 +1584,6 @@ does the same thing as `current-time'. */) } -/* Make a Lisp list that represents the time T with fraction TAIL. */ -static Lisp_Object -make_time_tail (time_t t, Lisp_Object tail) -{ - return Fcons (make_number (hi_time (t)), - Fcons (make_number (lo_time (t)), tail)); -} - -/* Make a Lisp list that represents the system time T. */ -static Lisp_Object -make_time (time_t t) -{ - return make_time_tail (t, Qnil); -} - /* Make a Lisp list that represents the Emacs time T. T may be an invalid time, with a slightly negative tv_nsec value such as UNKNOWN_MODTIME_NSECS; in that case, the Lisp list contains a @@ -1470,23 +1591,30 @@ make_time (time_t t) Lisp_Object make_lisp_time (struct timespec t) { + time_t s = t.tv_sec; int ns = t.tv_nsec; - return make_time_tail (t.tv_sec, list2i (ns / 1000, ns % 1000 * 1000)); + return list4i (hi_time (s), lo_time (s), ns / 1000, ns % 1000 * 1000); } /* Decode a Lisp list SPECIFIED_TIME that represents a time. Set *PHIGH, *PLOW, *PUSEC, *PPSEC to its parts; do not check their values. - Return true if successful. */ -static bool + Return 2, 3, or 4 to indicate the effective length of SPECIFIED_TIME + if successful, 0 if unsuccessful. */ +static int disassemble_lisp_time (Lisp_Object specified_time, Lisp_Object *phigh, Lisp_Object *plow, Lisp_Object *pusec, Lisp_Object *ppsec) { + Lisp_Object high = make_number (0); + Lisp_Object low = specified_time; + Lisp_Object usec = make_number (0); + Lisp_Object psec = make_number (0); + int len = 4; + if (CONSP (specified_time)) { - Lisp_Object low = XCDR (specified_time); - Lisp_Object usec = make_number (0); - Lisp_Object psec = make_number (0); + high = XCAR (specified_time); + low = XCDR (specified_time); if (CONSP (low)) { Lisp_Object low_tail = XCDR (low); @@ -1497,40 +1625,119 @@ disassemble_lisp_time (Lisp_Object specified_time, Lisp_Object *phigh, low_tail = XCDR (low_tail); if (CONSP (low_tail)) psec = XCAR (low_tail); + else + len = 3; } else if (!NILP (low_tail)) - usec = low_tail; + { + usec = low_tail; + len = 3; + } + else + len = 2; } + else + len = 2; - *phigh = XCAR (specified_time); - *plow = low; - *pusec = usec; - *ppsec = psec; - return 1; + /* When combining components, require LOW to be an integer, + as otherwise it would be a pain to add up times. */ + if (! INTEGERP (low)) + return 0; } + else if (INTEGERP (specified_time)) + len = 2; + + *phigh = high; + *plow = low; + *pusec = usec; + *ppsec = psec; + return len; +} - return 0; +/* Convert T into an Emacs time *RESULT, truncating toward minus infinity. + Return true if T is in range, false otherwise. */ +static bool +decode_float_time (double t, struct lisp_time *result) +{ + double lo_multiplier = 1 << LO_TIME_BITS; + double emacs_time_min = MOST_NEGATIVE_FIXNUM * lo_multiplier; + if (! (emacs_time_min <= t && t < -emacs_time_min)) + return false; + + double small_t = t / lo_multiplier; + EMACS_INT hi = small_t; + double t_sans_hi = t - hi * lo_multiplier; + int lo = t_sans_hi; + long double fracps = (t_sans_hi - lo) * 1e12L; +#ifdef INT_FAST64_MAX + int_fast64_t ifracps = fracps; + int us = ifracps / 1000000; + int ps = ifracps % 1000000; +#else + int us = fracps / 1e6L; + int ps = fracps - us * 1e6L; +#endif + us -= (ps < 0); + ps += (ps < 0) * 1000000; + lo -= (us < 0); + us += (us < 0) * 1000000; + hi -= (lo < 0); + lo += (lo < 0) << LO_TIME_BITS; + result->hi = hi; + result->lo = lo; + result->us = us; + result->ps = ps; + return true; } /* From the time components HIGH, LOW, USEC and PSEC taken from a Lisp list, generate the corresponding time value. + If LOW is floating point, the other components should be zero. - If RESULT is not null, store into *RESULT the converted time; - if the converted time does not fit into struct timespec, - store an invalid timespec to indicate the overflow. + If RESULT is not null, store into *RESULT the converted time. If *DRESULT is not null, store into *DRESULT the number of seconds since the start of the POSIX Epoch. - Return true if successful. */ + Return true if successful, false if the components are of the + wrong type or represent a time out of range. */ bool decode_time_components (Lisp_Object high, Lisp_Object low, Lisp_Object usec, Lisp_Object psec, - struct timespec *result, double *dresult) + struct lisp_time *result, double *dresult) { EMACS_INT hi, lo, us, ps; - if (! (INTEGERP (high) && INTEGERP (low) + if (! (INTEGERP (high) && INTEGERP (usec) && INTEGERP (psec))) return false; + if (! INTEGERP (low)) + { + if (FLOATP (low)) + { + double t = XFLOAT_DATA (low); + if (result && ! decode_float_time (t, result)) + return false; + if (dresult) + *dresult = t; + return true; + } + else if (NILP (low)) + { + struct timespec now = current_timespec (); + if (result) + { + result->hi = hi_time (now.tv_sec); + result->lo = lo_time (now.tv_sec); + result->us = now.tv_nsec / 1000; + result->ps = now.tv_nsec % 1000 * 1000; + } + if (dresult) + *dresult = now.tv_sec + now.tv_nsec / 1e9; + return true; + } + else + return false; + } + hi = XINT (high); lo = XINT (low); us = XINT (usec); @@ -1540,53 +1747,68 @@ decode_time_components (Lisp_Object high, Lisp_Object low, Lisp_Object usec, each overflow into the next higher-order component. */ us += ps / 1000000 - (ps % 1000000 < 0); lo += us / 1000000 - (us % 1000000 < 0); - hi += lo >> 16; + hi += lo >> LO_TIME_BITS; ps = ps % 1000000 + 1000000 * (ps % 1000000 < 0); us = us % 1000000 + 1000000 * (us % 1000000 < 0); - lo &= (1 << 16) - 1; + lo &= (1 << LO_TIME_BITS) - 1; if (result) { - if ((TYPE_SIGNED (time_t) ? TIME_T_MIN >> 16 <= hi : 0 <= hi) - && hi <= TIME_T_MAX >> 16) - { - /* Return the greatest representable time that is not greater - than the requested time. */ - time_t sec = hi; - *result = make_timespec ((sec << 16) + lo, us * 1000 + ps / 1000); - } - else - *result = invalid_timespec (); + if (! (MOST_NEGATIVE_FIXNUM <= hi && hi <= MOST_POSITIVE_FIXNUM)) + return false; + result->hi = hi; + result->lo = lo; + result->us = us; + result->ps = ps; } if (dresult) - *dresult = (us * 1e6 + ps) / 1e12 + lo + hi * 65536.0; + { + double dhi = hi; + *dresult = (us * 1e6 + ps) / 1e12 + lo + dhi * (1 << LO_TIME_BITS); + } return true; } +struct timespec +lisp_to_timespec (struct lisp_time t) +{ + if (! ((TYPE_SIGNED (time_t) ? TIME_T_MIN >> LO_TIME_BITS <= t.hi : 0 <= t.hi) + && t.hi <= TIME_T_MAX >> LO_TIME_BITS)) + return invalid_timespec (); + time_t s = (t.hi << LO_TIME_BITS) + t.lo; + int ns = t.us * 1000 + t.ps / 1000; + return make_timespec (s, ns); +} + /* Decode a Lisp list SPECIFIED_TIME that represents a time. + Store its effective length into *PLEN. If SPECIFIED_TIME is nil, use the current time. + Signal an error if SPECIFIED_TIME does not represent a time. */ +static struct lisp_time +lisp_time_struct (Lisp_Object specified_time, int *plen) +{ + Lisp_Object high, low, usec, psec; + struct lisp_time t; + int len = disassemble_lisp_time (specified_time, &high, &low, &usec, &psec); + if (! (len && decode_time_components (high, low, usec, psec, &t, 0))) + invalid_time (); + *plen = len; + return t; +} - Round the time down to the nearest struct timespec value. - Return seconds since the Epoch. - Signal an error if unsuccessful. */ +/* Like lisp_time_struct, except return a struct timespec. + Discard any low-order digits. */ struct timespec lisp_time_argument (Lisp_Object specified_time) { - if (NILP (specified_time)) - return current_timespec (); - else - { - Lisp_Object high, low, usec, psec; - struct timespec t; - if (! (disassemble_lisp_time (specified_time, &high, &low, &usec, &psec) - && decode_time_components (high, low, usec, psec, &t, 0))) - error ("Invalid time specification"); - if (! timespec_valid_p (t)) - time_overflow (); - return t; - } + int len; + struct lisp_time lt = lisp_time_struct (specified_time, &len); + struct timespec t = lisp_to_timespec (lt); + if (! timespec_valid_p (t)) + time_overflow (); + return t; } /* Like lisp_time_argument, except decode only the seconds part, @@ -1594,20 +1816,16 @@ lisp_time_argument (Lisp_Object specified_time) static time_t lisp_seconds_argument (Lisp_Object specified_time) { - if (NILP (specified_time)) - return time (NULL); - else - { - Lisp_Object high, low, usec, psec; - struct timespec t; - if (! (disassemble_lisp_time (specified_time, &high, &low, &usec, &psec) - && decode_time_components (high, low, make_number (0), - make_number (0), &t, 0))) - error ("Invalid time specification"); - if (! timespec_valid_p (t)) - time_overflow (); - return t.tv_sec; - } + Lisp_Object high, low, usec, psec; + struct lisp_time t; + if (! (disassemble_lisp_time (specified_time, &high, &low, &usec, &psec) + && decode_time_components (high, low, make_number (0), + make_number (0), &t, 0))) + invalid_time (); + if (! ((TYPE_SIGNED (time_t) ? TIME_T_MIN >> LO_TIME_BITS <= t.hi : 0 <= t.hi) + && t.hi <= TIME_T_MAX >> LO_TIME_BITS)) + time_overflow (); + return (t.hi << LO_TIME_BITS) + t.lo; } DEFUN ("float-time", Ffloat_time, Sfloat_time, 0, 1, 0, @@ -1625,18 +1843,10 @@ or (if you need time as a string) `format-time-string'. */) (Lisp_Object specified_time) { double t; - if (NILP (specified_time)) - { - struct timespec now = current_timespec (); - t = now.tv_sec + now.tv_nsec / 1e9; - } - else - { - Lisp_Object high, low, usec, psec; - if (! (disassemble_lisp_time (specified_time, &high, &low, &usec, &psec) - && decode_time_components (high, low, usec, psec, 0, &t))) - error ("Invalid time specification"); - } + Lisp_Object high, low, usec, psec; + if (! (disassemble_lisp_time (specified_time, &high, &low, &usec, &psec) + && decode_time_components (high, low, usec, psec, 0, &t))) + invalid_time (); return make_float (t); } @@ -1768,39 +1978,28 @@ format_time_string (char const *format, ptrdiff_t formatlen, size_t len; Lisp_Object bufstring; int ns = t.tv_nsec; - struct tm *tm; USE_SAFE_ALLOCA; - while (1) - { - time_t *taddr = &t.tv_sec; - block_input (); - - synchronize_system_time_locale (); - - tm = ut ? gmtime (taddr) : localtime (taddr); - if (! tm) - { - unblock_input (); - time_overflow (); - } - *tmp = *tm; + tmp = ut ? gmtime_r (&t.tv_sec, tmp) : localtime_r (&t.tv_sec, tmp); + if (! tmp) + time_overflow (); + synchronize_system_time_locale (); + while (true) + { buf[0] = '\1'; - len = emacs_nmemftime (buf, size, format, formatlen, tm, ut, ns); + len = emacs_nmemftime (buf, size, format, formatlen, tmp, ut, ns); if ((0 < len && len < size) || (len == 0 && buf[0] == '\0')) break; /* Buffer was too small, so make it bigger and try again. */ - len = emacs_nmemftime (NULL, SIZE_MAX, format, formatlen, tm, ut, ns); - unblock_input (); + len = emacs_nmemftime (NULL, SIZE_MAX, format, formatlen, tmp, ut, ns); if (STRING_BYTES_BOUND <= len) string_overflow (); size = len + 1; buf = SAFE_ALLOCA (size); } - unblock_input (); bufstring = make_unibyte_string (buf, len); SAFE_FREE (); return code_convert_string_norecord (bufstring, Vlocale_coding_system, 0); @@ -1824,38 +2023,30 @@ DOW and ZONE.) */) (Lisp_Object specified_time) { time_t time_spec = lisp_seconds_argument (specified_time); - struct tm save_tm; - struct tm *decoded_time; - Lisp_Object list_args[9]; + struct tm local_tm, gmt_tm; - block_input (); - decoded_time = localtime (&time_spec); - if (decoded_time) - save_tm = *decoded_time; - unblock_input (); - if (! (decoded_time - && MOST_NEGATIVE_FIXNUM - TM_YEAR_BASE <= save_tm.tm_year - && save_tm.tm_year <= MOST_POSITIVE_FIXNUM - TM_YEAR_BASE)) + if (! (localtime_r (&time_spec, &local_tm) + && MOST_NEGATIVE_FIXNUM - TM_YEAR_BASE <= local_tm.tm_year + && local_tm.tm_year <= MOST_POSITIVE_FIXNUM - TM_YEAR_BASE)) time_overflow (); - XSETFASTINT (list_args[0], save_tm.tm_sec); - XSETFASTINT (list_args[1], save_tm.tm_min); - XSETFASTINT (list_args[2], save_tm.tm_hour); - XSETFASTINT (list_args[3], save_tm.tm_mday); - XSETFASTINT (list_args[4], save_tm.tm_mon + 1); - /* On 64-bit machines an int is narrower than EMACS_INT, thus the - cast below avoids overflow in int arithmetics. */ - XSETINT (list_args[5], TM_YEAR_BASE + (EMACS_INT) save_tm.tm_year); - XSETFASTINT (list_args[6], save_tm.tm_wday); - list_args[7] = save_tm.tm_isdst ? Qt : Qnil; - block_input (); - decoded_time = gmtime (&time_spec); - if (decoded_time == 0) - list_args[8] = Qnil; - else - XSETINT (list_args[8], tm_diff (&save_tm, decoded_time)); - unblock_input (); - return Flist (9, list_args); + /* Avoid overflow when INT_MAX < EMACS_INT_MAX. */ + EMACS_INT tm_year_base = TM_YEAR_BASE; + + return Flist (9, ((Lisp_Object []) + {make_number (local_tm.tm_sec), + make_number (local_tm.tm_min), + make_number (local_tm.tm_hour), + make_number (local_tm.tm_mday), + make_number (local_tm.tm_mon + 1), + make_number (local_tm.tm_year + tm_year_base), + make_number (local_tm.tm_wday), + local_tm.tm_isdst ? Qt : Qnil, + (HAVE_TM_GMTOFF + ? make_number (tm_gmtoff (&local_tm)) + : gmtime_r (&time_spec, &gmt_tm) + ? make_number (tm_diff (&local_tm, &gmt_tm)) + : Qnil)})); } /* Return OBJ - OFFSET, checking that OBJ is a valid fixnum and that @@ -1872,6 +2063,29 @@ check_tm_member (Lisp_Object obj, int offset) return n - offset; } +/* Decode ZONE as a time zone specification. */ + +static Lisp_Object +decode_time_zone (Lisp_Object zone) +{ + if (EQ (zone, Qt)) + return build_string ("UTC0"); + else if (STRINGP (zone)) + return zone; + else if (INTEGERP (zone)) + { + static char const tzbuf_format[] = "XXX%s%"pI"d:%02d:%02d"; + char tzbuf[sizeof tzbuf_format + INT_STRLEN_BOUND (EMACS_INT)]; + EMACS_INT abszone = eabs (XINT (zone)), zone_hr = abszone / (60 * 60); + int zone_min = (abszone / 60) % 60, zone_sec = abszone % 60; + + return make_formatted_string (tzbuf, tzbuf_format, &"-"[XINT (zone) < 0], + zone_hr, zone_min, zone_sec); + } + else + xsignal2 (Qerror, build_string ("Invalid time zone specification"), zone); +} + DEFUN ("encode-time", Fencode_time, Sencode_time, 6, MANY, 0, doc: /* Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time. This is the reverse operation of `decode-time', which see. @@ -1911,63 +2125,18 @@ usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */) if (CONSP (zone)) zone = XCAR (zone); if (NILP (zone)) - { - block_input (); - value = mktime (&tm); - unblock_input (); - } + value = mktime (&tm); else { - static char const tzbuf_format[] = "XXX%s%"pI"d:%02d:%02d"; - char tzbuf[sizeof tzbuf_format + INT_STRLEN_BOUND (EMACS_INT)]; - char *old_tzstring; - const char *tzstring; - USE_SAFE_ALLOCA; - - if (EQ (zone, Qt)) - tzstring = "UTC0"; - else if (STRINGP (zone)) - tzstring = SSDATA (zone); - else if (INTEGERP (zone)) - { - EMACS_INT abszone = eabs (XINT (zone)); - EMACS_INT zone_hr = abszone / (60*60); - int zone_min = (abszone/60) % 60; - int zone_sec = abszone % 60; - sprintf (tzbuf, tzbuf_format, &"-"[XINT (zone) < 0], - zone_hr, zone_min, zone_sec); - tzstring = tzbuf; - } - else - error ("Invalid time zone specification"); - - old_tzstring = getenv ("TZ"); - if (old_tzstring) - { - char *buf = SAFE_ALLOCA (strlen (old_tzstring) + 1); - old_tzstring = strcpy (buf, old_tzstring); - } - - block_input (); - - /* Set TZ before calling mktime; merely adjusting mktime's returned - value doesn't suffice, since that would mishandle leap seconds. */ - set_time_zone_rule (tzstring); - - value = mktime (&tm); - - set_time_zone_rule (old_tzstring); -#ifdef LOCALTIME_CACHE - tzset (); -#endif - unblock_input (); - SAFE_FREE (); + timezone_t tz = tzalloc (SSDATA (decode_time_zone (zone))); + value = mktime_z (tz, &tm); + tzfree (tz); } if (value == (time_t) -1) time_overflow (); - return make_time (value); + return list2i (hi_time (value), lo_time (value)); } DEFUN ("current-time-string", Fcurrent_time_string, Scurrent_time_string, 0, 1, 0, @@ -1987,34 +2156,27 @@ but this is considered obsolete. */) (Lisp_Object specified_time) { time_t value = lisp_seconds_argument (specified_time); - struct tm *tm; - char buf[sizeof "Mon Apr 30 12:49:17 " + INT_STRLEN_BOUND (int) + 1]; - int len IF_LINT (= 0); /* Convert to a string in ctime format, except without the trailing newline, and without the 4-digit year limit. Don't use asctime or ctime, as they might dump core if the year is outside the range -999 .. 9999. */ - block_input (); - tm = localtime (&value); - if (tm) - { - static char const wday_name[][4] = - { "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" }; - static char const mon_name[][4] = - { "Jan", "Feb", "Mar", "Apr", "May", "Jun", - "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" }; - printmax_t year_base = TM_YEAR_BASE; - - len = sprintf (buf, "%s %s%3d %02d:%02d:%02d %"pMd, - wday_name[tm->tm_wday], mon_name[tm->tm_mon], tm->tm_mday, - tm->tm_hour, tm->tm_min, tm->tm_sec, - tm->tm_year + year_base); - } - unblock_input (); - if (! tm) + struct tm tm; + if (! localtime_r (&value, &tm)) time_overflow (); + static char const wday_name[][4] = + { "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" }; + static char const mon_name[][4] = + { "Jan", "Feb", "Mar", "Apr", "May", "Jun", + "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" }; + printmax_t year_base = TM_YEAR_BASE; + char buf[sizeof "Mon Apr 30 12:49:17 " + INT_STRLEN_BOUND (int) + 1]; + int len = sprintf (buf, "%s %s%3d %02d:%02d:%02d %"pMd, + wday_name[tm.tm_wday], mon_name[tm.tm_mon], tm.tm_mday, + tm.tm_hour, tm.tm_min, tm.tm_sec, + tm.tm_year + year_base); + return make_unibyte_string (buf, len); } @@ -2041,6 +2203,17 @@ tm_diff (struct tm *a, struct tm *b) + (a->tm_sec - b->tm_sec)); } +/* Yield A's UTC offset, or an unspecified value if unknown. */ +static long int +tm_gmtoff (struct tm *a) +{ +#if HAVE_TM_GMTOFF + return a->tm_gmtoff; +#else + return 0; +#endif +} + DEFUN ("current-time-zone", Fcurrent_time_zone, Scurrent_time_zone, 0, 1, 0, doc: /* Return the offset and name for the local time zone. This returns a list of the form (OFFSET NAME). @@ -2059,32 +2232,30 @@ the data it can't find. */) (Lisp_Object specified_time) { struct timespec value; - int offset; - struct tm *t; - struct tm localtm; + struct tm local_tm, gmt_tm; Lisp_Object zone_offset, zone_name; zone_offset = Qnil; value = make_timespec (lisp_seconds_argument (specified_time), 0); - zone_name = format_time_string ("%Z", sizeof "%Z" - 1, value, 0, &localtm); - block_input (); - t = gmtime (&value.tv_sec); - if (t) - offset = tm_diff (&localtm, t); - unblock_input (); + zone_name = format_time_string ("%Z", sizeof "%Z" - 1, value, 0, &local_tm); - if (t) + if (HAVE_TM_GMTOFF || gmtime_r (&value.tv_sec, &gmt_tm)) { + long int offset = (HAVE_TM_GMTOFF + ? tm_gmtoff (&local_tm) + : tm_diff (&local_tm, &gmt_tm)); zone_offset = make_number (offset); if (SCHARS (zone_name) == 0) { /* No local time zone name is available; use "+-NNNN" instead. */ - int m = offset / 60; - int am = offset < 0 ? - m : m; - char buf[sizeof "+00" + INT_STRLEN_BOUND (int)]; - zone_name = make_formatted_string (buf, "%c%02d%02d", + long int m = offset / 60; + long int am = offset < 0 ? - m : m; + long int hour = am / 60; + int min = am % 60; + char buf[sizeof "+00" + INT_STRLEN_BOUND (long int)]; + zone_name = make_formatted_string (buf, "%c%02ld%02d", (offset < 0 ? '-' : '+'), - am / 60, am % 60); + hour, min); } } @@ -2094,7 +2265,8 @@ the data it can't find. */) DEFUN ("set-time-zone-rule", Fset_time_zone_rule, Sset_time_zone_rule, 1, 1, 0, doc: /* Set the local time zone using TZ, a string specifying a time zone rule. If TZ is nil, use implementation-defined default time zone information. -If TZ is t, use Universal Time. +If TZ is t, use Universal Time. If TZ is an integer, it is treated as in +`encode-time'. Instead of calling this function, you typically want (setenv "TZ" TZ). That changes both the environment of the Emacs process and the @@ -2102,17 +2274,7 @@ variable `process-environment', whereas `set-time-zone-rule' affects only the former. */) (Lisp_Object tz) { - const char *tzstring; - - if (! (NILP (tz) || EQ (tz, Qt))) - CHECK_STRING (tz); - - if (NILP (tz)) - tzstring = initial_tz; - else if (EQ (tz, Qt)) - tzstring = "UTC0"; - else - tzstring = SSDATA (tz); + const char *tzstring = NILP (tz) ? initial_tz : SSDATA (decode_time_zone (tz)); block_input (); set_time_zone_rule (tzstring); @@ -2123,12 +2285,12 @@ only the former. */) /* Set the local time zone rule to TZSTRING. - This function is not thread-safe, partly because putenv, unsetenv - and tzset are not, and partly because of the static storage it - updates. Other threads that invoke localtime etc. may be adversely - affected while this function is executing. */ + This function is not thread-safe, in theory because putenv is not, + but mostly because of the static storage it updates. Other threads + that invoke localtime etc. may be adversely affected while this + function is executing. */ -void +static void set_time_zone_rule (const char *tzstring) { /* A buffer holding a string of the form "TZ=value", intended @@ -2137,75 +2299,47 @@ set_time_zone_rule (const char *tzstring) static ptrdiff_t tzvalbufsize; int tzeqlen = sizeof "TZ=" - 1; + ptrdiff_t tzstringlen = tzstring ? strlen (tzstring) : 0; + char *tzval = tzvalbuf; + bool new_tzvalbuf = tzvalbufsize <= tzeqlen + tzstringlen; -#ifdef LOCALTIME_CACHE - /* These two values are known to load tz files in buggy implementations, - i.e., Solaris 1 executables running under either Solaris 1 or Solaris 2. - Their values shouldn't matter in non-buggy implementations. - We don't use string literals for these strings, - since if a string in the environment is in readonly - storage, it runs afoul of bugs in SVR4 and Solaris 2.3. - See Sun bugs 1113095 and 1114114, ``Timezone routines - improperly modify environment''. */ - - static char set_time_zone_rule_tz[][sizeof "TZ=GMT+0"] - = { "TZ=GMT+0", "TZ=GMT+1" }; - - /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like - "US/Pacific" that loads a tz file, then changes to a value like - "XXX0" that does not load a tz file, and then changes back to - its original value, the last change is (incorrectly) ignored. - Also, if TZ changes twice in succession to values that do - not load a tz file, tzset can dump core (see Sun bug#1225179). - The following code works around these bugs. */ + if (new_tzvalbuf) + { + /* Do not attempt to free the old tzvalbuf, since another thread + may be using it. In practice, the first allocation is large + enough and memory does not leak. */ + tzval = xpalloc (NULL, &tzvalbufsize, + tzeqlen + tzstringlen - tzvalbufsize + 1, -1, 1); + tzvalbuf = tzval; + tzval[1] = 'Z'; + tzval[2] = '='; + } if (tzstring) { - /* Temporarily set TZ to a value that loads a tz file - and that differs from tzstring. */ - bool eq0 = strcmp (tzstring, set_time_zone_rule_tz[0] + tzeqlen) == 0; - xputenv (set_time_zone_rule_tz[eq0]); + /* Modify TZVAL in place. Although this is dicey in a + multithreaded environment, we know of no portable alternative. + Calling putenv or setenv could crash some other thread. */ + tzval[0] = 'T'; + strcpy (tzval + tzeqlen, tzstring); } else { - /* The implied tzstring is unknown, so temporarily set TZ to - two different values that each load a tz file. */ - xputenv (set_time_zone_rule_tz[0]); - tzset (); - xputenv (set_time_zone_rule_tz[1]); + /* Turn 'TZ=whatever' into an empty environment variable 'tZ='. + Although this is also dicey, calling unsetenv here can crash Emacs. + See Bug#8705. */ + tzval[0] = 't'; + tzval[tzeqlen] = 0; } - tzset (); - tzvalbuf_in_environ = 0; -#endif - if (!tzstring) + if (new_tzvalbuf) { - unsetenv ("TZ"); - tzvalbuf_in_environ = 0; + /* Although this is not thread-safe, in practice this runs only + on startup when there is only one thread. */ + xputenv (tzval); } - else - { - ptrdiff_t tzstringlen = strlen (tzstring); - - if (tzvalbufsize <= tzeqlen + tzstringlen) - { - unsetenv ("TZ"); - tzvalbuf_in_environ = 0; - tzvalbuf = xpalloc (tzvalbuf, &tzvalbufsize, - tzeqlen + tzstringlen - tzvalbufsize + 1, -1, 1); - memcpy (tzvalbuf, "TZ=", tzeqlen); - } - strcpy (tzvalbuf + tzeqlen, tzstring); - - if (!tzvalbuf_in_environ) - { - xputenv (tzvalbuf); - tzvalbuf_in_environ = 1; - } - } - -#ifdef LOCALTIME_CACHE +#ifdef HAVE_TZSET tzset (); #endif } @@ -2490,15 +2624,34 @@ make_buffer_string_both (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, ptrdiff_t end_byte, bool props) { Lisp_Object result, tem, tem1; + ptrdiff_t beg0, end0, beg1, end1, size; - if (start < GPT && GPT < end) - move_gap_both (start, start_byte); + if (start_byte < GPT_BYTE && GPT_BYTE < end_byte) + { + /* Two regions, before and after the gap. */ + beg0 = start_byte; + end0 = GPT_BYTE; + beg1 = GPT_BYTE + GAP_SIZE - BEG_BYTE; + end1 = end_byte + GAP_SIZE - BEG_BYTE; + } + else + { + /* The only region. */ + beg0 = start_byte; + end0 = end_byte; + beg1 = -1; + end1 = -1; + } if (! NILP (BVAR (current_buffer, enable_multibyte_characters))) result = make_uninit_multibyte_string (end - start, end_byte - start_byte); else result = make_uninit_string (end - start); - memcpy (SDATA (result), BYTE_POS_ADDR (start_byte), end_byte - start_byte); + + size = end0 - beg0; + memcpy (SDATA (result), BYTE_POS_ADDR (beg0), size); + if (beg1 != -1) + memcpy (SDATA (result) + size, BEG_ADDR + beg1, end1 - beg1); /* If desired, update and copy the text properties. */ if (props) @@ -4819,6 +4972,7 @@ functions if all the text being accessed has this property. */); DEFVAR_LISP ("system-name", Vsystem_name, doc: /* The host name of the machine Emacs is running on. */); + Vsystem_name = cached_system_name = Qnil; DEFVAR_LISP ("user-full-name", Vuser_full_name, doc: /* The full name of the user logged in. */); @@ -4849,8 +5003,12 @@ functions if all the text being accessed has this property. */); defsubr (&Sregion_beginning); defsubr (&Sregion_end); + /* Symbol for the text property used to mark fields. */ DEFSYM (Qfield, "field"); + + /* A special value for Qfield properties. */ DEFSYM (Qboundary, "boundary"); + defsubr (&Sfield_beginning); defsubr (&Sfield_end); defsubr (&Sfield_string); @@ -4898,6 +5056,9 @@ functions if all the text being accessed has this property. */); defsubr (&Suser_full_name); defsubr (&Semacs_pid); defsubr (&Scurrent_time); + defsubr (&Stime_add); + defsubr (&Stime_subtract); + defsubr (&Stime_less_p); defsubr (&Sget_internal_run_time); defsubr (&Sformat_time_string); defsubr (&Sfloat_time);