aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/alloc.c200
-rw-r--r--src/callint.c1
-rw-r--r--src/callproc.c40
-rw-r--r--src/charset.c20
-rw-r--r--src/cm.c1
-rw-r--r--src/dired.c149
-rw-r--r--src/doc.c2
-rw-r--r--src/emacs.c3
-rw-r--r--src/eval.c9
-rw-r--r--src/fileio.c478
-rw-r--r--src/filelock.c86
-rw-r--r--src/fns.c3
-rw-r--r--src/lisp.h11
-rw-r--r--src/lread.c21
-rw-r--r--src/print.c100
-rw-r--r--src/profiler.c12
-rw-r--r--src/term.c1
-rw-r--r--src/w32.c29
-rw-r--r--src/w32fns.c4
-rw-r--r--src/w32font.c127
-rw-r--r--src/xdisp.c8
-rw-r--r--src/xwidget.c219
22 files changed, 816 insertions, 708 deletions
diff --git a/src/alloc.c b/src/alloc.c
index 2d490f3bb75..9fbd0d05739 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -224,7 +224,7 @@ struct emacs_globals globals;
224 224
225/* maybe_gc collects garbage if this goes negative. */ 225/* maybe_gc collects garbage if this goes negative. */
226 226
227intmax_t consing_until_gc; 227EMACS_INT consing_until_gc;
228 228
229#ifdef HAVE_PDUMPER 229#ifdef HAVE_PDUMPER
230/* Number of finalizers run: used to loop over GC until we stop 230/* Number of finalizers run: used to loop over GC until we stop
@@ -238,10 +238,17 @@ bool gc_in_progress;
238 238
239/* System byte and object counts reported by GC. */ 239/* System byte and object counts reported by GC. */
240 240
241/* Assume byte counts fit in uintptr_t and object counts fit into
242 intptr_t. */
241typedef uintptr_t byte_ct; 243typedef uintptr_t byte_ct;
242typedef intptr_t object_ct; 244typedef intptr_t object_ct;
243 245
244/* Number of live and free conses etc. */ 246/* Large-magnitude value for a threshold count, which fits in EMACS_INT.
247 Using only half the EMACS_INT range avoids overflow hassles.
248 There is no need to fit these counts into fixnums. */
249#define HI_THRESHOLD (EMACS_INT_MAX / 2)
250
251/* Number of live and free conses etc. counted by the most-recent GC. */
245 252
246static struct gcstat 253static struct gcstat
247{ 254{
@@ -299,7 +306,7 @@ static intptr_t garbage_collection_inhibited;
299 306
300/* The GC threshold in bytes, the last time it was calculated 307/* The GC threshold in bytes, the last time it was calculated
301 from gc-cons-threshold and gc-cons-percentage. */ 308 from gc-cons-threshold and gc-cons-percentage. */
302static intmax_t gc_threshold; 309static EMACS_INT gc_threshold;
303 310
304/* If nonzero, this is a warning delivered by malloc and not yet 311/* If nonzero, this is a warning delivered by malloc and not yet
305 displayed. */ 312 displayed. */
@@ -536,6 +543,15 @@ XFLOAT_INIT (Lisp_Object f, double n)
536 XFLOAT (f)->u.data = n; 543 XFLOAT (f)->u.data = n;
537} 544}
538 545
546/* Account for allocation of NBYTES in the heap. This is a separate
547 function to avoid hassles with implementation-defined conversion
548 from unsigned to signed types. */
549static void
550tally_consing (ptrdiff_t nbytes)
551{
552 consing_until_gc -= nbytes;
553}
554
539#ifdef DOUG_LEA_MALLOC 555#ifdef DOUG_LEA_MALLOC
540static bool 556static bool
541pointers_fit_in_lispobj_p (void) 557pointers_fit_in_lispobj_p (void)
@@ -560,7 +576,7 @@ struct Lisp_Finalizer finalizers;
560 576
561/* Head of a circularly-linked list of finalizers that must be invoked 577/* Head of a circularly-linked list of finalizers that must be invoked
562 because we deemed them unreachable. This list must be global, and 578 because we deemed them unreachable. This list must be global, and
563 not a local inside garbage_collect_1, in case we GC again while 579 not a local inside garbage_collect, in case we GC again while
564 running finalizers. */ 580 running finalizers. */
565struct Lisp_Finalizer doomed_finalizers; 581struct Lisp_Finalizer doomed_finalizers;
566 582
@@ -1366,16 +1382,14 @@ make_interval (void)
1366 newi->next = interval_block; 1382 newi->next = interval_block;
1367 interval_block = newi; 1383 interval_block = newi;
1368 interval_block_index = 0; 1384 interval_block_index = 0;
1369 gcstat.total_free_intervals += INTERVAL_BLOCK_SIZE;
1370 } 1385 }
1371 val = &interval_block->intervals[interval_block_index++]; 1386 val = &interval_block->intervals[interval_block_index++];
1372 } 1387 }
1373 1388
1374 MALLOC_UNBLOCK_INPUT; 1389 MALLOC_UNBLOCK_INPUT;
1375 1390
1376 consing_until_gc -= sizeof (struct interval); 1391 tally_consing (sizeof (struct interval));
1377 intervals_consed++; 1392 intervals_consed++;
1378 gcstat.total_free_intervals--;
1379 RESET_INTERVAL (val); 1393 RESET_INTERVAL (val);
1380 val->gcmarkbit = 0; 1394 val->gcmarkbit = 0;
1381 return val; 1395 return val;
@@ -1730,8 +1744,6 @@ allocate_string (void)
1730 NEXT_FREE_LISP_STRING (s) = string_free_list; 1744 NEXT_FREE_LISP_STRING (s) = string_free_list;
1731 string_free_list = ptr_bounds_clip (s, sizeof *s); 1745 string_free_list = ptr_bounds_clip (s, sizeof *s);
1732 } 1746 }
1733
1734 gcstat.total_free_strings += STRING_BLOCK_SIZE;
1735 } 1747 }
1736 1748
1737 check_string_free_list (); 1749 check_string_free_list ();
@@ -1742,10 +1754,8 @@ allocate_string (void)
1742 1754
1743 MALLOC_UNBLOCK_INPUT; 1755 MALLOC_UNBLOCK_INPUT;
1744 1756
1745 gcstat.total_free_strings--;
1746 gcstat.total_strings++;
1747 ++strings_consed; 1757 ++strings_consed;
1748 consing_until_gc -= sizeof *s; 1758 tally_consing (sizeof *s);
1749 1759
1750#ifdef GC_CHECK_STRING_BYTES 1760#ifdef GC_CHECK_STRING_BYTES
1751 if (!noninteractive) 1761 if (!noninteractive)
@@ -1865,7 +1875,7 @@ allocate_string_data (struct Lisp_String *s,
1865 old_data->string = NULL; 1875 old_data->string = NULL;
1866 } 1876 }
1867 1877
1868 consing_until_gc -= needed; 1878 tally_consing (needed);
1869} 1879}
1870 1880
1871 1881
@@ -2461,7 +2471,6 @@ make_float (double float_value)
2461 memset (new->gcmarkbits, 0, sizeof new->gcmarkbits); 2471 memset (new->gcmarkbits, 0, sizeof new->gcmarkbits);
2462 float_block = new; 2472 float_block = new;
2463 float_block_index = 0; 2473 float_block_index = 0;
2464 gcstat.total_free_floats += FLOAT_BLOCK_SIZE;
2465 } 2474 }
2466 XSETFLOAT (val, &float_block->floats[float_block_index]); 2475 XSETFLOAT (val, &float_block->floats[float_block_index]);
2467 float_block_index++; 2476 float_block_index++;
@@ -2471,9 +2480,8 @@ make_float (double float_value)
2471 2480
2472 XFLOAT_INIT (val, float_value); 2481 XFLOAT_INIT (val, float_value);
2473 eassert (!XFLOAT_MARKED_P (XFLOAT (val))); 2482 eassert (!XFLOAT_MARKED_P (XFLOAT (val)));
2474 consing_until_gc -= sizeof (struct Lisp_Float); 2483 tally_consing (sizeof (struct Lisp_Float));
2475 floats_consed++; 2484 floats_consed++;
2476 gcstat.total_free_floats--;
2477 return val; 2485 return val;
2478} 2486}
2479 2487
@@ -2543,9 +2551,8 @@ free_cons (struct Lisp_Cons *ptr)
2543 ptr->u.s.u.chain = cons_free_list; 2551 ptr->u.s.u.chain = cons_free_list;
2544 ptr->u.s.car = dead_object (); 2552 ptr->u.s.car = dead_object ();
2545 cons_free_list = ptr; 2553 cons_free_list = ptr;
2546 if (INT_ADD_WRAPV (consing_until_gc, sizeof *ptr, &consing_until_gc)) 2554 ptrdiff_t nbytes = sizeof *ptr;
2547 consing_until_gc = INTMAX_MAX; 2555 tally_consing (-nbytes);
2548 gcstat.total_free_conses++;
2549} 2556}
2550 2557
2551DEFUN ("cons", Fcons, Scons, 2, 2, 0, 2558DEFUN ("cons", Fcons, Scons, 2, 2, 0,
@@ -2565,26 +2572,12 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0,
2565 { 2572 {
2566 if (cons_block_index == CONS_BLOCK_SIZE) 2573 if (cons_block_index == CONS_BLOCK_SIZE)
2567 { 2574 {
2568 /* Maximum number of conses that should be active at any
2569 given time, so that list lengths fit into a ptrdiff_t and
2570 into a fixnum. */
2571 ptrdiff_t max_conses = min (PTRDIFF_MAX, MOST_POSITIVE_FIXNUM);
2572
2573 /* This check is typically optimized away, as a runtime
2574 check is needed only on weird platforms where a count of
2575 distinct conses might not fit. */
2576 if (max_conses < INTPTR_MAX / sizeof (struct Lisp_Cons)
2577 && (max_conses - CONS_BLOCK_SIZE
2578 < gcstat.total_free_conses + gcstat.total_conses))
2579 memory_full (sizeof (struct cons_block));
2580
2581 struct cons_block *new 2575 struct cons_block *new
2582 = lisp_align_malloc (sizeof *new, MEM_TYPE_CONS); 2576 = lisp_align_malloc (sizeof *new, MEM_TYPE_CONS);
2583 memset (new->gcmarkbits, 0, sizeof new->gcmarkbits); 2577 memset (new->gcmarkbits, 0, sizeof new->gcmarkbits);
2584 new->next = cons_block; 2578 new->next = cons_block;
2585 cons_block = new; 2579 cons_block = new;
2586 cons_block_index = 0; 2580 cons_block_index = 0;
2587 gcstat.total_free_conses += CONS_BLOCK_SIZE;
2588 } 2581 }
2589 XSETCONS (val, &cons_block->conses[cons_block_index]); 2582 XSETCONS (val, &cons_block->conses[cons_block_index]);
2590 cons_block_index++; 2583 cons_block_index++;
@@ -2596,7 +2589,6 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0,
2596 XSETCDR (val, cdr); 2589 XSETCDR (val, cdr);
2597 eassert (!XCONS_MARKED_P (XCONS (val))); 2590 eassert (!XCONS_MARKED_P (XCONS (val)));
2598 consing_until_gc -= sizeof (struct Lisp_Cons); 2591 consing_until_gc -= sizeof (struct Lisp_Cons);
2599 gcstat.total_free_conses--;
2600 cons_cells_consed++; 2592 cons_cells_consed++;
2601 return val; 2593 return val;
2602} 2594}
@@ -2855,7 +2847,6 @@ setup_on_free_list (struct Lisp_Vector *v, ptrdiff_t nbytes)
2855 eassert (vindex < VECTOR_MAX_FREE_LIST_INDEX); 2847 eassert (vindex < VECTOR_MAX_FREE_LIST_INDEX);
2856 set_next_vector (v, vector_free_lists[vindex]); 2848 set_next_vector (v, vector_free_lists[vindex]);
2857 vector_free_lists[vindex] = v; 2849 vector_free_lists[vindex] = v;
2858 gcstat.total_free_vector_slots += nbytes / word_size;
2859} 2850}
2860 2851
2861/* Get a new vector block. */ 2852/* Get a new vector block. */
@@ -2903,7 +2894,6 @@ allocate_vector_from_block (ptrdiff_t nbytes)
2903 { 2894 {
2904 vector = vector_free_lists[index]; 2895 vector = vector_free_lists[index];
2905 vector_free_lists[index] = next_vector (vector); 2896 vector_free_lists[index] = next_vector (vector);
2906 gcstat.total_free_vector_slots -= nbytes / word_size;
2907 return vector; 2897 return vector;
2908 } 2898 }
2909 2899
@@ -2917,7 +2907,6 @@ allocate_vector_from_block (ptrdiff_t nbytes)
2917 /* This vector is larger than requested. */ 2907 /* This vector is larger than requested. */
2918 vector = vector_free_lists[index]; 2908 vector = vector_free_lists[index];
2919 vector_free_lists[index] = next_vector (vector); 2909 vector_free_lists[index] = next_vector (vector);
2920 gcstat.total_free_vector_slots -= nbytes / word_size;
2921 2910
2922 /* Excess bytes are used for the smaller vector, 2911 /* Excess bytes are used for the smaller vector,
2923 which should be set on an appropriate free list. */ 2912 which should be set on an appropriate free list. */
@@ -3092,7 +3081,10 @@ sweep_vectors (void)
3092 space was coalesced into the only free vector. */ 3081 space was coalesced into the only free vector. */
3093 free_this_block = true; 3082 free_this_block = true;
3094 else 3083 else
3095 setup_on_free_list (vector, total_bytes); 3084 {
3085 setup_on_free_list (vector, total_bytes);
3086 gcstat.total_free_vector_slots += total_bytes / word_size;
3087 }
3096 } 3088 }
3097 } 3089 }
3098 3090
@@ -3177,7 +3169,7 @@ allocate_vectorlike (ptrdiff_t len)
3177 if (find_suspicious_object_in_range (p, (char *) p + nbytes)) 3169 if (find_suspicious_object_in_range (p, (char *) p + nbytes))
3178 emacs_abort (); 3170 emacs_abort ();
3179 3171
3180 consing_until_gc -= nbytes; 3172 tally_consing (nbytes);
3181 vector_cells_consed += len; 3173 vector_cells_consed += len;
3182 3174
3183 MALLOC_UNBLOCK_INPUT; 3175 MALLOC_UNBLOCK_INPUT;
@@ -3454,7 +3446,6 @@ Its value is void, and its function definition and property list are nil. */)
3454 new->next = symbol_block; 3446 new->next = symbol_block;
3455 symbol_block = new; 3447 symbol_block = new;
3456 symbol_block_index = 0; 3448 symbol_block_index = 0;
3457 gcstat.total_free_symbols += SYMBOL_BLOCK_SIZE;
3458 } 3449 }
3459 XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index]); 3450 XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index]);
3460 symbol_block_index++; 3451 symbol_block_index++;
@@ -3463,9 +3454,8 @@ Its value is void, and its function definition and property list are nil. */)
3463 MALLOC_UNBLOCK_INPUT; 3454 MALLOC_UNBLOCK_INPUT;
3464 3455
3465 init_symbol (val, name); 3456 init_symbol (val, name);
3466 consing_until_gc -= sizeof (struct Lisp_Symbol); 3457 tally_consing (sizeof (struct Lisp_Symbol));
3467 symbols_consed++; 3458 symbols_consed++;
3468 gcstat.total_free_symbols--;
3469 return val; 3459 return val;
3470} 3460}
3471 3461
@@ -5503,7 +5493,7 @@ staticpro (Lisp_Object const *varaddress)
5503static void 5493static void
5504allow_garbage_collection (intmax_t consing) 5494allow_garbage_collection (intmax_t consing)
5505{ 5495{
5506 consing_until_gc = consing - (INTMAX_MAX - consing_until_gc); 5496 consing_until_gc = consing - (HI_THRESHOLD - consing_until_gc);
5507 garbage_collection_inhibited--; 5497 garbage_collection_inhibited--;
5508} 5498}
5509 5499
@@ -5513,7 +5503,7 @@ inhibit_garbage_collection (void)
5513 ptrdiff_t count = SPECPDL_INDEX (); 5503 ptrdiff_t count = SPECPDL_INDEX ();
5514 record_unwind_protect_intmax (allow_garbage_collection, consing_until_gc); 5504 record_unwind_protect_intmax (allow_garbage_collection, consing_until_gc);
5515 garbage_collection_inhibited++; 5505 garbage_collection_inhibited++;
5516 consing_until_gc = INTMAX_MAX; 5506 consing_until_gc = HI_THRESHOLD;
5517 return count; 5507 return count;
5518} 5508}
5519 5509
@@ -5723,7 +5713,7 @@ visit_buffer_root (struct gc_root_visitor visitor,
5723 5713
5724 There are other GC roots of course, but these roots are dynamic 5714 There are other GC roots of course, but these roots are dynamic
5725 runtime data structures that pdump doesn't care about and so we can 5715 runtime data structures that pdump doesn't care about and so we can
5726 continue to mark those directly in garbage_collect_1. */ 5716 continue to mark those directly in garbage_collect. */
5727void 5717void
5728visit_static_gc_roots (struct gc_root_visitor visitor) 5718visit_static_gc_roots (struct gc_root_visitor visitor)
5729{ 5719{
@@ -5753,8 +5743,7 @@ mark_object_root_visitor (Lisp_Object const *root_ptr,
5753} 5743}
5754 5744
5755/* List of weak hash tables we found during marking the Lisp heap. 5745/* List of weak hash tables we found during marking the Lisp heap.
5756 Will be NULL on entry to garbage_collect_1 and after it 5746 NULL on entry to garbage_collect and after it returns. */
5757 returns. */
5758static struct Lisp_Hash_Table *weak_hash_tables; 5747static struct Lisp_Hash_Table *weak_hash_tables;
5759 5748
5760NO_INLINE /* For better stack traces */ 5749NO_INLINE /* For better stack traces */
@@ -5788,11 +5777,13 @@ mark_and_sweep_weak_table_contents (void)
5788 } 5777 }
5789} 5778}
5790 5779
5791/* Return the number of bytes to cons between GCs, assuming 5780/* Return the number of bytes to cons between GCs, given THRESHOLD and
5792 gc-cons-threshold is THRESHOLD and gc-cons-percentage is 5781 PERCENTAGE. When calculating a threshold based on PERCENTAGE,
5793 PERCENTAGE. */ 5782 assume SINCE_GC bytes have been allocated since the most recent GC.
5794static intmax_t 5783 The returned value is positive and no greater than HI_THRESHOLD. */
5795consing_threshold (intmax_t threshold, Lisp_Object percentage) 5784static EMACS_INT
5785consing_threshold (intmax_t threshold, Lisp_Object percentage,
5786 intmax_t since_gc)
5796{ 5787{
5797 if (!NILP (Vmemory_full)) 5788 if (!NILP (Vmemory_full))
5798 return memory_full_cons_threshold; 5789 return memory_full_cons_threshold;
@@ -5802,42 +5793,33 @@ consing_threshold (intmax_t threshold, Lisp_Object percentage)
5802 if (FLOATP (percentage)) 5793 if (FLOATP (percentage))
5803 { 5794 {
5804 double tot = (XFLOAT_DATA (percentage) 5795 double tot = (XFLOAT_DATA (percentage)
5805 * total_bytes_of_live_objects ()); 5796 * (total_bytes_of_live_objects () + since_gc));
5806 if (threshold < tot) 5797 if (threshold < tot)
5807 { 5798 {
5808 if (tot < INTMAX_MAX) 5799 if (tot < HI_THRESHOLD)
5809 threshold = tot; 5800 return tot;
5810 else 5801 else
5811 threshold = INTMAX_MAX; 5802 return HI_THRESHOLD;
5812 } 5803 }
5813 } 5804 }
5814 return threshold; 5805 return min (threshold, HI_THRESHOLD);
5815 } 5806 }
5816} 5807}
5817 5808
5818/* Adjust consing_until_gc, assuming gc-cons-threshold is THRESHOLD and 5809/* Adjust consing_until_gc and gc_threshold, given THRESHOLD and PERCENTAGE.
5819 gc-cons-percentage is PERCENTAGE. */ 5810 Return the updated consing_until_gc. */
5820static Lisp_Object 5811
5812static EMACS_INT
5821bump_consing_until_gc (intmax_t threshold, Lisp_Object percentage) 5813bump_consing_until_gc (intmax_t threshold, Lisp_Object percentage)
5822{ 5814{
5823 /* If consing_until_gc is negative leave it alone, since this prevents 5815 /* Guesstimate that half the bytes allocated since the most
5824 negative integer overflow and a GC would have been done soon anyway. */ 5816 recent GC are still in use. */
5825 if (0 <= consing_until_gc) 5817 EMACS_INT since_gc = (gc_threshold - consing_until_gc) >> 1;
5826 { 5818 EMACS_INT new_gc_threshold = consing_threshold (threshold, percentage,
5827 threshold = consing_threshold (threshold, percentage); 5819 since_gc);
5828 intmax_t sum; 5820 consing_until_gc += new_gc_threshold - gc_threshold;
5829 if (INT_ADD_WRAPV (consing_until_gc, threshold - gc_threshold, &sum)) 5821 gc_threshold = new_gc_threshold;
5830 { 5822 return consing_until_gc;
5831 /* Scale the threshold down so that consing_until_gc does
5832 not overflow. */
5833 sum = INTMAX_MAX;
5834 threshold = INTMAX_MAX - consing_until_gc + gc_threshold;
5835 }
5836 consing_until_gc = sum;
5837 gc_threshold = threshold;
5838 }
5839
5840 return Qnil;
5841} 5823}
5842 5824
5843/* Watch changes to gc-cons-threshold. */ 5825/* Watch changes to gc-cons-threshold. */
@@ -5848,7 +5830,8 @@ watch_gc_cons_threshold (Lisp_Object symbol, Lisp_Object newval,
5848 intmax_t threshold; 5830 intmax_t threshold;
5849 if (! (INTEGERP (newval) && integer_to_intmax (newval, &threshold))) 5831 if (! (INTEGERP (newval) && integer_to_intmax (newval, &threshold)))
5850 return Qnil; 5832 return Qnil;
5851 return bump_consing_until_gc (threshold, Vgc_cons_percentage); 5833 bump_consing_until_gc (threshold, Vgc_cons_percentage);
5834 return Qnil;
5852} 5835}
5853 5836
5854/* Watch changes to gc-cons-percentage. */ 5837/* Watch changes to gc-cons-percentage. */
@@ -5856,24 +5839,34 @@ static Lisp_Object
5856watch_gc_cons_percentage (Lisp_Object symbol, Lisp_Object newval, 5839watch_gc_cons_percentage (Lisp_Object symbol, Lisp_Object newval,
5857 Lisp_Object operation, Lisp_Object where) 5840 Lisp_Object operation, Lisp_Object where)
5858{ 5841{
5859 return bump_consing_until_gc (gc_cons_threshold, newval); 5842 bump_consing_until_gc (gc_cons_threshold, newval);
5843 return Qnil;
5844}
5845
5846/* It may be time to collect garbage. Recalculate consing_until_gc,
5847 since it might depend on current usage, and do the garbage
5848 collection if the recalculation says so. */
5849void
5850maybe_garbage_collect (void)
5851{
5852 if (bump_consing_until_gc (gc_cons_threshold, Vgc_cons_percentage) < 0)
5853 garbage_collect ();
5860} 5854}
5861 5855
5862/* Subroutine of Fgarbage_collect that does most of the work. */ 5856/* Subroutine of Fgarbage_collect that does most of the work. */
5863static bool 5857void
5864garbage_collect_1 (struct gcstat *gcst) 5858garbage_collect (void)
5865{ 5859{
5866 struct buffer *nextb; 5860 struct buffer *nextb;
5867 char stack_top_variable; 5861 char stack_top_variable;
5868 bool message_p; 5862 bool message_p;
5869 ptrdiff_t count = SPECPDL_INDEX (); 5863 ptrdiff_t count = SPECPDL_INDEX ();
5870 struct timespec start; 5864 struct timespec start;
5871 byte_ct tot_before = 0;
5872 5865
5873 eassert (weak_hash_tables == NULL); 5866 eassert (weak_hash_tables == NULL);
5874 5867
5875 if (garbage_collection_inhibited) 5868 if (garbage_collection_inhibited)
5876 return false; 5869 return;
5877 5870
5878 /* Record this function, so it appears on the profiler's backtraces. */ 5871 /* Record this function, so it appears on the profiler's backtraces. */
5879 record_in_backtrace (QAutomatic_GC, 0, 0); 5872 record_in_backtrace (QAutomatic_GC, 0, 0);
@@ -5883,14 +5876,15 @@ garbage_collect_1 (struct gcstat *gcst)
5883 FOR_EACH_BUFFER (nextb) 5876 FOR_EACH_BUFFER (nextb)
5884 compact_buffer (nextb); 5877 compact_buffer (nextb);
5885 5878
5886 if (profiler_memory_running) 5879 byte_ct tot_before = (profiler_memory_running
5887 tot_before = total_bytes_of_live_objects (); 5880 ? total_bytes_of_live_objects ()
5881 : (byte_ct) -1);
5888 5882
5889 start = current_timespec (); 5883 start = current_timespec ();
5890 5884
5891 /* In case user calls debug_print during GC, 5885 /* In case user calls debug_print during GC,
5892 don't let that cause a recursive GC. */ 5886 don't let that cause a recursive GC. */
5893 consing_until_gc = INTMAX_MAX; 5887 consing_until_gc = HI_THRESHOLD;
5894 5888
5895 /* Save what's currently displayed in the echo area. Don't do that 5889 /* Save what's currently displayed in the echo area. Don't do that
5896 if we are GC'ing because we've run out of memory, since 5890 if we are GC'ing because we've run out of memory, since
@@ -6002,7 +5996,7 @@ garbage_collect_1 (struct gcstat *gcst)
6002 unblock_input (); 5996 unblock_input ();
6003 5997
6004 consing_until_gc = gc_threshold 5998 consing_until_gc = gc_threshold
6005 = consing_threshold (gc_cons_threshold, Vgc_cons_percentage); 5999 = consing_threshold (gc_cons_threshold, Vgc_cons_percentage, 0);
6006 6000
6007 if (garbage_collection_messages && NILP (Vmemory_full)) 6001 if (garbage_collection_messages && NILP (Vmemory_full))
6008 { 6002 {
@@ -6014,8 +6008,6 @@ garbage_collect_1 (struct gcstat *gcst)
6014 6008
6015 unbind_to (count, Qnil); 6009 unbind_to (count, Qnil);
6016 6010
6017 *gcst = gcstat;
6018
6019 /* GC is complete: now we can run our finalizer callbacks. */ 6011 /* GC is complete: now we can run our finalizer callbacks. */
6020 run_finalizers (&doomed_finalizers); 6012 run_finalizers (&doomed_finalizers);
6021 6013
@@ -6029,29 +6021,21 @@ garbage_collect_1 (struct gcstat *gcst)
6029 /* Accumulate statistics. */ 6021 /* Accumulate statistics. */
6030 if (FLOATP (Vgc_elapsed)) 6022 if (FLOATP (Vgc_elapsed))
6031 { 6023 {
6032 struct timespec since_start = timespec_sub (current_timespec (), start); 6024 static struct timespec gc_elapsed;
6033 Vgc_elapsed = make_float (XFLOAT_DATA (Vgc_elapsed) 6025 gc_elapsed = timespec_add (gc_elapsed,
6034 + timespectod (since_start)); 6026 timespec_sub (current_timespec (), start));
6027 Vgc_elapsed = make_float (timespectod (gc_elapsed));
6035 } 6028 }
6036 6029
6037 gcs_done++; 6030 gcs_done++;
6038 6031
6039 /* Collect profiling data. */ 6032 /* Collect profiling data. */
6040 if (profiler_memory_running) 6033 if (tot_before != (byte_ct) -1)
6041 { 6034 {
6042 byte_ct tot_after = total_bytes_of_live_objects (); 6035 byte_ct tot_after = total_bytes_of_live_objects ();
6043 byte_ct swept = tot_before <= tot_after ? 0 : tot_before - tot_after; 6036 if (tot_after < tot_before)
6044 malloc_probe (min (swept, SIZE_MAX)); 6037 malloc_probe (min (tot_before - tot_after, SIZE_MAX));
6045 } 6038 }
6046
6047 return true;
6048}
6049
6050void
6051garbage_collect (void)
6052{
6053 struct gcstat gcst;
6054 garbage_collect_1 (&gcst);
6055} 6039}
6056 6040
6057DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "", 6041DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "",
@@ -6071,10 +6055,12 @@ returns nil, because real GC can't be done.
6071See Info node `(elisp)Garbage Collection'. */) 6055See Info node `(elisp)Garbage Collection'. */)
6072 (void) 6056 (void)
6073{ 6057{
6074 struct gcstat gcst; 6058 if (garbage_collection_inhibited)
6075 if (!garbage_collect_1 (&gcst))
6076 return Qnil; 6059 return Qnil;
6077 6060
6061 garbage_collect ();
6062 struct gcstat gcst = gcstat;
6063
6078 Lisp_Object total[] = { 6064 Lisp_Object total[] = {
6079 list4 (Qconses, make_fixnum (sizeof (struct Lisp_Cons)), 6065 list4 (Qconses, make_fixnum (sizeof (struct Lisp_Cons)),
6080 make_int (gcst.total_conses), 6066 make_int (gcst.total_conses),
diff --git a/src/callint.c b/src/callint.c
index d76836f32b2..449b5048609 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -35,7 +35,6 @@ static Lisp_Object point_marker;
35/* String for the prompt text used in Fcall_interactively. */ 35/* String for the prompt text used in Fcall_interactively. */
36static Lisp_Object callint_message; 36static Lisp_Object callint_message;
37 37
38/* ARGSUSED */
39DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0, 38DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0,
40 doc: /* Specify a way of parsing arguments for interactive use of a function. 39 doc: /* Specify a way of parsing arguments for interactive use of a function.
41For example, write 40For example, write
diff --git a/src/callproc.c b/src/callproc.c
index b296bdb088b..dbbf15c792a 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -108,11 +108,8 @@ static Lisp_Object call_process (ptrdiff_t, Lisp_Object *, int, ptrdiff_t);
108Lisp_Object 108Lisp_Object
109encode_current_directory (void) 109encode_current_directory (void)
110{ 110{
111 Lisp_Object dir; 111 Lisp_Object curdir = BVAR (current_buffer, directory);
112 112 Lisp_Object dir = Funhandled_file_name_directory (curdir);
113 dir = BVAR (current_buffer, directory);
114
115 dir = Funhandled_file_name_directory (dir);
116 113
117 /* If the file name handler says that dir is unreachable, use 114 /* If the file name handler says that dir is unreachable, use
118 a sensible default. */ 115 a sensible default. */
@@ -120,17 +117,10 @@ encode_current_directory (void)
120 dir = build_string ("~"); 117 dir = build_string ("~");
121 118
122 dir = expand_and_dir_to_file (dir); 119 dir = expand_and_dir_to_file (dir);
123
124 if (NILP (Ffile_accessible_directory_p (dir)))
125 report_file_error ("Setting current directory",
126 BVAR (current_buffer, directory));
127
128 /* Remove "/:" from DIR and encode it. */
129 dir = ENCODE_FILE (remove_slash_colon (dir)); 120 dir = ENCODE_FILE (remove_slash_colon (dir));
130 121
131 if (! file_accessible_directory_p (dir)) 122 if (! file_accessible_directory_p (dir))
132 report_file_error ("Setting current directory", 123 report_file_error ("Setting current directory", curdir);
133 BVAR (current_buffer, directory));
134 124
135 return dir; 125 return dir;
136} 126}
@@ -1570,20 +1560,19 @@ init_callproc (void)
1570 source directory. */ 1560 source directory. */
1571 if (data_dir == 0) 1561 if (data_dir == 0)
1572 { 1562 {
1573 Lisp_Object tem, tem1, srcdir; 1563 Lisp_Object tem, srcdir;
1574 Lisp_Object lispdir = Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH, 0)); 1564 Lisp_Object lispdir = Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH, 0));
1575 1565
1576 srcdir = Fexpand_file_name (build_string ("../src/"), lispdir); 1566 srcdir = Fexpand_file_name (build_string ("../src/"), lispdir);
1577 1567
1578 tem = Fexpand_file_name (build_string ("NEWS"), Vdata_directory); 1568 tem = Fexpand_file_name (build_string ("NEWS"), Vdata_directory);
1579 tem1 = Ffile_exists_p (tem); 1569 if (!NILP (Fequal (srcdir, Vinvocation_directory))
1580 if (!NILP (Fequal (srcdir, Vinvocation_directory)) || NILP (tem1)) 1570 || !file_access_p (SSDATA (tem), F_OK))
1581 { 1571 {
1582 Lisp_Object newdir; 1572 Lisp_Object newdir;
1583 newdir = Fexpand_file_name (build_string ("../etc/"), lispdir); 1573 newdir = Fexpand_file_name (build_string ("../etc/"), lispdir);
1584 tem = Fexpand_file_name (build_string ("NEWS"), newdir); 1574 tem = Fexpand_file_name (build_string ("NEWS"), newdir);
1585 tem1 = Ffile_exists_p (tem); 1575 if (file_access_p (SSDATA (tem), F_OK))
1586 if (!NILP (tem1))
1587 Vdata_directory = newdir; 1576 Vdata_directory = newdir;
1588 } 1577 }
1589 } 1578 }
@@ -1605,9 +1594,22 @@ init_callproc (void)
1605 Lisp_Object gamedir = Qnil; 1594 Lisp_Object gamedir = Qnil;
1606 if (PATH_GAME) 1595 if (PATH_GAME)
1607 { 1596 {
1608 Lisp_Object path_game = build_unibyte_string (PATH_GAME); 1597 const char *cpath_game = PATH_GAME;
1598#ifdef WINDOWSNT
1599 /* On MS-Windows, PATH_GAME normally starts with a literal
1600 "%emacs_dir%", so it will never work without some tweaking. */
1601 cpath_game = w32_relocate (cpath_game);
1602#endif
1603 Lisp_Object path_game = build_unibyte_string (cpath_game);
1609 if (file_accessible_directory_p (path_game)) 1604 if (file_accessible_directory_p (path_game))
1610 gamedir = path_game; 1605 gamedir = path_game;
1606 else if (errno != ENOENT && errno != ENOTDIR
1607#ifdef DOS_NT
1608 /* DOS/Windows sometimes return EACCES for bad file names */
1609 && errno != EACCES
1610#endif
1611 )
1612 dir_warning ("game dir", path_game);
1611 } 1613 }
1612 Vshared_game_score_directory = gamedir; 1614 Vshared_game_score_directory = gamedir;
1613} 1615}
diff --git a/src/charset.c b/src/charset.c
index 8c54381dc48..93206aa29b0 100644
--- a/src/charset.c
+++ b/src/charset.c
@@ -2292,14 +2292,18 @@ init_charset (void)
2292 { 2292 {
2293 /* This used to be non-fatal (dir_warning), but it should not 2293 /* This used to be non-fatal (dir_warning), but it should not
2294 happen, and if it does sooner or later it will cause some 2294 happen, and if it does sooner or later it will cause some
2295 obscure problem (eg bug#6401), so better abort. */ 2295 obscure problem (eg bug#6401), so better exit. */
2296 fprintf (stderr, "Error: charsets directory not found:\n\ 2296 fprintf (stderr,
2297%s\n\ 2297 ("Error: %s: %s\n"
2298Emacs will not function correctly without the character map files.\n%s\ 2298 "Emacs will not function correctly "
2299Please check your installation!\n", 2299 "without the character map files.\n"
2300 SDATA (tempdir), 2300 "%s"
2301 egetenv("EMACSDATA") ? "The EMACSDATA environment \ 2301 "Please check your installation!\n"),
2302variable is set, maybe it has the wrong value?\n" : ""); 2302 SDATA (tempdir), strerror (errno),
2303 (egetenv ("EMACSDATA")
2304 ? ("The EMACSDATA environment variable is set. "
2305 "Maybe it has the wrong value?\n")
2306 : ""));
2303 exit (1); 2307 exit (1);
2304 } 2308 }
2305 2309
diff --git a/src/cm.c b/src/cm.c
index e09216a854b..7947d3565c5 100644
--- a/src/cm.c
+++ b/src/cm.c
@@ -30,7 +30,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
30 30
31int cost; /* sums up costs */ 31int cost; /* sums up costs */
32 32
33/* ARGSUSED */
34int 33int
35evalcost (int c) 34evalcost (int c)
36{ 35{
diff --git a/src/dired.c b/src/dired.c
index 7bc4b83fd77..3768b6dbb7c 100644
--- a/src/dired.c
+++ b/src/dired.c
@@ -79,9 +79,9 @@ dirent_type (struct dirent *dp)
79} 79}
80 80
81static DIR * 81static DIR *
82open_directory (Lisp_Object dirname, int *fdp) 82open_directory (Lisp_Object dirname, Lisp_Object encoded_dirname, int *fdp)
83{ 83{
84 char *name = SSDATA (dirname); 84 char *name = SSDATA (encoded_dirname);
85 DIR *d; 85 DIR *d;
86 int fd, opendir_errno; 86 int fd, opendir_errno;
87 87
@@ -167,38 +167,31 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full,
167 Lisp_Object match, Lisp_Object nosort, bool attrs, 167 Lisp_Object match, Lisp_Object nosort, bool attrs,
168 Lisp_Object id_format) 168 Lisp_Object id_format)
169{ 169{
170 ptrdiff_t directory_nbytes; 170 if (!NILP (match))
171 Lisp_Object list, dirfilename, encoded_directory; 171 CHECK_STRING (match);
172 bool needsep = 0;
173 ptrdiff_t count = SPECPDL_INDEX ();
174#ifdef WINDOWSNT
175 Lisp_Object w32_save = Qnil;
176#endif
177 172
178 /* Don't let the compiler optimize away all copies of DIRECTORY, 173 /* Don't let the compiler optimize away all copies of DIRECTORY,
179 which would break GC; see Bug#16986. */ 174 which would break GC; see Bug#16986. */
180 Lisp_Object volatile directory_volatile = directory; 175 Lisp_Object volatile directory_volatile = directory;
181 176
182 /* Because of file name handlers, these functions might call 177 Lisp_Object dirfilename = Fdirectory_file_name (directory);
183 Ffuncall, and cause a GC. */
184 list = encoded_directory = dirfilename = Qnil;
185 dirfilename = Fdirectory_file_name (directory);
186 178
187 /* Note: ENCODE_FILE and DECODE_FILE can GC because they can run 179 /* Note: ENCODE_FILE and DECODE_FILE can GC because they can run
188 run_pre_post_conversion_on_str which calls Lisp directly and 180 run_pre_post_conversion_on_str which calls Lisp directly and
189 indirectly. */ 181 indirectly. */
190 dirfilename = ENCODE_FILE (dirfilename); 182 Lisp_Object encoded_dirfilename = ENCODE_FILE (dirfilename);
191 encoded_directory = ENCODE_FILE (directory);
192 183
193 int fd; 184 int fd;
194 DIR *d = open_directory (dirfilename, &fd); 185 DIR *d = open_directory (dirfilename, encoded_dirfilename, &fd);
195 186
196 /* Unfortunately, we can now invoke expand-file-name and 187 /* Unfortunately, we can now invoke expand-file-name and
197 file-attributes on filenames, both of which can throw, so we must 188 file-attributes on filenames, both of which can throw, so we must
198 do a proper unwind-protect. */ 189 do a proper unwind-protect. */
190 ptrdiff_t count = SPECPDL_INDEX ();
199 record_unwind_protect_ptr (directory_files_internal_unwind, d); 191 record_unwind_protect_ptr (directory_files_internal_unwind, d);
200 192
201#ifdef WINDOWSNT 193#ifdef WINDOWSNT
194 Lisp_Object w32_save = Qnil;
202 if (attrs) 195 if (attrs)
203 { 196 {
204 /* Do this only once to avoid doing it (in w32.c:stat) for each 197 /* Do this only once to avoid doing it (in w32.c:stat) for each
@@ -210,7 +203,7 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full,
210 { 203 {
211 /* w32.c:stat will notice these bindings and avoid calling 204 /* w32.c:stat will notice these bindings and avoid calling
212 GetDriveType for each file. */ 205 GetDriveType for each file. */
213 if (is_slow_fs (SSDATA (dirfilename))) 206 if (is_slow_fs (SSDATA (encoded_dirfilename)))
214 Vw32_get_true_file_attributes = Qnil; 207 Vw32_get_true_file_attributes = Qnil;
215 else 208 else
216 Vw32_get_true_file_attributes = Qt; 209 Vw32_get_true_file_attributes = Qt;
@@ -218,88 +211,63 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full,
218 } 211 }
219#endif 212#endif
220 213
221 directory_nbytes = SBYTES (directory); 214 ptrdiff_t directory_nbytes = SBYTES (directory);
222 re_match_object = Qt; 215 re_match_object = Qt;
223 216
224 /* Decide whether we need to add a directory separator. */ 217 /* Decide whether we need to add a directory separator. */
225 if (directory_nbytes == 0 218 bool needsep = (directory_nbytes == 0
226 || !IS_ANY_SEP (SREF (directory, directory_nbytes - 1))) 219 || !IS_ANY_SEP (SREF (directory, directory_nbytes - 1)));
227 needsep = 1;
228 220
229 /* Windows users want case-insensitive wildcards. */ 221 /* Windows users want case-insensitive wildcards. */
230 Lisp_Object case_table = 222 Lisp_Object case_table = Qnil;
231#ifdef WINDOWSNT 223#ifdef WINDOWSNT
232 BVAR (&buffer_defaults, case_canon_table) 224 case_table = BVAR (&buffer_defaults, case_canon_table);
233#else
234 Qnil
235#endif 225#endif
236 ;
237 226
238 if (!NILP (match)) 227 /* Read directory entries and accumulate them into LIST. */
239 CHECK_STRING (match); 228 Lisp_Object list = Qnil;
240
241 /* Loop reading directory entries. */
242 for (struct dirent *dp; (dp = read_dirent (d, directory)); ) 229 for (struct dirent *dp; (dp = read_dirent (d, directory)); )
243 { 230 {
244 ptrdiff_t len = dirent_namelen (dp); 231 ptrdiff_t len = dirent_namelen (dp);
245 Lisp_Object name = make_unibyte_string (dp->d_name, len); 232 Lisp_Object name = make_unibyte_string (dp->d_name, len);
246 Lisp_Object finalname = name; 233 Lisp_Object finalname = name;
247 234
248 /* Note: DECODE_FILE can GC; it should protect its argument, 235 /* This can GC. */
249 though. */
250 name = DECODE_FILE (name); 236 name = DECODE_FILE (name);
251 len = SBYTES (name);
252 237
253 /* Now that we have unwind_protect in place, we might as well
254 allow matching to be interrupted. */
255 maybe_quit (); 238 maybe_quit ();
256 239
257 bool wanted = (NILP (match) || 240 if (!NILP (match)
258 fast_string_match_internal ( 241 && fast_string_match_internal (match, name, case_table) < 0)
259 match, name, case_table) >= 0); 242 continue;
260 243
261 if (wanted) 244 Lisp_Object fileattrs UNINIT;
245 if (attrs)
262 { 246 {
263 if (!NILP (full)) 247 fileattrs = file_attributes (fd, dp->d_name, directory, name,
264 { 248 id_format);
265 Lisp_Object fullname; 249 if (NILP (fileattrs))
266 ptrdiff_t nbytes = len + directory_nbytes + needsep; 250 continue;
267 ptrdiff_t nchars; 251 }
268
269 fullname = make_uninit_multibyte_string (nbytes, nbytes);
270 memcpy (SDATA (fullname), SDATA (directory),
271 directory_nbytes);
272
273 if (needsep)
274 SSET (fullname, directory_nbytes, DIRECTORY_SEP);
275
276 memcpy (SDATA (fullname) + directory_nbytes + needsep,
277 SDATA (name), len);
278
279 nchars = multibyte_chars_in_text (SDATA (fullname), nbytes);
280
281 /* Some bug somewhere. */
282 if (nchars > nbytes)
283 emacs_abort ();
284
285 STRING_SET_CHARS (fullname, nchars);
286 if (nchars == nbytes)
287 STRING_SET_UNIBYTE (fullname);
288
289 finalname = fullname;
290 }
291 else
292 finalname = name;
293 252
294 if (attrs) 253 if (!NILP (full))
295 { 254 {
296 Lisp_Object fileattrs 255 ptrdiff_t name_nbytes = SBYTES (name);
297 = file_attributes (fd, dp->d_name, directory, name, id_format); 256 ptrdiff_t nbytes = directory_nbytes + needsep + name_nbytes;
298 list = Fcons (Fcons (finalname, fileattrs), list); 257 ptrdiff_t nchars = SCHARS (directory) + needsep + SCHARS (name);
299 } 258 finalname = make_uninit_multibyte_string (nchars, nbytes);
300 else 259 if (nchars == nbytes)
301 list = Fcons (finalname, list); 260 STRING_SET_UNIBYTE (finalname);
261 memcpy (SDATA (finalname), SDATA (directory), directory_nbytes);
262 if (needsep)
263 SSET (finalname, directory_nbytes, DIRECTORY_SEP);
264 memcpy (SDATA (finalname) + directory_nbytes + needsep,
265 SDATA (name), name_nbytes);
302 } 266 }
267 else
268 finalname = name;
269
270 list = Fcons (attrs ? Fcons (finalname, fileattrs) : finalname, list);
303 } 271 }
304 272
305 closedir (d); 273 closedir (d);
@@ -329,14 +297,14 @@ If MATCH is non-nil, mention only file names that match the regexp MATCH.
329If NOSORT is non-nil, the list is not sorted--its order is unpredictable. 297If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
330 Otherwise, the list returned is sorted with `string-lessp'. 298 Otherwise, the list returned is sorted with `string-lessp'.
331 NOSORT is useful if you plan to sort the result yourself. */) 299 NOSORT is useful if you plan to sort the result yourself. */)
332 (Lisp_Object directory, Lisp_Object full, Lisp_Object match, Lisp_Object nosort) 300 (Lisp_Object directory, Lisp_Object full, Lisp_Object match,
301 Lisp_Object nosort)
333{ 302{
334 Lisp_Object handler;
335 directory = Fexpand_file_name (directory, Qnil); 303 directory = Fexpand_file_name (directory, Qnil);
336 304
337 /* If the file name has special constructs in it, 305 /* If the file name has special constructs in it,
338 call the corresponding file name handler. */ 306 call the corresponding file name handler. */
339 handler = Ffind_file_name_handler (directory, Qdirectory_files); 307 Lisp_Object handler = Ffind_file_name_handler (directory, Qdirectory_files);
340 if (!NILP (handler)) 308 if (!NILP (handler))
341 return call5 (handler, Qdirectory_files, directory, 309 return call5 (handler, Qdirectory_files, directory,
342 full, match, nosort); 310 full, match, nosort);
@@ -364,14 +332,15 @@ ID-FORMAT specifies the preferred format of attributes uid and gid, see
364`file-attributes' for further documentation. 332`file-attributes' for further documentation.
365On MS-Windows, performance depends on `w32-get-true-file-attributes', 333On MS-Windows, performance depends on `w32-get-true-file-attributes',
366which see. */) 334which see. */)
367 (Lisp_Object directory, Lisp_Object full, Lisp_Object match, Lisp_Object nosort, Lisp_Object id_format) 335 (Lisp_Object directory, Lisp_Object full, Lisp_Object match,
336 Lisp_Object nosort, Lisp_Object id_format)
368{ 337{
369 Lisp_Object handler;
370 directory = Fexpand_file_name (directory, Qnil); 338 directory = Fexpand_file_name (directory, Qnil);
371 339
372 /* If the file name has special constructs in it, 340 /* If the file name has special constructs in it,
373 call the corresponding file name handler. */ 341 call the corresponding file name handler. */
374 handler = Ffind_file_name_handler (directory, Qdirectory_files_and_attributes); 342 Lisp_Object handler
343 = Ffind_file_name_handler (directory, Qdirectory_files_and_attributes);
375 if (!NILP (handler)) 344 if (!NILP (handler))
376 return call6 (handler, Qdirectory_files_and_attributes, 345 return call6 (handler, Qdirectory_files_and_attributes,
377 directory, full, match, nosort, id_format); 346 directory, full, match, nosort, id_format);
@@ -508,7 +477,7 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
508 } 477 }
509 } 478 }
510 int fd; 479 int fd;
511 DIR *d = open_directory (encoded_dir, &fd); 480 DIR *d = open_directory (dirname, encoded_dir, &fd);
512 record_unwind_protect_ptr (directory_files_internal_unwind, d); 481 record_unwind_protect_ptr (directory_files_internal_unwind, d);
513 482
514 /* Loop reading directory entries. */ 483 /* Loop reading directory entries. */
@@ -850,7 +819,7 @@ stat_gname (struct stat *st)
850 819
851DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 2, 0, 820DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 2, 0,
852 doc: /* Return a list of attributes of file FILENAME. 821 doc: /* Return a list of attributes of file FILENAME.
853Value is nil if specified file cannot be opened. 822Value is nil if specified file does not exist.
854 823
855ID-FORMAT specifies the preferred format of attributes uid and gid (see 824ID-FORMAT specifies the preferred format of attributes uid and gid (see
856below) - valid values are `string' and `integer'. The latter is the 825below) - valid values are `string' and `integer'. The latter is the
@@ -970,15 +939,14 @@ file_attributes (int fd, char const *name,
970 information to be accurate. */ 939 information to be accurate. */
971 w32_stat_get_owner_group = 1; 940 w32_stat_get_owner_group = 1;
972#endif 941#endif
973 if (fstatat (fd, name, &s, AT_SYMLINK_NOFOLLOW) == 0) 942 err = fstatat (fd, name, &s, AT_SYMLINK_NOFOLLOW) == 0 ? 0 : errno;
974 err = 0;
975#ifdef WINDOWSNT 943#ifdef WINDOWSNT
976 w32_stat_get_owner_group = 0; 944 w32_stat_get_owner_group = 0;
977#endif 945#endif
978 } 946 }
979 947
980 if (err != 0) 948 if (err != 0)
981 return unbind_to (count, Qnil); 949 return unbind_to (count, file_attribute_errno (filename, err));
982 950
983 Lisp_Object file_type; 951 Lisp_Object file_type;
984 if (S_ISLNK (s.st_mode)) 952 if (S_ISLNK (s.st_mode))
@@ -987,7 +955,7 @@ file_attributes (int fd, char const *name,
987 symlink is replaced between the call to fstatat and the call 955 symlink is replaced between the call to fstatat and the call
988 to emacs_readlinkat. Detect this race unless the replacement 956 to emacs_readlinkat. Detect this race unless the replacement
989 is also a symlink. */ 957 is also a symlink. */
990 file_type = emacs_readlinkat (fd, name); 958 file_type = check_emacs_readlinkat (fd, filename, name);
991 if (NILP (file_type)) 959 if (NILP (file_type))
992 return unbind_to (count, Qnil); 960 return unbind_to (count, Qnil);
993 } 961 }
@@ -1031,7 +999,8 @@ file_attributes (int fd, char const *name,
1031 INT_TO_INTEGER (s.st_dev)); 999 INT_TO_INTEGER (s.st_dev));
1032} 1000}
1033 1001
1034DEFUN ("file-attributes-lessp", Ffile_attributes_lessp, Sfile_attributes_lessp, 2, 2, 0, 1002DEFUN ("file-attributes-lessp", Ffile_attributes_lessp,
1003 Sfile_attributes_lessp, 2, 2, 0,
1035 doc: /* Return t if first arg file attributes list is less than second. 1004 doc: /* Return t if first arg file attributes list is less than second.
1036Comparison is in lexicographic order and case is significant. */) 1005Comparison is in lexicographic order and case is significant. */)
1037 (Lisp_Object f1, Lisp_Object f2) 1006 (Lisp_Object f1, Lisp_Object f2)
diff --git a/src/doc.c b/src/doc.c
index 247be79adaf..b06b87c6114 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -136,7 +136,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
136 } 136 }
137 if (fd < 0) 137 if (fd < 0)
138 { 138 {
139 if (errno == EMFILE || errno == ENFILE) 139 if (errno != ENOENT && errno != ENOTDIR)
140 report_file_error ("Read error on documentation file", file); 140 report_file_error ("Read error on documentation file", file);
141 141
142 SAFE_FREE (); 142 SAFE_FREE ();
diff --git a/src/emacs.c b/src/emacs.c
index 5a526687b14..eb732810db4 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -746,7 +746,7 @@ load_pdump_find_executable (char const *argv0, ptrdiff_t *candidate_size)
746 candidate[path_part_length] = DIRECTORY_SEP; 746 candidate[path_part_length] = DIRECTORY_SEP;
747 memcpy (candidate + path_part_length + 1, argv0, argv0_length + 1); 747 memcpy (candidate + path_part_length + 1, argv0, argv0_length + 1);
748 struct stat st; 748 struct stat st;
749 if (check_executable (candidate) 749 if (file_access_p (candidate, X_OK)
750 && stat (candidate, &st) == 0 && S_ISREG (st.st_mode)) 750 && stat (candidate, &st) == 0 && S_ISREG (st.st_mode))
751 return candidate; 751 return candidate;
752 *candidate = '\0'; 752 *candidate = '\0';
@@ -923,7 +923,6 @@ load_pdump (int argc, char **argv)
923} 923}
924#endif /* HAVE_PDUMPER */ 924#endif /* HAVE_PDUMPER */
925 925
926/* ARGSUSED */
927int 926int
928main (int argc, char **argv) 927main (int argc, char **argv)
929{ 928{
diff --git a/src/eval.c b/src/eval.c
index 06d5c63f7f7..2bfc16eae0e 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1890,7 +1890,6 @@ verror (const char *m, va_list ap)
1890 1890
1891/* Dump an error message; called like printf. */ 1891/* Dump an error message; called like printf. */
1892 1892
1893/* VARARGS 1 */
1894void 1893void
1895error (const char *m, ...) 1894error (const char *m, ...)
1896{ 1895{
@@ -2649,7 +2648,6 @@ call0 (Lisp_Object fn)
2649} 2648}
2650 2649
2651/* Call function fn with 1 argument arg1. */ 2650/* Call function fn with 1 argument arg1. */
2652/* ARGSUSED */
2653Lisp_Object 2651Lisp_Object
2654call1 (Lisp_Object fn, Lisp_Object arg1) 2652call1 (Lisp_Object fn, Lisp_Object arg1)
2655{ 2653{
@@ -2657,7 +2655,6 @@ call1 (Lisp_Object fn, Lisp_Object arg1)
2657} 2655}
2658 2656
2659/* Call function fn with 2 arguments arg1, arg2. */ 2657/* Call function fn with 2 arguments arg1, arg2. */
2660/* ARGSUSED */
2661Lisp_Object 2658Lisp_Object
2662call2 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2) 2659call2 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2)
2663{ 2660{
@@ -2665,7 +2662,6 @@ call2 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2)
2665} 2662}
2666 2663
2667/* Call function fn with 3 arguments arg1, arg2, arg3. */ 2664/* Call function fn with 3 arguments arg1, arg2, arg3. */
2668/* ARGSUSED */
2669Lisp_Object 2665Lisp_Object
2670call3 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3) 2666call3 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3)
2671{ 2667{
@@ -2673,7 +2669,6 @@ call3 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3)
2673} 2669}
2674 2670
2675/* Call function fn with 4 arguments arg1, arg2, arg3, arg4. */ 2671/* Call function fn with 4 arguments arg1, arg2, arg3, arg4. */
2676/* ARGSUSED */
2677Lisp_Object 2672Lisp_Object
2678call4 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, 2673call4 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
2679 Lisp_Object arg4) 2674 Lisp_Object arg4)
@@ -2682,7 +2677,6 @@ call4 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
2682} 2677}
2683 2678
2684/* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5. */ 2679/* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5. */
2685/* ARGSUSED */
2686Lisp_Object 2680Lisp_Object
2687call5 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, 2681call5 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
2688 Lisp_Object arg4, Lisp_Object arg5) 2682 Lisp_Object arg4, Lisp_Object arg5)
@@ -2691,7 +2685,6 @@ call5 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
2691} 2685}
2692 2686
2693/* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6. */ 2687/* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6. */
2694/* ARGSUSED */
2695Lisp_Object 2688Lisp_Object
2696call6 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, 2689call6 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
2697 Lisp_Object arg4, Lisp_Object arg5, Lisp_Object arg6) 2690 Lisp_Object arg4, Lisp_Object arg5, Lisp_Object arg6)
@@ -2700,7 +2693,6 @@ call6 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
2700} 2693}
2701 2694
2702/* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7. */ 2695/* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7. */
2703/* ARGSUSED */
2704Lisp_Object 2696Lisp_Object
2705call7 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, 2697call7 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
2706 Lisp_Object arg4, Lisp_Object arg5, Lisp_Object arg6, Lisp_Object arg7) 2698 Lisp_Object arg4, Lisp_Object arg5, Lisp_Object arg6, Lisp_Object arg7)
@@ -2710,7 +2702,6 @@ call7 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
2710 2702
2711/* Call function fn with 8 arguments arg1, arg2, arg3, arg4, arg5, 2703/* Call function fn with 8 arguments arg1, arg2, arg3, arg4, arg5,
2712 arg6, arg7, arg8. */ 2704 arg6, arg7, arg8. */
2713/* ARGSUSED */
2714Lisp_Object 2705Lisp_Object
2715call8 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, 2706call8 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
2716 Lisp_Object arg4, Lisp_Object arg5, Lisp_Object arg6, Lisp_Object arg7, 2707 Lisp_Object arg4, Lisp_Object arg5, Lisp_Object arg6, Lisp_Object arg7,
diff --git a/src/fileio.c b/src/fileio.c
index cbc0c89cf3e..5337ea5c800 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -134,60 +134,45 @@ static dev_t timestamp_file_system;
134 is added here. */ 134 is added here. */
135static Lisp_Object Vwrite_region_annotation_buffers; 135static Lisp_Object Vwrite_region_annotation_buffers;
136 136
137static Lisp_Object file_name_directory (Lisp_Object);
137static bool a_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t, 138static bool a_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t,
138 Lisp_Object *, struct coding_system *); 139 Lisp_Object *, struct coding_system *);
139static bool e_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t, 140static bool e_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t,
140 struct coding_system *); 141 struct coding_system *);
141 142
142 143
143/* Return true if FILENAME exists, otherwise return false and set errno. */ 144/* Test whether FILE is accessible for AMODE.
144 145 Return true if successful, false (setting errno) otherwise. */
145static bool
146check_existing (const char *filename)
147{
148 return faccessat (AT_FDCWD, filename, F_OK, AT_EACCESS) == 0;
149}
150
151/* Return true if file FILENAME exists and can be executed. */
152 146
153bool 147bool
154check_executable (char *filename) 148file_access_p (char const *file, int amode)
155{
156 return faccessat (AT_FDCWD, filename, X_OK, AT_EACCESS) == 0;
157}
158
159/* Return true if file FILENAME exists and can be accessed
160 according to AMODE, which should include W_OK.
161 On failure, return false and set errno. */
162
163static bool
164check_writable (const char *filename, int amode)
165{ 149{
166#ifdef MSDOS 150#ifdef MSDOS
167 /* FIXME: an faccessat implementation should be added to the 151 if (amode & W_OK)
168 DOS/Windows ports and this #ifdef branch should be removed. */
169 struct stat st;
170 if (stat (filename, &st) < 0)
171 return 0;
172 errno = EPERM;
173 return (st.st_mode & S_IWRITE || S_ISDIR (st.st_mode));
174#else /* not MSDOS */
175 bool res = faccessat (AT_FDCWD, filename, amode, AT_EACCESS) == 0;
176#ifdef CYGWIN
177 /* faccessat may have returned failure because Cygwin couldn't
178 determine the file's UID or GID; if so, we return success. */
179 if (!res)
180 { 152 {
181 int faccessat_errno = errno; 153 /* FIXME: The MS-DOS faccessat implementation should handle this. */
182 struct stat st; 154 struct stat st;
183 if (stat (filename, &st) < 0) 155 if (stat (file, &st) != 0)
184 return 0; 156 return false;
185 res = (st.st_uid == -1 || st.st_gid == -1); 157 errno = EPERM;
186 errno = faccessat_errno; 158 return st.st_mode & S_IWRITE || S_ISDIR (st.st_mode);
187 } 159 }
188#endif /* CYGWIN */ 160#endif
189 return res; 161
190#endif /* not MSDOS */ 162 if (faccessat (AT_FDCWD, file, amode, AT_EACCESS) == 0)
163 return true;
164
165#ifdef CYGWIN
166 /* Return success if faccessat failed because Cygwin couldn't
167 determine the file's UID or GID. */
168 int err = errno;
169 struct stat st;
170 if (stat (file, &st) == 0 && (st.st_uid == -1 || st.st_gid == -1))
171 return true;
172 errno = err;
173#endif
174
175 return false;
191} 176}
192 177
193/* Signal a file-access failure. STRING describes the failure, 178/* Signal a file-access failure. STRING describes the failure,
@@ -250,6 +235,44 @@ report_file_notify_error (const char *string, Lisp_Object name)
250} 235}
251#endif 236#endif
252 237
238/* ACTION failed for FILE with errno ERR. Signal an error if ERR
239 means the file's metadata could not be retrieved even though it may
240 exist, otherwise return nil. */
241
242static Lisp_Object
243file_metadata_errno (char const *action, Lisp_Object file, int err)
244{
245 if (err == ENOENT || err == ENOTDIR || err == 0)
246 return Qnil;
247 report_file_errno (action, file, err);
248}
249
250Lisp_Object
251file_attribute_errno (Lisp_Object file, int err)
252{
253 return file_metadata_errno ("Getting attributes", file, err);
254}
255
256/* In theory, EACCES errors for predicates like file-readable-p should
257 be checked further because they may be problems with an ancestor
258 directory instead of with the file itself, which means that we
259 don't have reliable info about the requested file. In practice,
260 though, such errors are common enough that signaling them can be
261 annoying even if the errors are real (e.g., Bug#37445). So return
262 nil for EACCES unless compiling with -DPICKY_EACCES, which is off
263 by default. */
264#ifndef PICKY_EACCES
265enum { PICKY_EACCES = false };
266#endif
267
268Lisp_Object
269file_test_errno (Lisp_Object file, int err)
270{
271 if (!PICKY_EACCES && err == EACCES)
272 return Qnil;
273 return file_metadata_errno ("Testing file", file, err);
274}
275
253void 276void
254close_file_unwind (int fd) 277close_file_unwind (int fd)
255{ 278{
@@ -356,6 +379,15 @@ Given a Unix syntax file name, returns a string ending in slash. */)
356 return STRINGP (handled_name) ? handled_name : Qnil; 379 return STRINGP (handled_name) ? handled_name : Qnil;
357 } 380 }
358 381
382 return file_name_directory (filename);
383}
384
385/* Return the directory component of FILENAME, or nil if FILENAME does
386 not contain a directory component. */
387
388static Lisp_Object
389file_name_directory (Lisp_Object filename)
390{
359 char *beg = SSDATA (filename); 391 char *beg = SSDATA (filename);
360 char const *p = beg + SBYTES (filename); 392 char const *p = beg + SBYTES (filename);
361 393
@@ -2369,41 +2401,48 @@ internal_delete_file (Lisp_Object filename)
2369 return NILP (tem); 2401 return NILP (tem);
2370} 2402}
2371 2403
2372/* Filesystems are case-sensitive on all supported systems except 2404/* Return -1 if FILE is a case-insensitive file name, 0 if not,
2373 MS-Windows, MS-DOS, Cygwin, and Mac OS X. They are always 2405 and a positive errno value if the result cannot be determined. */
2374 case-insensitive on the first two, but they may or may not be
2375 case-insensitive on Cygwin and OS X. The following function
2376 attempts to provide a runtime test on those two systems. If the
2377 test is not conclusive, we assume case-insensitivity on Cygwin and
2378 case-sensitivity on Mac OS X.
2379
2380 FIXME: Mounted filesystems on Posix hosts, like Samba shares or
2381 NFS-mounted Windows volumes, might be case-insensitive. Can we
2382 detect this? */
2383 2406
2384static bool 2407static int
2385file_name_case_insensitive_p (const char *filename) 2408file_name_case_insensitive_err (Lisp_Object file)
2386{ 2409{
2387 /* Use pathconf with _PC_CASE_INSENSITIVE or _PC_CASE_SENSITIVE if 2410 /* Filesystems are case-sensitive on all supported systems except
2388 those flags are available. As of this writing (2017-05-20), 2411 MS-Windows, MS-DOS, Cygwin, and macOS. They are always
2412 case-insensitive on the first two, but they may or may not be
2413 case-insensitive on Cygwin and macOS so do a runtime test on
2414 those two systems. If the test is not conclusive, assume
2415 case-insensitivity on Cygwin and case-sensitivity on macOS.
2416
2417 FIXME: Mounted filesystems on Posix hosts, like Samba shares or
2418 NFS-mounted Windows volumes, might be case-insensitive. Can we
2419 detect this?
2420
2421 Use pathconf with _PC_CASE_INSENSITIVE or _PC_CASE_SENSITIVE if
2422 those flags are available. As of this writing (2019-09-15),
2389 Cygwin is the only platform known to support the former (starting 2423 Cygwin is the only platform known to support the former (starting
2390 with Cygwin-2.6.1), and macOS is the only platform known to 2424 with Cygwin-2.6.1), and macOS is the only platform known to
2391 support the latter. */ 2425 support the latter. */
2392 2426
2393#ifdef _PC_CASE_INSENSITIVE 2427#if defined _PC_CASE_INSENSITIVE || defined _PC_CASE_SENSITIVE
2394 int res = pathconf (filename, _PC_CASE_INSENSITIVE); 2428 char *filename = SSDATA (ENCODE_FILE (file));
2429# ifdef _PC_CASE_INSENSITIVE
2430 long int res = pathconf (filename, _PC_CASE_INSENSITIVE);
2395 if (res >= 0) 2431 if (res >= 0)
2396 return res > 0; 2432 return - (res > 0);
2397#elif defined _PC_CASE_SENSITIVE 2433# else
2398 int res = pathconf (filename, _PC_CASE_SENSITIVE); 2434 long int res = pathconf (filename, _PC_CASE_SENSITIVE);
2399 if (res >= 0) 2435 if (res >= 0)
2400 return res == 0; 2436 return - (res == 0);
2437# endif
2438 if (errno != EINVAL)
2439 return errno;
2401#endif 2440#endif
2402 2441
2403#if defined CYGWIN || defined DOS_NT 2442#if defined CYGWIN || defined DOS_NT
2404 return true; 2443 return -1;
2405#else 2444#else
2406 return false; 2445 return 0;
2407#endif 2446#endif
2408} 2447}
2409 2448
@@ -2426,21 +2465,22 @@ The arg must be a string. */)
2426 2465
2427 /* If the file doesn't exist, move up the filesystem tree until we 2466 /* If the file doesn't exist, move up the filesystem tree until we
2428 reach an existing directory or the root. */ 2467 reach an existing directory or the root. */
2429 if (NILP (Ffile_exists_p (filename))) 2468 while (true)
2430 { 2469 {
2431 filename = Ffile_name_directory (filename); 2470 int err = file_name_case_insensitive_err (filename);
2432 while (NILP (Ffile_exists_p (filename))) 2471 switch (err)
2433 { 2472 {
2434 Lisp_Object newname = expand_and_dir_to_file (filename); 2473 case -1: return Qt;
2435 /* Avoid infinite loop if the root is reported as non-existing 2474 default: return file_test_errno (filename, err);
2436 (impossible?). */ 2475 case ENOENT: case ENOTDIR: break;
2437 if (!NILP (Fstring_equal (newname, filename)))
2438 break;
2439 filename = newname;
2440 } 2476 }
2477 Lisp_Object parent = file_name_directory (filename);
2478 /* Avoid infinite loop if the root is reported as non-existing
2479 (impossible?). */
2480 if (!NILP (Fstring_equal (parent, filename)))
2481 return Qnil;
2482 filename = parent;
2441 } 2483 }
2442 filename = ENCODE_FILE (filename);
2443 return file_name_case_insensitive_p (SSDATA (filename)) ? Qt : Qnil;
2444} 2484}
2445 2485
2446DEFUN ("rename-file", Frename_file, Srename_file, 2, 3, 2486DEFUN ("rename-file", Frename_file, Srename_file, 2, 3,
@@ -2546,7 +2586,7 @@ This is what happens in interactive use with M-x. */)
2546 { 2586 {
2547 Lisp_Object symlink_target 2587 Lisp_Object symlink_target
2548 = (S_ISLNK (file_st.st_mode) 2588 = (S_ISLNK (file_st.st_mode)
2549 ? emacs_readlinkat (AT_FDCWD, SSDATA (encoded_file)) 2589 ? check_emacs_readlinkat (AT_FDCWD, file, SSDATA (encoded_file))
2550 : Qnil); 2590 : Qnil);
2551 if (!NILP (symlink_target)) 2591 if (!NILP (symlink_target))
2552 Fmake_symbolic_link (symlink_target, newname, ok_if_already_exists); 2592 Fmake_symbolic_link (symlink_target, newname, ok_if_already_exists);
@@ -2694,32 +2734,48 @@ file_name_absolute_p (char const *filename)
2694 || user_homedir (&filename[1])))); 2734 || user_homedir (&filename[1]))));
2695} 2735}
2696 2736
2697DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0, 2737/* Return t if FILE exists and is accessible via OPERATION and AMODE,
2698 doc: /* Return t if file FILENAME exists (whether or not you can read it). 2738 nil (setting errno) if not. Signal an error if the result cannot
2699See also `file-readable-p' and `file-attributes'. 2739 be determined. */
2700This returns nil for a symlink to a nonexistent file.
2701Use `file-symlink-p' to test for such links. */)
2702 (Lisp_Object filename)
2703{
2704 Lisp_Object absname;
2705 Lisp_Object handler;
2706 2740
2707 CHECK_STRING (filename); 2741static Lisp_Object
2708 absname = Fexpand_file_name (filename, Qnil); 2742check_file_access (Lisp_Object file, Lisp_Object operation, int amode)
2709 2743{
2710 /* If the file name has special constructs in it, 2744 file = Fexpand_file_name (file, Qnil);
2711 call the corresponding file name handler. */ 2745 Lisp_Object handler = Ffind_file_name_handler (file, operation);
2712 handler = Ffind_file_name_handler (absname, Qfile_exists_p);
2713 if (!NILP (handler)) 2746 if (!NILP (handler))
2714 { 2747 {
2715 Lisp_Object result = call2 (handler, Qfile_exists_p, absname); 2748 Lisp_Object ok = call2 (handler, operation, file);
2749 /* This errno value is bogus. Any caller that depends on errno
2750 should be rethought anyway, to avoid a race between testing a
2751 handled file's accessibility and using the file. */
2716 errno = 0; 2752 errno = 0;
2717 return result; 2753 return ok;
2718 } 2754 }
2719 2755
2720 absname = ENCODE_FILE (absname); 2756 char *encoded_file = SSDATA (ENCODE_FILE (file));
2757 bool ok = file_access_p (encoded_file, amode);
2758 if (ok)
2759 return Qt;
2760 int err = errno;
2761 if (err == EROFS || err == ETXTBSY
2762 || (PICKY_EACCES && err == EACCES && amode != F_OK
2763 && file_access_p (encoded_file, F_OK)))
2764 {
2765 errno = err;
2766 return Qnil;
2767 }
2768 return file_test_errno (file, err);
2769}
2721 2770
2722 return check_existing (SSDATA (absname)) ? Qt : Qnil; 2771DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0,
2772 doc: /* Return t if file FILENAME exists (whether or not you can read it).
2773See also `file-readable-p' and `file-attributes'.
2774This returns nil for a symlink to a nonexistent file.
2775Use `file-symlink-p' to test for such links. */)
2776 (Lisp_Object filename)
2777{
2778 return check_file_access (filename, Qfile_exists_p, F_OK);
2723} 2779}
2724 2780
2725DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0, 2781DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0,
@@ -2729,21 +2785,7 @@ For a directory, this means you can access files in that directory.
2729purpose, though.) */) 2785purpose, though.) */)
2730 (Lisp_Object filename) 2786 (Lisp_Object filename)
2731{ 2787{
2732 Lisp_Object absname; 2788 return check_file_access (filename, Qfile_executable_p, X_OK);
2733 Lisp_Object handler;
2734
2735 CHECK_STRING (filename);
2736 absname = Fexpand_file_name (filename, Qnil);
2737
2738 /* If the file name has special constructs in it,
2739 call the corresponding file name handler. */
2740 handler = Ffind_file_name_handler (absname, Qfile_executable_p);
2741 if (!NILP (handler))
2742 return call2 (handler, Qfile_executable_p, absname);
2743
2744 absname = ENCODE_FILE (absname);
2745
2746 return (check_executable (SSDATA (absname)) ? Qt : Qnil);
2747} 2789}
2748 2790
2749DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0, 2791DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0,
@@ -2751,21 +2793,7 @@ DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0,
2751See also `file-exists-p' and `file-attributes'. */) 2793See also `file-exists-p' and `file-attributes'. */)
2752 (Lisp_Object filename) 2794 (Lisp_Object filename)
2753{ 2795{
2754 Lisp_Object absname; 2796 return check_file_access (filename, Qfile_readable_p, R_OK);
2755 Lisp_Object handler;
2756
2757 CHECK_STRING (filename);
2758 absname = Fexpand_file_name (filename, Qnil);
2759
2760 /* If the file name has special constructs in it,
2761 call the corresponding file name handler. */
2762 handler = Ffind_file_name_handler (absname, Qfile_readable_p);
2763 if (!NILP (handler))
2764 return call2 (handler, Qfile_readable_p, absname);
2765
2766 absname = ENCODE_FILE (absname);
2767 return (faccessat (AT_FDCWD, SSDATA (absname), R_OK, AT_EACCESS) == 0
2768 ? Qt : Qnil);
2769} 2797}
2770 2798
2771DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, 2799DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
@@ -2775,7 +2803,6 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
2775 Lisp_Object absname, dir, encoded; 2803 Lisp_Object absname, dir, encoded;
2776 Lisp_Object handler; 2804 Lisp_Object handler;
2777 2805
2778 CHECK_STRING (filename);
2779 absname = Fexpand_file_name (filename, Qnil); 2806 absname = Fexpand_file_name (filename, Qnil);
2780 2807
2781 /* If the file name has special constructs in it, 2808 /* If the file name has special constructs in it,
@@ -2785,25 +2812,34 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
2785 return call2 (handler, Qfile_writable_p, absname); 2812 return call2 (handler, Qfile_writable_p, absname);
2786 2813
2787 encoded = ENCODE_FILE (absname); 2814 encoded = ENCODE_FILE (absname);
2788 if (check_writable (SSDATA (encoded), W_OK)) 2815 if (file_access_p (SSDATA (encoded), W_OK))
2789 return Qt; 2816 return Qt;
2790 if (errno != ENOENT) 2817 if (errno != ENOENT)
2791 return Qnil; 2818 return Qnil;
2792 2819
2793 dir = Ffile_name_directory (absname); 2820 dir = file_name_directory (absname);
2794 eassert (!NILP (dir)); 2821 eassert (!NILP (dir));
2795#ifdef MSDOS 2822#ifdef MSDOS
2796 dir = Fdirectory_file_name (dir); 2823 dir = Fdirectory_file_name (dir);
2797#endif /* MSDOS */ 2824#endif /* MSDOS */
2798 2825
2799 dir = ENCODE_FILE (dir); 2826 encoded = ENCODE_FILE (dir);
2800#ifdef WINDOWSNT 2827#ifdef WINDOWSNT
2801 /* The read-only attribute of the parent directory doesn't affect 2828 /* The read-only attribute of the parent directory doesn't affect
2802 whether a file or directory can be created within it. Some day we 2829 whether a file or directory can be created within it. Some day we
2803 should check ACLs though, which do affect this. */ 2830 should check ACLs though, which do affect this. */
2804 return file_directory_p (dir) ? Qt : Qnil; 2831 return file_directory_p (encoded) ? Qt : Qnil;
2805#else 2832#else
2806 return check_writable (SSDATA (dir), W_OK | X_OK) ? Qt : Qnil; 2833 if (file_access_p (SSDATA (encoded), W_OK | X_OK))
2834 return Qt;
2835 int err = errno;
2836 if (err == EROFS
2837 || (err == EACCES && file_access_p (SSDATA (encoded), F_OK)))
2838 {
2839 errno = err;
2840 return Qnil;
2841 }
2842 return file_test_errno (absname, err);
2807#endif 2843#endif
2808} 2844}
2809 2845
@@ -2835,8 +2871,8 @@ If there is no error, returns nil. */)
2835} 2871}
2836 2872
2837/* Relative to directory FD, return the symbolic link value of FILENAME. 2873/* Relative to directory FD, return the symbolic link value of FILENAME.
2838 On failure, return nil. */ 2874 On failure, return nil (setting errno). */
2839Lisp_Object 2875static Lisp_Object
2840emacs_readlinkat (int fd, char const *filename) 2876emacs_readlinkat (int fd, char const *filename)
2841{ 2877{
2842 static struct allocator const emacs_norealloc_allocator = 2878 static struct allocator const emacs_norealloc_allocator =
@@ -2855,6 +2891,27 @@ emacs_readlinkat (int fd, char const *filename)
2855 return val; 2891 return val;
2856} 2892}
2857 2893
2894/* Relative to directory FD, return the symbolic link value of FILE.
2895 If FILE is not a symbolic link, return nil (setting errno).
2896 Signal an error if the result cannot be determined. */
2897Lisp_Object
2898check_emacs_readlinkat (int fd, Lisp_Object file, char const *encoded_file)
2899{
2900 Lisp_Object val = emacs_readlinkat (fd, encoded_file);
2901 if (NILP (val))
2902 {
2903 if (errno == EINVAL)
2904 return val;
2905#ifdef CYGWIN
2906 /* Work around Cygwin bugs. */
2907 if (errno == EIO || errno == EACCES)
2908 return val;
2909#endif
2910 return file_metadata_errno ("Reading symbolic link", file, errno);
2911 }
2912 return val;
2913}
2914
2858DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0, 2915DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0,
2859 doc: /* Return non-nil if file FILENAME is the name of a symbolic link. 2916 doc: /* Return non-nil if file FILENAME is the name of a symbolic link.
2860The value is the link target, as a string. 2917The value is the link target, as a string.
@@ -2874,9 +2931,8 @@ This function does not check whether the link target exists. */)
2874 if (!NILP (handler)) 2931 if (!NILP (handler))
2875 return call2 (handler, Qfile_symlink_p, filename); 2932 return call2 (handler, Qfile_symlink_p, filename);
2876 2933
2877 filename = ENCODE_FILE (filename); 2934 return check_emacs_readlinkat (AT_FDCWD, filename,
2878 2935 SSDATA (ENCODE_FILE (filename)));
2879 return emacs_readlinkat (AT_FDCWD, SSDATA (filename));
2880} 2936}
2881 2937
2882DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0, 2938DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0,
@@ -2893,9 +2949,9 @@ See `file-symlink-p' to distinguish symlinks. */)
2893 if (!NILP (handler)) 2949 if (!NILP (handler))
2894 return call2 (handler, Qfile_directory_p, absname); 2950 return call2 (handler, Qfile_directory_p, absname);
2895 2951
2896 absname = ENCODE_FILE (absname); 2952 if (file_directory_p (absname))
2897 2953 return Qt;
2898 return file_directory_p (absname) ? Qt : Qnil; 2954 return file_test_errno (absname, errno);
2899} 2955}
2900 2956
2901/* Return true if FILE is a directory or a symlink to a directory. 2957/* Return true if FILE is a directory or a symlink to a directory.
@@ -2905,7 +2961,10 @@ file_directory_p (Lisp_Object file)
2905{ 2961{
2906#ifdef DOS_NT 2962#ifdef DOS_NT
2907 /* This is cheaper than 'stat'. */ 2963 /* This is cheaper than 'stat'. */
2908 return faccessat (AT_FDCWD, SSDATA (file), D_OK, AT_EACCESS) == 0; 2964 bool retval = faccessat (AT_FDCWD, SSDATA (file), D_OK, AT_EACCESS) == 0;
2965 if (!retval && errno == EACCES)
2966 errno = ENOTDIR; /* like the non-DOS_NT branch below does */
2967 return retval;
2909#else 2968#else
2910# ifdef O_PATH 2969# ifdef O_PATH
2911 /* Use O_PATH if available, as it avoids races and EOVERFLOW issues. */ 2970 /* Use O_PATH if available, as it avoids races and EOVERFLOW issues. */
@@ -2920,7 +2979,7 @@ file_directory_p (Lisp_Object file)
2920 /* O_PATH is defined but evidently this Linux kernel predates 2.6.39. 2979 /* O_PATH is defined but evidently this Linux kernel predates 2.6.39.
2921 Fall back on generic POSIX code. */ 2980 Fall back on generic POSIX code. */
2922# endif 2981# endif
2923 /* Use file_accessible_directory, as it avoids stat EOVERFLOW 2982 /* Use file_accessible_directory_p, as it avoids stat EOVERFLOW
2924 problems and could be cheaper. However, if it fails because FILE 2983 problems and could be cheaper. However, if it fails because FILE
2925 is inaccessible, fall back on stat; if the latter fails with 2984 is inaccessible, fall back on stat; if the latter fails with
2926 EOVERFLOW then FILE must have been a directory unless a race 2985 EOVERFLOW then FILE must have been a directory unless a race
@@ -2976,8 +3035,13 @@ really is a readable and searchable directory. */)
2976 return r; 3035 return r;
2977 } 3036 }
2978 3037
2979 absname = ENCODE_FILE (absname); 3038 Lisp_Object encoded_absname = ENCODE_FILE (absname);
2980 return file_accessible_directory_p (absname) ? Qt : Qnil; 3039 if (file_accessible_directory_p (encoded_absname))
3040 return Qt;
3041 int err = errno;
3042 if (err == EACCES && file_access_p (SSDATA (encoded_absname), F_OK))
3043 return Qnil;
3044 return file_test_errno (absname, err);
2981} 3045}
2982 3046
2983/* If FILE is a searchable directory or a symlink to a 3047/* If FILE is a searchable directory or a symlink to a
@@ -3029,7 +3093,7 @@ file_accessible_directory_p (Lisp_Object file)
3029 dir = buf; 3093 dir = buf;
3030 } 3094 }
3031 3095
3032 ok = check_existing (dir); 3096 ok = file_access_p (dir, F_OK);
3033 saved_errno = errno; 3097 saved_errno = errno;
3034 SAFE_FREE (); 3098 SAFE_FREE ();
3035 errno = saved_errno; 3099 errno = saved_errno;
@@ -3053,27 +3117,21 @@ See `file-symlink-p' to distinguish symlinks. */)
3053 if (!NILP (handler)) 3117 if (!NILP (handler))
3054 return call2 (handler, Qfile_regular_p, absname); 3118 return call2 (handler, Qfile_regular_p, absname);
3055 3119
3056 absname = ENCODE_FILE (absname);
3057
3058#ifdef WINDOWSNT 3120#ifdef WINDOWSNT
3059 { 3121 /* Tell stat to use expensive method to get accurate info. */
3060 int result; 3122 Lisp_Object true_attributes = Vw32_get_true_file_attributes;
3061 Lisp_Object tem = Vw32_get_true_file_attributes; 3123 Vw32_get_true_file_attributes = Qt;
3124#endif
3062 3125
3063 /* Tell stat to use expensive method to get accurate info. */ 3126 int stat_result = stat (SSDATA (absname), &st);
3064 Vw32_get_true_file_attributes = Qt;
3065 result = stat (SSDATA (absname), &st);
3066 Vw32_get_true_file_attributes = tem;
3067 3127
3068 if (result < 0) 3128#ifdef WINDOWSNT
3069 return Qnil; 3129 Vw32_get_true_file_attributes = true_attributes;
3070 return S_ISREG (st.st_mode) ? Qt : Qnil;
3071 }
3072#else
3073 if (stat (SSDATA (absname), &st) < 0)
3074 return Qnil;
3075 return S_ISREG (st.st_mode) ? Qt : Qnil;
3076#endif 3130#endif
3131
3132 if (stat_result == 0)
3133 return S_ISREG (st.st_mode) ? Qt : Qnil;
3134 return file_test_errno (absname, errno);
3077} 3135}
3078 3136
3079DEFUN ("file-selinux-context", Ffile_selinux_context, 3137DEFUN ("file-selinux-context", Ffile_selinux_context,
@@ -3083,7 +3141,7 @@ The return value is a list (USER ROLE TYPE RANGE), where the list
3083elements are strings naming the user, role, type, and range of the 3141elements are strings naming the user, role, type, and range of the
3084file's SELinux security context. 3142file's SELinux security context.
3085 3143
3086Return (nil nil nil nil) if the file is nonexistent or inaccessible, 3144Return (nil nil nil nil) if the file is nonexistent,
3087or if SELinux is disabled, or if Emacs lacks SELinux support. */) 3145or if SELinux is disabled, or if Emacs lacks SELinux support. */)
3088 (Lisp_Object filename) 3146 (Lisp_Object filename)
3089{ 3147{
@@ -3097,13 +3155,11 @@ or if SELinux is disabled, or if Emacs lacks SELinux support. */)
3097 if (!NILP (handler)) 3155 if (!NILP (handler))
3098 return call2 (handler, Qfile_selinux_context, absname); 3156 return call2 (handler, Qfile_selinux_context, absname);
3099 3157
3100 absname = ENCODE_FILE (absname);
3101
3102#if HAVE_LIBSELINUX 3158#if HAVE_LIBSELINUX
3103 if (is_selinux_enabled ()) 3159 if (is_selinux_enabled ())
3104 { 3160 {
3105 security_context_t con; 3161 security_context_t con;
3106 int conlength = lgetfilecon (SSDATA (absname), &con); 3162 int conlength = lgetfilecon (SSDATA (ENCODE_FILE (absname)), &con);
3107 if (conlength > 0) 3163 if (conlength > 0)
3108 { 3164 {
3109 context_t context = context_new (con); 3165 context_t context = context_new (con);
@@ -3118,6 +3174,9 @@ or if SELinux is disabled, or if Emacs lacks SELinux support. */)
3118 context_free (context); 3174 context_free (context);
3119 freecon (con); 3175 freecon (con);
3120 } 3176 }
3177 else if (! (errno == ENOENT || errno == ENOTDIR || errno == ENODATA
3178 || errno == ENOTSUP))
3179 report_file_error ("getting SELinux context", absname);
3121 } 3180 }
3122#endif 3181#endif
3123 3182
@@ -3213,8 +3272,7 @@ DEFUN ("file-acl", Ffile_acl, Sfile_acl, 1, 1, 0,
3213 doc: /* Return ACL entries of file named FILENAME. 3272 doc: /* Return ACL entries of file named FILENAME.
3214The entries are returned in a format suitable for use in `set-file-acl' 3273The entries are returned in a format suitable for use in `set-file-acl'
3215but is otherwise undocumented and subject to change. 3274but is otherwise undocumented and subject to change.
3216Return nil if file does not exist or is not accessible, or if Emacs 3275Return nil if file does not exist. */)
3217was unable to determine the ACL entries. */)
3218 (Lisp_Object filename) 3276 (Lisp_Object filename)
3219{ 3277{
3220 Lisp_Object acl_string = Qnil; 3278 Lisp_Object acl_string = Qnil;
@@ -3229,20 +3287,22 @@ was unable to determine the ACL entries. */)
3229 return call2 (handler, Qfile_acl, absname); 3287 return call2 (handler, Qfile_acl, absname);
3230 3288
3231# ifdef HAVE_ACL_SET_FILE 3289# ifdef HAVE_ACL_SET_FILE
3232 absname = ENCODE_FILE (absname);
3233
3234# ifndef HAVE_ACL_TYPE_EXTENDED 3290# ifndef HAVE_ACL_TYPE_EXTENDED
3235 acl_type_t ACL_TYPE_EXTENDED = ACL_TYPE_ACCESS; 3291 acl_type_t ACL_TYPE_EXTENDED = ACL_TYPE_ACCESS;
3236# endif 3292# endif
3237 acl_t acl = acl_get_file (SSDATA (absname), ACL_TYPE_EXTENDED); 3293 acl_t acl = acl_get_file (SSDATA (ENCODE_FILE (absname)), ACL_TYPE_EXTENDED);
3238 if (acl == NULL) 3294 if (acl == NULL)
3239 return Qnil; 3295 {
3240 3296 if (errno == ENOENT || errno == ENOTDIR || errno == ENOTSUP)
3297 return Qnil;
3298 report_file_error ("Getting ACLs", absname);
3299 }
3241 char *str = acl_to_text (acl, NULL); 3300 char *str = acl_to_text (acl, NULL);
3242 if (str == NULL) 3301 if (str == NULL)
3243 { 3302 {
3303 int err = errno;
3244 acl_free (acl); 3304 acl_free (acl);
3245 return Qnil; 3305 report_file_errno ("Getting ACLs", absname, err);
3246 } 3306 }
3247 3307
3248 acl_string = build_string (str); 3308 acl_string = build_string (str);
@@ -3313,7 +3373,7 @@ support. */)
3313 3373
3314DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0, 3374DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0,
3315 doc: /* Return mode bits of file named FILENAME, as an integer. 3375 doc: /* Return mode bits of file named FILENAME, as an integer.
3316Return nil, if file does not exist or is not accessible. */) 3376Return nil if FILENAME does not exist. */)
3317 (Lisp_Object filename) 3377 (Lisp_Object filename)
3318{ 3378{
3319 struct stat st; 3379 struct stat st;
@@ -3325,11 +3385,8 @@ Return nil, if file does not exist or is not accessible. */)
3325 if (!NILP (handler)) 3385 if (!NILP (handler))
3326 return call2 (handler, Qfile_modes, absname); 3386 return call2 (handler, Qfile_modes, absname);
3327 3387
3328 absname = ENCODE_FILE (absname); 3388 if (stat (SSDATA (ENCODE_FILE (absname)), &st) != 0)
3329 3389 return file_attribute_errno (absname, errno);
3330 if (stat (SSDATA (absname), &st) < 0)
3331 return Qnil;
3332
3333 return make_fixnum (st.st_mode & 07777); 3390 return make_fixnum (st.st_mode & 07777);
3334} 3391}
3335 3392
@@ -3473,14 +3530,27 @@ otherwise, if FILE2 does not exist, the answer is t. */)
3473 if (!NILP (handler)) 3530 if (!NILP (handler))
3474 return call3 (handler, Qfile_newer_than_file_p, absname1, absname2); 3531 return call3 (handler, Qfile_newer_than_file_p, absname1, absname2);
3475 3532
3476 absname1 = ENCODE_FILE (absname1); 3533 int err1;
3477 absname2 = ENCODE_FILE (absname2); 3534 if (stat (SSDATA (ENCODE_FILE (absname1)), &st1) == 0)
3535 err1 = 0;
3536 else
3537 {
3538 err1 = errno;
3539 if (err1 != EOVERFLOW)
3540 return file_test_errno (absname1, err1);
3541 }
3478 3542
3479 if (stat (SSDATA (absname1), &st1) < 0) 3543 if (stat (SSDATA (ENCODE_FILE (absname2)), &st2) != 0)
3480 return Qnil; 3544 {
3545 file_test_errno (absname2, errno);
3546 return Qt;
3547 }
3481 3548
3482 if (stat (SSDATA (absname2), &st2) < 0) 3549 if (err1)
3483 return Qt; 3550 {
3551 file_test_errno (absname1, err1);
3552 eassume (false);
3553 }
3484 3554
3485 return (timespec_cmp (get_stat_mtime (&st2), get_stat_mtime (&st1)) < 0 3555 return (timespec_cmp (get_stat_mtime (&st2), get_stat_mtime (&st1)) < 0
3486 ? Qt : Qnil); 3556 ? Qt : Qnil);
@@ -3612,7 +3682,7 @@ file_offset (Lisp_Object val)
3612static struct timespec 3682static struct timespec
3613time_error_value (int errnum) 3683time_error_value (int errnum)
3614{ 3684{
3615 int ns = (errnum == ENOENT || errnum == EACCES || errnum == ENOTDIR 3685 int ns = (errnum == ENOENT || errnum == ENOTDIR
3616 ? NONEXISTENT_MODTIME_NSECS 3686 ? NONEXISTENT_MODTIME_NSECS
3617 : UNKNOWN_MODTIME_NSECS); 3687 : UNKNOWN_MODTIME_NSECS);
3618 return make_timespec (0, ns); 3688 return make_timespec (0, ns);
@@ -5672,13 +5742,13 @@ in `current-time' or an integer flag as returned by `visited-file-modtime'. */)
5672 /* The handler can find the file name the same way we did. */ 5742 /* The handler can find the file name the same way we did. */
5673 return call2 (handler, Qset_visited_file_modtime, Qnil); 5743 return call2 (handler, Qset_visited_file_modtime, Qnil);
5674 5744
5675 filename = ENCODE_FILE (filename); 5745 if (stat (SSDATA (ENCODE_FILE (filename)), &st) == 0)
5676
5677 if (stat (SSDATA (filename), &st) >= 0)
5678 { 5746 {
5679 current_buffer->modtime = get_stat_mtime (&st); 5747 current_buffer->modtime = get_stat_mtime (&st);
5680 current_buffer->modtime_size = st.st_size; 5748 current_buffer->modtime_size = st.st_size;
5681 } 5749 }
5750 else
5751 file_attribute_errno (filename, errno);
5682 } 5752 }
5683 5753
5684 return Qnil; 5754 return Qnil;
@@ -5822,7 +5892,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */)
5822 if (!NILP (Vrun_hooks)) 5892 if (!NILP (Vrun_hooks))
5823 { 5893 {
5824 Lisp_Object dir; 5894 Lisp_Object dir;
5825 dir = Ffile_name_directory (listfile); 5895 dir = file_name_directory (listfile);
5826 if (NILP (Ffile_directory_p (dir))) 5896 if (NILP (Ffile_directory_p (dir)))
5827 internal_condition_case_1 (do_auto_save_make_dir, 5897 internal_condition_case_1 (do_auto_save_make_dir,
5828 dir, Qt, 5898 dir, Qt,
@@ -6067,16 +6137,18 @@ effect except for flushing STREAM's data. */)
6067 6137
6068#ifndef DOS_NT 6138#ifndef DOS_NT
6069 6139
6070/* Yield a Lisp float as close as possible to BLOCKSIZE * BLOCKS, with 6140/* Yield a Lisp number equal to BLOCKSIZE * BLOCKS, with the result
6071 the result negated if NEGATE. */ 6141 negated if NEGATE. */
6072static Lisp_Object 6142static Lisp_Object
6073blocks_to_bytes (uintmax_t blocksize, uintmax_t blocks, bool negate) 6143blocks_to_bytes (uintmax_t blocksize, uintmax_t blocks, bool negate)
6074{ 6144{
6075 /* On typical platforms the following code is accurate to 53 bits, 6145 intmax_t n;
6076 which is close enough. BLOCKSIZE is invariably a power of 2, so 6146 if (!INT_MULTIPLY_WRAPV (blocksize, blocks, &n))
6077 converting it to double does not lose information. */ 6147 return make_int (negate ? -n : n);
6078 double bs = blocksize; 6148 Lisp_Object bs = make_uint (blocksize);
6079 return make_float (negate ? -bs * -blocks : bs * blocks); 6149 if (negate)
6150 bs = CALLN (Fminus, bs);
6151 return CALLN (Ftimes, bs, make_uint (blocks));
6080} 6152}
6081 6153
6082DEFUN ("file-system-info", Ffile_system_info, Sfile_system_info, 1, 1, 0, 6154DEFUN ("file-system-info", Ffile_system_info, Sfile_system_info, 1, 1, 0,
@@ -6087,22 +6159,22 @@ storage available to a non-superuser. All 3 numbers are in bytes.
6087If the underlying system call fails, value is nil. */) 6159If the underlying system call fails, value is nil. */)
6088 (Lisp_Object filename) 6160 (Lisp_Object filename)
6089{ 6161{
6090 Lisp_Object encoded = ENCODE_FILE (Fexpand_file_name (filename, Qnil)); 6162 filename = Fexpand_file_name (filename, Qnil);
6091 6163
6092 /* If the file name has special constructs in it, 6164 /* If the file name has special constructs in it,
6093 call the corresponding file name handler. */ 6165 call the corresponding file name handler. */
6094 Lisp_Object handler = Ffind_file_name_handler (encoded, Qfile_system_info); 6166 Lisp_Object handler = Ffind_file_name_handler (filename, Qfile_system_info);
6095 if (!NILP (handler)) 6167 if (!NILP (handler))
6096 { 6168 {
6097 Lisp_Object result = call2 (handler, Qfile_system_info, encoded); 6169 Lisp_Object result = call2 (handler, Qfile_system_info, filename);
6098 if (CONSP (result) || NILP (result)) 6170 if (CONSP (result) || NILP (result))
6099 return result; 6171 return result;
6100 error ("Invalid handler in `file-name-handler-alist'"); 6172 error ("Invalid handler in `file-name-handler-alist'");
6101 } 6173 }
6102 6174
6103 struct fs_usage u; 6175 struct fs_usage u;
6104 if (get_fs_usage (SSDATA (encoded), NULL, &u) != 0) 6176 if (get_fs_usage (SSDATA (ENCODE_FILE (filename)), NULL, &u) != 0)
6105 return Qnil; 6177 return errno == ENOSYS ? Qnil : file_attribute_errno (filename, errno);
6106 return list3 (blocks_to_bytes (u.fsu_blocksize, u.fsu_blocks, false), 6178 return list3 (blocks_to_bytes (u.fsu_blocksize, u.fsu_blocks, false),
6107 blocks_to_bytes (u.fsu_blocksize, u.fsu_bfree, false), 6179 blocks_to_bytes (u.fsu_blocksize, u.fsu_bfree, false),
6108 blocks_to_bytes (u.fsu_blocksize, u.fsu_bavail, 6180 blocks_to_bytes (u.fsu_blocksize, u.fsu_bavail,
diff --git a/src/filelock.c b/src/filelock.c
index 46349a63e4a..ff25d6475de 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -504,9 +504,9 @@ read_lock_data (char *lfname, char lfinfo[MAX_LFINFO + 1])
504} 504}
505 505
506/* Return 0 if nobody owns the lock file LFNAME or the lock is obsolete, 506/* Return 0 if nobody owns the lock file LFNAME or the lock is obsolete,
507 1 if another process owns it (and set OWNER (if non-null) to info), 507 -1 if another process owns it (and set OWNER (if non-null) to info),
508 2 if the current process owns it, 508 -2 if the current process owns it,
509 or -1 if something is wrong with the locking mechanism. */ 509 or an errno value if something is wrong with the locking mechanism. */
510 510
511static int 511static int
512current_lock_owner (lock_info_type *owner, char *lfname) 512current_lock_owner (lock_info_type *owner, char *lfname)
@@ -525,23 +525,23 @@ current_lock_owner (lock_info_type *owner, char *lfname)
525 /* If nonexistent lock file, all is well; otherwise, got strange error. */ 525 /* If nonexistent lock file, all is well; otherwise, got strange error. */
526 lfinfolen = read_lock_data (lfname, owner->user); 526 lfinfolen = read_lock_data (lfname, owner->user);
527 if (lfinfolen < 0) 527 if (lfinfolen < 0)
528 return errno == ENOENT ? 0 : -1; 528 return errno == ENOENT ? 0 : errno;
529 if (MAX_LFINFO < lfinfolen) 529 if (MAX_LFINFO < lfinfolen)
530 return -1; 530 return ENAMETOOLONG;
531 owner->user[lfinfolen] = 0; 531 owner->user[lfinfolen] = 0;
532 532
533 /* Parse USER@HOST.PID:BOOT_TIME. If can't parse, return -1. */ 533 /* Parse USER@HOST.PID:BOOT_TIME. If can't parse, return EINVAL. */
534 /* The USER is everything before the last @. */ 534 /* The USER is everything before the last @. */
535 owner->at = at = memrchr (owner->user, '@', lfinfolen); 535 owner->at = at = memrchr (owner->user, '@', lfinfolen);
536 if (!at) 536 if (!at)
537 return -1; 537 return EINVAL;
538 owner->dot = dot = strrchr (at, '.'); 538 owner->dot = dot = strrchr (at, '.');
539 if (!dot) 539 if (!dot)
540 return -1; 540 return EINVAL;
541 541
542 /* The PID is everything from the last '.' to the ':' or equivalent. */ 542 /* The PID is everything from the last '.' to the ':' or equivalent. */
543 if (! c_isdigit (dot[1])) 543 if (! c_isdigit (dot[1]))
544 return -1; 544 return EINVAL;
545 errno = 0; 545 errno = 0;
546 pid = strtoimax (dot + 1, &owner->colon, 10); 546 pid = strtoimax (dot + 1, &owner->colon, 10);
547 if (errno == ERANGE) 547 if (errno == ERANGE)
@@ -562,20 +562,20 @@ current_lock_owner (lock_info_type *owner, char *lfname)
562 mistakenly transliterate ':' to U+F022 in symlink contents. 562 mistakenly transliterate ':' to U+F022 in symlink contents.
563 See <https://bugzilla.redhat.com/show_bug.cgi?id=1384153>. */ 563 See <https://bugzilla.redhat.com/show_bug.cgi?id=1384153>. */
564 if (! (boot[0] == '\200' && boot[1] == '\242')) 564 if (! (boot[0] == '\200' && boot[1] == '\242'))
565 return -1; 565 return EINVAL;
566 boot += 2; 566 boot += 2;
567 FALLTHROUGH; 567 FALLTHROUGH;
568 case ':': 568 case ':':
569 if (! c_isdigit (boot[0])) 569 if (! c_isdigit (boot[0]))
570 return -1; 570 return EINVAL;
571 boot_time = strtoimax (boot, &lfinfo_end, 10); 571 boot_time = strtoimax (boot, &lfinfo_end, 10);
572 break; 572 break;
573 573
574 default: 574 default:
575 return -1; 575 return EINVAL;
576 } 576 }
577 if (lfinfo_end != owner->user + lfinfolen) 577 if (lfinfo_end != owner->user + lfinfolen)
578 return -1; 578 return EINVAL;
579 579
580 /* On current host? */ 580 /* On current host? */
581 Lisp_Object system_name = Fsystem_name (); 581 Lisp_Object system_name = Fsystem_name ();
@@ -584,22 +584,22 @@ current_lock_owner (lock_info_type *owner, char *lfname)
584 && memcmp (at + 1, SSDATA (system_name), SBYTES (system_name)) == 0) 584 && memcmp (at + 1, SSDATA (system_name), SBYTES (system_name)) == 0)
585 { 585 {
586 if (pid == getpid ()) 586 if (pid == getpid ())
587 ret = 2; /* We own it. */ 587 ret = -2; /* We own it. */
588 else if (0 < pid && pid <= TYPE_MAXIMUM (pid_t) 588 else if (0 < pid && pid <= TYPE_MAXIMUM (pid_t)
589 && (kill (pid, 0) >= 0 || errno == EPERM) 589 && (kill (pid, 0) >= 0 || errno == EPERM)
590 && (boot_time == 0 590 && (boot_time == 0
591 || (boot_time <= TYPE_MAXIMUM (time_t) 591 || (boot_time <= TYPE_MAXIMUM (time_t)
592 && within_one_second (boot_time, get_boot_time ())))) 592 && within_one_second (boot_time, get_boot_time ()))))
593 ret = 1; /* An existing process on this machine owns it. */ 593 ret = -1; /* An existing process on this machine owns it. */
594 /* The owner process is dead or has a strange pid, so try to 594 /* The owner process is dead or has a strange pid, so try to
595 zap the lockfile. */ 595 zap the lockfile. */
596 else 596 else
597 return unlink (lfname); 597 return unlink (lfname) < 0 ? errno : 0;
598 } 598 }
599 else 599 else
600 { /* If we wanted to support the check for stale locks on remote machines, 600 { /* If we wanted to support the check for stale locks on remote machines,
601 here's where we'd do it. */ 601 here's where we'd do it. */
602 ret = 1; 602 ret = -1;
603 } 603 }
604 604
605 return ret; 605 return ret;
@@ -608,9 +608,9 @@ current_lock_owner (lock_info_type *owner, char *lfname)
608 608
609/* Lock the lock named LFNAME if possible. 609/* Lock the lock named LFNAME if possible.
610 Return 0 in that case. 610 Return 0 in that case.
611 Return positive if some other process owns the lock, and info about 611 Return negative if some other process owns the lock, and info about
612 that process in CLASHER. 612 that process in CLASHER.
613 Return -1 if cannot lock for any other reason. */ 613 Return positive errno value if cannot lock for any other reason. */
614 614
615static int 615static int
616lock_if_free (lock_info_type *clasher, char *lfname) 616lock_if_free (lock_info_type *clasher, char *lfname)
@@ -618,20 +618,18 @@ lock_if_free (lock_info_type *clasher, char *lfname)
618 int err; 618 int err;
619 while ((err = lock_file_1 (lfname, 0)) == EEXIST) 619 while ((err = lock_file_1 (lfname, 0)) == EEXIST)
620 { 620 {
621 switch (current_lock_owner (clasher, lfname)) 621 err = current_lock_owner (clasher, lfname);
622 if (err != 0)
622 { 623 {
623 case 2: 624 if (err < 0)
624 return 0; /* We ourselves locked it. */ 625 return -2 - err; /* We locked it, or someone else has it. */
625 case 1: 626 break; /* current_lock_owner returned strange error. */
626 return 1; /* Someone else has it. */
627 case -1:
628 return -1; /* current_lock_owner returned strange error. */
629 } 627 }
630 628
631 /* We deleted a stale lock; try again to lock the file. */ 629 /* We deleted a stale lock; try again to lock the file. */
632 } 630 }
633 631
634 return err ? -1 : 0; 632 return err;
635} 633}
636 634
637/* lock_file locks file FN, 635/* lock_file locks file FN,
@@ -697,8 +695,9 @@ lock_file (Lisp_Object fn)
697 /* Create the name of the lock-file for file fn */ 695 /* Create the name of the lock-file for file fn */
698 MAKE_LOCK_NAME (lfname, encoded_fn); 696 MAKE_LOCK_NAME (lfname, encoded_fn);
699 697
700 /* Try to lock the lock. */ 698 /* Try to lock the lock. FIXME: This ignores errors when
701 if (0 < lock_if_free (&lock_info, lfname)) 699 lock_if_free returns a positive errno value. */
700 if (lock_if_free (&lock_info, lfname) < 0)
702 { 701 {
703 /* Someone else has the lock. Consider breaking it. */ 702 /* Someone else has the lock. Consider breaking it. */
704 Lisp_Object attack; 703 Lisp_Object attack;
@@ -725,13 +724,16 @@ unlock_file (Lisp_Object fn)
725 char *lfname; 724 char *lfname;
726 USE_SAFE_ALLOCA; 725 USE_SAFE_ALLOCA;
727 726
728 fn = Fexpand_file_name (fn, Qnil); 727 Lisp_Object filename = Fexpand_file_name (fn, Qnil);
729 fn = ENCODE_FILE (fn); 728 fn = ENCODE_FILE (filename);
730 729
731 MAKE_LOCK_NAME (lfname, fn); 730 MAKE_LOCK_NAME (lfname, fn);
732 731
733 if (current_lock_owner (0, lfname) == 2) 732 int err = current_lock_owner (0, lfname);
734 unlink (lfname); 733 if (err == -2 && unlink (lfname) != 0 && errno != ENOENT)
734 err = errno;
735 if (0 < err)
736 report_file_errno ("Unlocking file", filename, err);
735 737
736 SAFE_FREE (); 738 SAFE_FREE ();
737} 739}
@@ -822,17 +824,17 @@ t if it is locked by you, else a string saying which user has locked it. */)
822 USE_SAFE_ALLOCA; 824 USE_SAFE_ALLOCA;
823 825
824 filename = Fexpand_file_name (filename, Qnil); 826 filename = Fexpand_file_name (filename, Qnil);
825 filename = ENCODE_FILE (filename); 827 Lisp_Object encoded_filename = ENCODE_FILE (filename);
826 828 MAKE_LOCK_NAME (lfname, encoded_filename);
827 MAKE_LOCK_NAME (lfname, filename);
828 829
829 owner = current_lock_owner (&locker, lfname); 830 owner = current_lock_owner (&locker, lfname);
830 if (owner <= 0) 831 switch (owner)
831 ret = Qnil; 832 {
832 else if (owner == 2) 833 case -2: ret = Qt; break;
833 ret = Qt; 834 case -1: ret = make_string (locker.user, locker.at - locker.user); break;
834 else 835 case 0: ret = Qnil; break;
835 ret = make_string (locker.user, locker.at - locker.user); 836 default: report_file_errno ("Testing file lock", filename, owner);
837 }
836 838
837 SAFE_FREE (); 839 SAFE_FREE ();
838 return ret; 840 return ret;
diff --git a/src/fns.c b/src/fns.c
index df921e28f3b..f45c729cfaf 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -532,14 +532,12 @@ Do NOT use this function to compare file names for equality. */)
532static Lisp_Object concat (ptrdiff_t nargs, Lisp_Object *args, 532static Lisp_Object concat (ptrdiff_t nargs, Lisp_Object *args,
533 enum Lisp_Type target_type, bool last_special); 533 enum Lisp_Type target_type, bool last_special);
534 534
535/* ARGSUSED */
536Lisp_Object 535Lisp_Object
537concat2 (Lisp_Object s1, Lisp_Object s2) 536concat2 (Lisp_Object s1, Lisp_Object s2)
538{ 537{
539 return concat (2, ((Lisp_Object []) {s1, s2}), Lisp_String, 0); 538 return concat (2, ((Lisp_Object []) {s1, s2}), Lisp_String, 0);
540} 539}
541 540
542/* ARGSUSED */
543Lisp_Object 541Lisp_Object
544concat3 (Lisp_Object s1, Lisp_Object s2, Lisp_Object s3) 542concat3 (Lisp_Object s1, Lisp_Object s2, Lisp_Object s3)
545{ 543{
@@ -2577,7 +2575,6 @@ This makes STRING unibyte and may change its length. */)
2577 return Qnil; 2575 return Qnil;
2578} 2576}
2579 2577
2580/* ARGSUSED */
2581Lisp_Object 2578Lisp_Object
2582nconc2 (Lisp_Object s1, Lisp_Object s2) 2579nconc2 (Lisp_Object s1, Lisp_Object s2)
2583{ 2580{
diff --git a/src/lisp.h b/src/lisp.h
index 024e5edb26e..b081ae1cee8 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3824,9 +3824,10 @@ extern void mark_maybe_objects (Lisp_Object const *, ptrdiff_t);
3824extern void mark_stack (char const *, char const *); 3824extern void mark_stack (char const *, char const *);
3825extern void flush_stack_call_func (void (*func) (void *arg), void *arg); 3825extern void flush_stack_call_func (void (*func) (void *arg), void *arg);
3826extern void garbage_collect (void); 3826extern void garbage_collect (void);
3827extern void maybe_garbage_collect (void);
3827extern const char *pending_malloc_warning; 3828extern const char *pending_malloc_warning;
3828extern Lisp_Object zero_vector; 3829extern Lisp_Object zero_vector;
3829extern intmax_t consing_until_gc; 3830extern EMACS_INT consing_until_gc;
3830#ifdef HAVE_PDUMPER 3831#ifdef HAVE_PDUMPER
3831extern int number_finalizers_run; 3832extern int number_finalizers_run;
3832#endif 3833#endif
@@ -4298,7 +4299,6 @@ extern void syms_of_marker (void);
4298 4299
4299/* Defined in fileio.c. */ 4300/* Defined in fileio.c. */
4300 4301
4301extern bool check_executable (char *);
4302extern char *splice_dir_file (char *, char const *, char const *); 4302extern char *splice_dir_file (char *, char const *, char const *);
4303extern bool file_name_absolute_p (const char *); 4303extern bool file_name_absolute_p (const char *);
4304extern char const *get_homedir (void); 4304extern char const *get_homedir (void);
@@ -4309,12 +4309,15 @@ extern Lisp_Object write_region (Lisp_Object, Lisp_Object, Lisp_Object,
4309extern void close_file_unwind (int); 4309extern void close_file_unwind (int);
4310extern void fclose_unwind (void *); 4310extern void fclose_unwind (void *);
4311extern void restore_point_unwind (Lisp_Object); 4311extern void restore_point_unwind (Lisp_Object);
4312extern bool file_access_p (char const *, int);
4312extern Lisp_Object get_file_errno_data (const char *, Lisp_Object, int); 4313extern Lisp_Object get_file_errno_data (const char *, Lisp_Object, int);
4313extern AVOID report_file_errno (const char *, Lisp_Object, int); 4314extern AVOID report_file_errno (const char *, Lisp_Object, int);
4314extern AVOID report_file_error (const char *, Lisp_Object); 4315extern AVOID report_file_error (const char *, Lisp_Object);
4315extern AVOID report_file_notify_error (const char *, Lisp_Object); 4316extern AVOID report_file_notify_error (const char *, Lisp_Object);
4317extern Lisp_Object file_attribute_errno (Lisp_Object, int);
4318extern Lisp_Object file_test_errno (Lisp_Object, int);
4316extern bool internal_delete_file (Lisp_Object); 4319extern bool internal_delete_file (Lisp_Object);
4317extern Lisp_Object emacs_readlinkat (int, const char *); 4320extern Lisp_Object check_emacs_readlinkat (int, Lisp_Object, char const *);
4318extern bool file_directory_p (Lisp_Object); 4321extern bool file_directory_p (Lisp_Object);
4319extern bool file_accessible_directory_p (Lisp_Object); 4322extern bool file_accessible_directory_p (Lisp_Object);
4320extern void init_fileio (void); 4323extern void init_fileio (void);
@@ -5056,7 +5059,7 @@ INLINE void
5056maybe_gc (void) 5059maybe_gc (void)
5057{ 5060{
5058 if (consing_until_gc < 0) 5061 if (consing_until_gc < 0)
5059 garbage_collect (); 5062 maybe_garbage_collect ();
5060} 5063}
5061 5064
5062INLINE_HEADER_END 5065INLINE_HEADER_END
diff --git a/src/lread.c b/src/lread.c
index 6ae7a0d8ba0..ab0fab47a98 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -1346,15 +1346,22 @@ Return t if the file exists and loads successfully. */)
1346 if (!load_prefer_newer && is_elc) 1346 if (!load_prefer_newer && is_elc)
1347 { 1347 {
1348 result = stat (SSDATA (efound), &s1); 1348 result = stat (SSDATA (efound), &s1);
1349 int err = errno;
1349 if (result == 0) 1350 if (result == 0)
1350 { 1351 {
1351 SSET (efound, SBYTES (efound) - 1, 0); 1352 SSET (efound, SBYTES (efound) - 1, 0);
1352 result = stat (SSDATA (efound), &s2); 1353 result = stat (SSDATA (efound), &s2);
1354 err = errno;
1353 SSET (efound, SBYTES (efound) - 1, 'c'); 1355 SSET (efound, SBYTES (efound) - 1, 'c');
1356 if (result != 0)
1357 found = Fsubstring (found, make_fixnum (0),
1358 make_fixnum (-1));
1354 } 1359 }
1355 1360 if (result != 0)
1356 if (result == 0 1361 file_test_errno (found, err);
1357 && timespec_cmp (get_stat_mtime (&s1), get_stat_mtime (&s2)) < 0) 1362 else if (timespec_cmp (get_stat_mtime (&s1),
1363 get_stat_mtime (&s2))
1364 < 0)
1358 { 1365 {
1359 /* Make the progress messages mention that source is newer. */ 1366 /* Make the progress messages mention that source is newer. */
1360 newer = 1; 1367 newer = 1;
@@ -1748,16 +1755,20 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
1748 { 1755 {
1749 if (file_directory_p (encoded_fn)) 1756 if (file_directory_p (encoded_fn))
1750 last_errno = EISDIR; 1757 last_errno = EISDIR;
1751 else 1758 else if (errno == ENOENT || errno == ENOTDIR)
1752 fd = 1; 1759 fd = 1;
1760 else
1761 last_errno = errno;
1753 } 1762 }
1763 else if (! (errno == ENOENT || errno == ENOTDIR))
1764 last_errno = errno;
1754 } 1765 }
1755 else 1766 else
1756 { 1767 {
1757 fd = emacs_open (pfn, O_RDONLY, 0); 1768 fd = emacs_open (pfn, O_RDONLY, 0);
1758 if (fd < 0) 1769 if (fd < 0)
1759 { 1770 {
1760 if (errno != ENOENT) 1771 if (! (errno == ENOENT || errno == ENOTDIR))
1761 last_errno = errno; 1772 last_errno = errno;
1762 } 1773 }
1763 else 1774 else
diff --git a/src/print.c b/src/print.c
index 7c3da68fc98..7e5aed82877 100644
--- a/src/print.c
+++ b/src/print.c
@@ -81,7 +81,7 @@ static ptrdiff_t print_buffer_pos_byte;
81 -N the object will be printed several times and will take number N. 81 -N the object will be printed several times and will take number N.
82 N the object has been printed so we can refer to it as #N#. 82 N the object has been printed so we can refer to it as #N#.
83 print_number_index holds the largest N already used. 83 print_number_index holds the largest N already used.
84 N has to be striclty larger than 0 since we need to distinguish -N. */ 84 N has to be strictly larger than 0 since we need to distinguish -N. */
85static ptrdiff_t print_number_index; 85static ptrdiff_t print_number_index;
86static void print_interval (INTERVAL interval, Lisp_Object printcharfun); 86static void print_interval (INTERVAL interval, Lisp_Object printcharfun);
87 87
@@ -1120,8 +1120,8 @@ print (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
1120 Vprint_number_table = Qnil; 1120 Vprint_number_table = Qnil;
1121 } 1121 }
1122 1122
1123 /* Construct Vprint_number_table for print-gensym and print-circle. */ 1123 /* Construct Vprint_number_table for print-circle. */
1124 if (!NILP (Vprint_gensym) || !NILP (Vprint_circle)) 1124 if (!NILP (Vprint_circle))
1125 { 1125 {
1126 /* Construct Vprint_number_table. 1126 /* Construct Vprint_number_table.
1127 This increments print_number_index for the objects added. */ 1127 This increments print_number_index for the objects added. */
@@ -1149,7 +1149,11 @@ print (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
1149} 1149}
1150 1150
1151#define PRINT_CIRCLE_CANDIDATE_P(obj) \ 1151#define PRINT_CIRCLE_CANDIDATE_P(obj) \
1152 (STRINGP (obj) || CONSP (obj) \ 1152 ((STRINGP (obj) \
1153 && (string_intervals (obj) \
1154 || print_depth > 1 \
1155 || !NILP (Vprint_continuous_numbering))) \
1156 || CONSP (obj) \
1153 || (VECTORLIKEP (obj) \ 1157 || (VECTORLIKEP (obj) \
1154 && (VECTORP (obj) || COMPILEDP (obj) \ 1158 && (VECTORP (obj) || COMPILEDP (obj) \
1155 || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj) \ 1159 || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj) \
@@ -1159,13 +1163,14 @@ print (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
1159 && SYMBOLP (obj) \ 1163 && SYMBOLP (obj) \
1160 && !SYMBOL_INTERNED_P (obj))) 1164 && !SYMBOL_INTERNED_P (obj)))
1161 1165
1162/* Construct Vprint_number_table according to the structure of OBJ. 1166/* Construct Vprint_number_table for the print-circle feature
1163 OBJ itself and all its elements will be added to Vprint_number_table 1167 according to the structure of OBJ. OBJ itself and all its elements
1164 recursively if it is a list, vector, compiled function, char-table, 1168 will be added to Vprint_number_table recursively if it is a list,
1165 string (its text properties will be traced), or a symbol that has 1169 vector, compiled function, char-table, string (its text properties
1166 no obarray (this is for the print-gensym feature). 1170 will be traced), or a symbol that has no obarray (this is for the
1167 The status fields of Vprint_number_table mean whether each object appears 1171 print-gensym feature). The status fields of Vprint_number_table
1168 more than once in OBJ: Qnil at the first time, and Qt after that. */ 1172 mean whether each object appears more than once in OBJ: Qnil at the
1173 first time, and Qt after that. */
1169static void 1174static void
1170print_preprocess (Lisp_Object obj) 1175print_preprocess (Lisp_Object obj)
1171{ 1176{
@@ -1174,20 +1179,7 @@ print_preprocess (Lisp_Object obj)
1174 int loop_count = 0; 1179 int loop_count = 0;
1175 Lisp_Object halftail; 1180 Lisp_Object halftail;
1176 1181
1177 /* Avoid infinite recursion for circular nested structure 1182 eassert (!NILP (Vprint_circle));
1178 in the case where Vprint_circle is nil. */
1179 if (NILP (Vprint_circle))
1180 {
1181 /* Give up if we go so deep that print_object will get an error. */
1182 /* See similar code in print_object. */
1183 if (print_depth >= PRINT_CIRCLE)
1184 error ("Apparently circular structure being printed");
1185
1186 for (i = 0; i < print_depth; i++)
1187 if (EQ (obj, being_printed[i]))
1188 return;
1189 being_printed[print_depth] = obj;
1190 }
1191 1183
1192 print_depth++; 1184 print_depth++;
1193 halftail = obj; 1185 halftail = obj;
@@ -1198,33 +1190,28 @@ print_preprocess (Lisp_Object obj)
1198 if (!HASH_TABLE_P (Vprint_number_table)) 1190 if (!HASH_TABLE_P (Vprint_number_table))
1199 Vprint_number_table = CALLN (Fmake_hash_table, QCtest, Qeq); 1191 Vprint_number_table = CALLN (Fmake_hash_table, QCtest, Qeq);
1200 1192
1201 /* In case print-circle is nil and print-gensym is t, 1193 Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil);
1202 add OBJ to Vprint_number_table only when OBJ is a symbol. */ 1194 if (!NILP (num)
1203 if (! NILP (Vprint_circle) || SYMBOLP (obj)) 1195 /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym,
1204 { 1196 always print the gensym with a number. This is a special for
1205 Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil); 1197 the lisp function byte-compile-output-docform. */
1206 if (!NILP (num) 1198 || (!NILP (Vprint_continuous_numbering)
1207 /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym, 1199 && SYMBOLP (obj)
1208 always print the gensym with a number. This is a special for 1200 && !SYMBOL_INTERNED_P (obj)))
1209 the lisp function byte-compile-output-docform. */ 1201 { /* OBJ appears more than once. Let's remember that. */
1210 || (!NILP (Vprint_continuous_numbering) 1202 if (!FIXNUMP (num))
1211 && SYMBOLP (obj) 1203 {
1212 && !SYMBOL_INTERNED_P (obj))) 1204 print_number_index++;
1213 { /* OBJ appears more than once. Let's remember that. */ 1205 /* Negative number indicates it hasn't been printed yet. */
1214 if (!FIXNUMP (num)) 1206 Fputhash (obj, make_fixnum (- print_number_index),
1215 { 1207 Vprint_number_table);
1216 print_number_index++;
1217 /* Negative number indicates it hasn't been printed yet. */
1218 Fputhash (obj, make_fixnum (- print_number_index),
1219 Vprint_number_table);
1220 }
1221 print_depth--;
1222 return;
1223 } 1208 }
1224 else 1209 print_depth--;
1225 /* OBJ is not yet recorded. Let's add to the table. */ 1210 return;
1226 Fputhash (obj, Qt, Vprint_number_table);
1227 } 1211 }
1212 else
1213 /* OBJ is not yet recorded. Let's add to the table. */
1214 Fputhash (obj, Qt, Vprint_number_table);
1228 1215
1229 switch (XTYPE (obj)) 1216 switch (XTYPE (obj))
1230 { 1217 {
@@ -1271,11 +1258,15 @@ print_preprocess (Lisp_Object obj)
1271 1258
1272DEFUN ("print--preprocess", Fprint_preprocess, Sprint_preprocess, 1, 1, 0, 1259DEFUN ("print--preprocess", Fprint_preprocess, Sprint_preprocess, 1, 1, 0,
1273 doc: /* Extract sharing info from OBJECT needed to print it. 1260 doc: /* Extract sharing info from OBJECT needed to print it.
1274Fills `print-number-table'. */) 1261Fills `print-number-table' if `print-circle' is non-nil. Does nothing
1275 (Lisp_Object object) 1262if `print-circle' is nil. */)
1263 (Lisp_Object object)
1276{ 1264{
1277 print_number_index = 0; 1265 if (!NILP (Vprint_circle))
1278 print_preprocess (object); 1266 {
1267 print_number_index = 0;
1268 print_preprocess (object);
1269 }
1279 return Qnil; 1270 return Qnil;
1280} 1271}
1281 1272
@@ -1860,7 +1851,6 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
1860 /* Simple but incomplete way. */ 1851 /* Simple but incomplete way. */
1861 int i; 1852 int i;
1862 1853
1863 /* See similar code in print_preprocess. */
1864 if (print_depth >= PRINT_CIRCLE) 1854 if (print_depth >= PRINT_CIRCLE)
1865 error ("Apparently circular structure being printed"); 1855 error ("Apparently circular structure being printed");
1866 1856
diff --git a/src/profiler.c b/src/profiler.c
index 6943905062c..84583cec765 100644
--- a/src/profiler.c
+++ b/src/profiler.c
@@ -66,11 +66,11 @@ make_log (void)
66 Qnil, false); 66 Qnil, false);
67 struct Lisp_Hash_Table *h = XHASH_TABLE (log); 67 struct Lisp_Hash_Table *h = XHASH_TABLE (log);
68 68
69 /* What is special about our hash-tables is that the keys are pre-filled 69 /* What is special about our hash-tables is that the values are pre-filled
70 with the vectors we'll put in them. */ 70 with the vectors we'll use as keys. */
71 ptrdiff_t i = ASIZE (h->key_and_value) >> 1; 71 ptrdiff_t i = ASIZE (h->key_and_value) >> 1;
72 while (i > 0) 72 while (i > 0)
73 set_hash_key_slot (h, --i, make_nil_vector (max_stack_depth)); 73 set_hash_value_slot (h, --i, make_nil_vector (max_stack_depth));
74 return log; 74 return log;
75} 75}
76 76
@@ -132,13 +132,14 @@ static void evict_lower_half (log_t *log)
132 XSET_HASH_TABLE (tmp, log); /* FIXME: Use make_lisp_ptr. */ 132 XSET_HASH_TABLE (tmp, log); /* FIXME: Use make_lisp_ptr. */
133 Fremhash (key, tmp); 133 Fremhash (key, tmp);
134 } 134 }
135 eassert (EQ (Qunbound, HASH_KEY (log, i)));
135 eassert (log->next_free == i); 136 eassert (log->next_free == i);
136 137
137 eassert (VECTORP (key)); 138 eassert (VECTORP (key));
138 for (ptrdiff_t j = 0; j < ASIZE (key); j++) 139 for (ptrdiff_t j = 0; j < ASIZE (key); j++)
139 ASET (key, j, Qnil); 140 ASET (key, j, Qnil);
140 141
141 set_hash_key_slot (log, i, key); 142 set_hash_value_slot (log, i, key);
142 } 143 }
143} 144}
144 145
@@ -156,7 +157,8 @@ record_backtrace (log_t *log, EMACS_INT count)
156 ptrdiff_t index = log->next_free; 157 ptrdiff_t index = log->next_free;
157 158
158 /* Get a "working memory" vector. */ 159 /* Get a "working memory" vector. */
159 Lisp_Object backtrace = HASH_KEY (log, index); 160 Lisp_Object backtrace = HASH_VALUE (log, index);
161 eassert (EQ (Qunbound, HASH_KEY (log, index)));
160 get_backtrace (backtrace); 162 get_backtrace (backtrace);
161 163
162 { /* We basically do a `gethash+puthash' here, except that we have to be 164 { /* We basically do a `gethash+puthash' here, except that we have to be
diff --git a/src/term.c b/src/term.c
index a88d47f9238..5f70c7a3d4f 100644
--- a/src/term.c
+++ b/src/term.c
@@ -1084,7 +1084,6 @@ int *char_ins_del_vector;
1084 1084
1085#define char_ins_del_cost(f) (&char_ins_del_vector[FRAME_COLS ((f))]) 1085#define char_ins_del_cost(f) (&char_ins_del_vector[FRAME_COLS ((f))])
1086 1086
1087/* ARGSUSED */
1088static void 1087static void
1089calculate_ins_del_char_costs (struct frame *f) 1088calculate_ins_del_char_costs (struct frame *f)
1090{ 1089{
diff --git a/src/w32.c b/src/w32.c
index d7a91692c63..88e9aef338f 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -4151,13 +4151,36 @@ w32_accessible_directory_p (const char *dirname, ptrdiff_t dirlen)
4151 /* In case DIRNAME cannot be expressed in characters from the 4151 /* In case DIRNAME cannot be expressed in characters from the
4152 current ANSI codepage. */ 4152 current ANSI codepage. */
4153 if (_mbspbrk (pat_a, "?")) 4153 if (_mbspbrk (pat_a, "?"))
4154 dh = INVALID_HANDLE_VALUE; 4154 {
4155 else 4155 errno = ENOENT;
4156 dh = FindFirstFileA (pat_a, &dfd_a); 4156 return 0;
4157 }
4158 dh = FindFirstFileA (pat_a, &dfd_a);
4157 } 4159 }
4158 4160
4159 if (dh == INVALID_HANDLE_VALUE) 4161 if (dh == INVALID_HANDLE_VALUE)
4162 {
4163 DWORD w32err = GetLastError ();
4164
4165 switch (w32err)
4166 {
4167 case ERROR_INVALID_NAME:
4168 case ERROR_BAD_PATHNAME:
4169 case ERROR_FILE_NOT_FOUND:
4170 case ERROR_PATH_NOT_FOUND:
4171 case ERROR_NO_MORE_FILES:
4172 case ERROR_BAD_NETPATH:
4173 errno = ENOENT;
4174 break;
4175 case ERROR_NOT_READY:
4176 errno = ENODEV;
4177 break;
4178 default:
4179 errno = EACCES;
4180 break;
4181 }
4160 return 0; 4182 return 0;
4183 }
4161 FindClose (dh); 4184 FindClose (dh);
4162 return 1; 4185 return 1;
4163} 4186}
diff --git a/src/w32fns.c b/src/w32fns.c
index d6fd8f53490..34abd026f95 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -10109,8 +10109,8 @@ KEY can use either forward- or back-slashes.
10109To access the default value of KEY (if it is defined), use NAME 10109To access the default value of KEY (if it is defined), use NAME
10110that is an empty string. 10110that is an empty string.
10111 10111
10112If the the named KEY or its subkey called NAME don't exist, or cannot 10112If the named KEY or its subkey called NAME don't exist, or cannot be
10113be accessed by the current user, the function returns nil. Otherwise, 10113accessed by the current user, the function returns nil. Otherwise,
10114the return value depends on the type of the data stored in Registry: 10114the return value depends on the type of the data stored in Registry:
10115 10115
10116 If the data type is REG_NONE, the function returns t. 10116 If the data type is REG_NONE, the function returns t.
diff --git a/src/w32font.c b/src/w32font.c
index 14d49b24d9b..9a334717c12 100644
--- a/src/w32font.c
+++ b/src/w32font.c
@@ -90,6 +90,8 @@ struct font_callback_data
90 Lisp_Object orig_font_spec; 90 Lisp_Object orig_font_spec;
91 /* The frame the font is being loaded on. */ 91 /* The frame the font is being loaded on. */
92 Lisp_Object frame; 92 Lisp_Object frame;
93 /* Fonts known to support the font spec, or nil if none. */
94 Lisp_Object known_fonts;
93 /* The list to add matches to. */ 95 /* The list to add matches to. */
94 Lisp_Object list; 96 Lisp_Object list;
95 /* Whether to match only opentype fonts. */ 97 /* Whether to match only opentype fonts. */
@@ -841,6 +843,25 @@ w32font_list_internal (struct frame *f, Lisp_Object font_spec,
841 match_data.opentype_only = opentype_only; 843 match_data.opentype_only = opentype_only;
842 if (opentype_only) 844 if (opentype_only)
843 match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS; 845 match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS;
846 match_data.known_fonts = Qnil;
847 Lisp_Object vw32_non_USB_fonts = Fsymbol_value (Qw32_non_USB_fonts), val;
848 if (CONSP (vw32_non_USB_fonts))
849 {
850 Lisp_Object extra;
851 for (extra = AREF (font_spec, FONT_EXTRA_INDEX);
852 CONSP (extra); extra = XCDR (extra))
853 {
854 Lisp_Object tem = XCAR (extra);
855 if (CONSP (tem)
856 && EQ (XCAR (tem), QCscript)
857 && SYMBOLP (XCDR (tem))
858 && !NILP (val = assq_no_quit (XCDR (tem), vw32_non_USB_fonts)))
859 {
860 match_data.known_fonts = XCDR (val);
861 break;
862 }
863 }
864 }
844 865
845 if (match_data.pattern.lfFaceName[0] == '\0') 866 if (match_data.pattern.lfFaceName[0] == '\0')
846 { 867 {
@@ -890,6 +911,26 @@ w32font_match_internal (struct frame *f, Lisp_Object font_spec,
890 if (opentype_only) 911 if (opentype_only)
891 match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS; 912 match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS;
892 913
914 match_data.known_fonts = Qnil;
915 Lisp_Object vw32_non_USB_fonts = Fsymbol_value (Qw32_non_USB_fonts), val;
916 if (CONSP (vw32_non_USB_fonts))
917 {
918 Lisp_Object extra;
919 for (extra = AREF (font_spec, FONT_EXTRA_INDEX);
920 CONSP (extra); extra = XCDR (extra))
921 {
922 Lisp_Object tem = XCAR (extra);
923 if (CONSP (tem)
924 && EQ (XCAR (tem), QCscript)
925 && SYMBOLP (XCDR (tem))
926 && !NILP (val = assq_no_quit (XCDR (tem), vw32_non_USB_fonts)))
927 {
928 match_data.known_fonts = XCDR (val);
929 break;
930 }
931 }
932 }
933
893 /* Prevent quitting while EnumFontFamiliesEx runs and conses the 934 /* Prevent quitting while EnumFontFamiliesEx runs and conses the
894 list it will return. That's because get_frame_dc acquires the 935 list it will return. That's because get_frame_dc acquires the
895 critical section, so we cannot quit before we release it in 936 critical section, so we cannot quit before we release it in
@@ -1511,9 +1552,13 @@ add_font_entity_to_list (ENUMLOGFONTEX *logical_font,
1511 1552
1512 /* Ensure a match. */ 1553 /* Ensure a match. */
1513 if (!logfonts_match (&logical_font->elfLogFont, &match_data->pattern) 1554 if (!logfonts_match (&logical_font->elfLogFont, &match_data->pattern)
1514 || !font_matches_spec (font_type, physical_font, 1555 || !(font_matches_spec (font_type, physical_font,
1515 match_data->orig_font_spec, backend, 1556 match_data->orig_font_spec, backend,
1516 &logical_font->elfLogFont) 1557 &logical_font->elfLogFont)
1558 || (!NILP (match_data->known_fonts)
1559 && memq_no_quit
1560 (intern_font_name (logical_font->elfLogFont.lfFaceName),
1561 match_data->known_fonts)))
1517 || !w32font_coverage_ok (&physical_font->ntmFontSig, 1562 || !w32font_coverage_ok (&physical_font->ntmFontSig,
1518 match_data->pattern.lfCharSet)) 1563 match_data->pattern.lfCharSet))
1519 return 1; 1564 return 1;
@@ -2214,8 +2259,9 @@ font_supported_scripts (FONTSIGNATURE * sig)
2214 || (subranges[2] & (mask2)) || (subranges[3] & (mask3))) \ 2259 || (subranges[2] & (mask2)) || (subranges[3] & (mask3))) \
2215 supported = Fcons ((sym), supported) 2260 supported = Fcons ((sym), supported)
2216 2261
2217 SUBRANGE (0, Qlatin); 2262 /* 0: ASCII (a.k.a. "Basic Latin"),
2218 /* 1: Latin-1 supplement, 2: Latin Extended A, 3: Latin Extended B. */ 2263 1: Latin-1 supplement, 2: Latin Extended A, 3: Latin Extended B,
2264 29: Latin Extended Additional. */
2219 /* Most fonts that support Latin will have good coverage of the 2265 /* Most fonts that support Latin will have good coverage of the
2220 Extended blocks, so in practice marking them below is not really 2266 Extended blocks, so in practice marking them below is not really
2221 needed, or useful: if a font claims support for, say, Latin 2267 needed, or useful: if a font claims support for, say, Latin
@@ -2224,12 +2270,11 @@ font_supported_scripts (FONTSIGNATURE * sig)
2224 fontset to display those few characters. But we mark these 2270 fontset to display those few characters. But we mark these
2225 subranges here anyway, for the marginal use cases where they 2271 subranges here anyway, for the marginal use cases where they
2226 might make a difference. */ 2272 might make a difference. */
2227 SUBRANGE (1, Qlatin); 2273 MASK_ANY (0x2000000F, 0, 0, 0, Qlatin);
2228 SUBRANGE (2, Qlatin);
2229 SUBRANGE (3, Qlatin);
2230 SUBRANGE (4, Qphonetic); 2274 SUBRANGE (4, Qphonetic);
2231 /* 5: Spacing and tone modifiers, 6: Combining Diacritical Marks. */ 2275 /* 5: Spacing and tone modifiers, 6: Combining Diacritical Marks. */
2232 SUBRANGE (7, Qgreek); 2276 /* 7: Greek and Coptic, 30: Greek Extended. */
2277 MASK_ANY (0x40000080, 0, 0, 0, Qgreek);
2233 SUBRANGE (8, Qcoptic); 2278 SUBRANGE (8, Qcoptic);
2234 SUBRANGE (9, Qcyrillic); 2279 SUBRANGE (9, Qcyrillic);
2235 SUBRANGE (10, Qarmenian); 2280 SUBRANGE (10, Qarmenian);
@@ -2246,7 +2291,7 @@ font_supported_scripts (FONTSIGNATURE * sig)
2246 SUBRANGE (16, Qbengali); 2291 SUBRANGE (16, Qbengali);
2247 SUBRANGE (17, Qgurmukhi); 2292 SUBRANGE (17, Qgurmukhi);
2248 SUBRANGE (18, Qgujarati); 2293 SUBRANGE (18, Qgujarati);
2249 SUBRANGE (19, Qoriya); 2294 SUBRANGE (19, Qoriya); /* a.k.a. "Odia" */
2250 SUBRANGE (20, Qtamil); 2295 SUBRANGE (20, Qtamil);
2251 SUBRANGE (21, Qtelugu); 2296 SUBRANGE (21, Qtelugu);
2252 SUBRANGE (22, Qkannada); 2297 SUBRANGE (22, Qkannada);
@@ -2259,8 +2304,7 @@ font_supported_scripts (FONTSIGNATURE * sig)
2259 /* 29: Latin Extended, 30: Greek Extended -- covered above. */ 2304 /* 29: Latin Extended, 30: Greek Extended -- covered above. */
2260 /* 31: Supplemental Punctuation -- most probably be masked by 2305 /* 31: Supplemental Punctuation -- most probably be masked by
2261 Courier New, so fontset customization is needed. */ 2306 Courier New, so fontset customization is needed. */
2262 SUBRANGE (31, Qsymbol); 2307 /* 31-47: Symbols (defined below). */
2263 /* 32-47: Symbols (defined below). */
2264 SUBRANGE (48, Qcjk_misc); 2308 SUBRANGE (48, Qcjk_misc);
2265 /* Match either 49: katakana or 50: hiragana for kana. */ 2309 /* Match either 49: katakana or 50: hiragana for kana. */
2266 MASK_ANY (0, 0x00060000, 0, 0, Qkana); 2310 MASK_ANY (0, 0x00060000, 0, 0, Qkana);
@@ -2286,7 +2330,7 @@ font_supported_scripts (FONTSIGNATURE * sig)
2286 SUBRANGE (71, Qsyriac); 2330 SUBRANGE (71, Qsyriac);
2287 SUBRANGE (72, Qthaana); 2331 SUBRANGE (72, Qthaana);
2288 SUBRANGE (73, Qsinhala); 2332 SUBRANGE (73, Qsinhala);
2289 SUBRANGE (74, Qmyanmar); 2333 SUBRANGE (74, Qburmese); /* a.k.a. "Myanmar" */
2290 SUBRANGE (75, Qethiopic); 2334 SUBRANGE (75, Qethiopic);
2291 SUBRANGE (76, Qcherokee); 2335 SUBRANGE (76, Qcherokee);
2292 SUBRANGE (77, Qcanadian_aboriginal); 2336 SUBRANGE (77, Qcanadian_aboriginal);
@@ -2329,6 +2373,7 @@ font_supported_scripts (FONTSIGNATURE * sig)
2329 SUBRANGE (99, Qhan); 2373 SUBRANGE (99, Qhan);
2330 SUBRANGE (100, Qsyloti_nagri); 2374 SUBRANGE (100, Qsyloti_nagri);
2331 SUBRANGE (101, Qlinear_b); 2375 SUBRANGE (101, Qlinear_b);
2376 SUBRANGE (101, Qaegean_number);
2332 SUBRANGE (102, Qancient_greek_number); 2377 SUBRANGE (102, Qancient_greek_number);
2333 SUBRANGE (103, Qugaritic); 2378 SUBRANGE (103, Qugaritic);
2334 SUBRANGE (104, Qold_persian); 2379 SUBRANGE (104, Qold_persian);
@@ -2338,6 +2383,7 @@ font_supported_scripts (FONTSIGNATURE * sig)
2338 SUBRANGE (108, Qkharoshthi); 2383 SUBRANGE (108, Qkharoshthi);
2339 SUBRANGE (109, Qtai_xuan_jing_symbol); 2384 SUBRANGE (109, Qtai_xuan_jing_symbol);
2340 SUBRANGE (110, Qcuneiform); 2385 SUBRANGE (110, Qcuneiform);
2386 SUBRANGE (111, Qcuneiform_numbers_and_punctuation);
2341 SUBRANGE (111, Qcounting_rod_numeral); 2387 SUBRANGE (111, Qcounting_rod_numeral);
2342 SUBRANGE (112, Qsundanese); 2388 SUBRANGE (112, Qsundanese);
2343 SUBRANGE (113, Qlepcha); 2389 SUBRANGE (113, Qlepcha);
@@ -2357,9 +2403,52 @@ font_supported_scripts (FONTSIGNATURE * sig)
2357 2403
2358 /* There isn't really a main symbol range, so include symbol if any 2404 /* There isn't really a main symbol range, so include symbol if any
2359 relevant range is set. */ 2405 relevant range is set. */
2360 MASK_ANY (0x8000000, 0x0000FFFF, 0, 0, Qsymbol); 2406 MASK_ANY (0x80000000, 0x0000FFFF, 0, 0, Qsymbol);
2361 2407
2362 /* Missing: Tai Viet (U+AA80-U+AADF). */ 2408 /* Missing:
2409 Tai Viet
2410 Old Permic
2411 Palmyrene
2412 Nabatean
2413 Manichean
2414 Hanifi Rohingya
2415 Sogdian
2416 Elymaic
2417 Mahajani
2418 Khojki
2419 Khudawadi
2420 Grantha
2421 Newa
2422 Tirhuta
2423 Siddham
2424 Modi
2425 Takri
2426 Dogra
2427 Warang Citi
2428 Nandinagari
2429 Zanabazar Square
2430 Soyombo
2431 Pau Cin Hau
2432 Bhaiksuki
2433 Marchen
2434 Masaram Gondi
2435 Makasar
2436 Egyptian
2437 Mro
2438 Bassa-Vah
2439 Pahawh Hmong
2440 Medefaidrin
2441 Tangut
2442 Tangut Components
2443 Nushu
2444 Duployan Shorthand
2445 Ancient Greek Musical Notation
2446 Nyiakeng Puachue Hmong
2447 Wancho
2448 Mende Kikakui
2449 Adlam
2450 Indic Siyaq Number
2451 Ottoman Siyaq Number. */
2363#undef SUBRANGE 2452#undef SUBRANGE
2364#undef MASK_ANY 2453#undef MASK_ANY
2365 2454
@@ -2698,7 +2787,7 @@ syms_of_w32font (void)
2698 DEFSYM (Qthai, "thai"); 2787 DEFSYM (Qthai, "thai");
2699 DEFSYM (Qlao, "lao"); 2788 DEFSYM (Qlao, "lao");
2700 DEFSYM (Qtibetan, "tibetan"); 2789 DEFSYM (Qtibetan, "tibetan");
2701 DEFSYM (Qmyanmar, "myanmar"); 2790 DEFSYM (Qburmese, "burmese");
2702 DEFSYM (Qgeorgian, "georgian"); 2791 DEFSYM (Qgeorgian, "georgian");
2703 DEFSYM (Qhangul, "hangul"); 2792 DEFSYM (Qhangul, "hangul");
2704 DEFSYM (Qethiopic, "ethiopic"); 2793 DEFSYM (Qethiopic, "ethiopic");
@@ -2737,6 +2826,8 @@ syms_of_w32font (void)
2737 DEFSYM (Qbuginese, "buginese"); 2826 DEFSYM (Qbuginese, "buginese");
2738 DEFSYM (Qbuhid, "buhid"); 2827 DEFSYM (Qbuhid, "buhid");
2739 DEFSYM (Qcuneiform, "cuneiform"); 2828 DEFSYM (Qcuneiform, "cuneiform");
2829 DEFSYM (Qcuneiform_numbers_and_punctuation,
2830 "cuneiform-numbers-and-punctuation");
2740 DEFSYM (Qcypriot, "cypriot"); 2831 DEFSYM (Qcypriot, "cypriot");
2741 DEFSYM (Qdeseret, "deseret"); 2832 DEFSYM (Qdeseret, "deseret");
2742 DEFSYM (Qglagolitic, "glagolitic"); 2833 DEFSYM (Qglagolitic, "glagolitic");
@@ -2745,6 +2836,7 @@ syms_of_w32font (void)
2745 DEFSYM (Qkharoshthi, "kharoshthi"); 2836 DEFSYM (Qkharoshthi, "kharoshthi");
2746 DEFSYM (Qlimbu, "limbu"); 2837 DEFSYM (Qlimbu, "limbu");
2747 DEFSYM (Qlinear_b, "linear_b"); 2838 DEFSYM (Qlinear_b, "linear_b");
2839 DEFSYM (Qaegean_number, "aegean-number");
2748 DEFSYM (Qold_italic, "old_italic"); 2840 DEFSYM (Qold_italic, "old_italic");
2749 DEFSYM (Qold_persian, "old_persian"); 2841 DEFSYM (Qold_persian, "old_persian");
2750 DEFSYM (Qosmanya, "osmanya"); 2842 DEFSYM (Qosmanya, "osmanya");
@@ -2818,6 +2910,7 @@ versions of Windows) characters. */);
2818 DEFSYM (Qw32_charset_vietnamese, "w32-charset-vietnamese"); 2910 DEFSYM (Qw32_charset_vietnamese, "w32-charset-vietnamese");
2819 DEFSYM (Qw32_charset_thai, "w32-charset-thai"); 2911 DEFSYM (Qw32_charset_thai, "w32-charset-thai");
2820 DEFSYM (Qw32_charset_mac, "w32-charset-mac"); 2912 DEFSYM (Qw32_charset_mac, "w32-charset-mac");
2913 DEFSYM (Qw32_non_USB_fonts, "w32-non-USB-fonts");
2821 2914
2822 defsubr (&Sx_select_font); 2915 defsubr (&Sx_select_font);
2823 2916
diff --git a/src/xdisp.c b/src/xdisp.c
index 94f969f37cf..6626fbcf63e 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -12907,7 +12907,8 @@ tool_bar_height (struct frame *f, int *n_rows, bool pixelwise)
12907 temp_row->reversed_p = false; 12907 temp_row->reversed_p = false;
12908 it.first_visible_x = 0; 12908 it.first_visible_x = 0;
12909 it.last_visible_x = WINDOW_PIXEL_WIDTH (w); 12909 it.last_visible_x = WINDOW_PIXEL_WIDTH (w);
12910 reseat_to_string (&it, NULL, f->desired_tool_bar_string, 0, 0, 0, -1); 12910 reseat_to_string (&it, NULL, f->desired_tool_bar_string,
12911 0, 0, 0, STRING_MULTIBYTE (f->desired_tool_bar_string));
12911 it.paragraph_embedding = L2R; 12912 it.paragraph_embedding = L2R;
12912 12913
12913 while (!ITERATOR_AT_END_P (&it)) 12914 while (!ITERATOR_AT_END_P (&it))
@@ -12994,7 +12995,8 @@ redisplay_tool_bar (struct frame *f)
12994 12995
12995 /* Build a string that represents the contents of the tool-bar. */ 12996 /* Build a string that represents the contents of the tool-bar. */
12996 build_desired_tool_bar_string (f); 12997 build_desired_tool_bar_string (f);
12997 reseat_to_string (&it, NULL, f->desired_tool_bar_string, 0, 0, 0, -1); 12998 reseat_to_string (&it, NULL, f->desired_tool_bar_string,
12999 0, 0, 0, STRING_MULTIBYTE (f->desired_tool_bar_string));
12998 /* FIXME: This should be controlled by a user option. But it 13000 /* FIXME: This should be controlled by a user option. But it
12999 doesn't make sense to have an R2L tool bar if the menu bar cannot 13001 doesn't make sense to have an R2L tool bar if the menu bar cannot
13000 be drawn also R2L, and making the menu bar R2L is tricky due 13002 be drawn also R2L, and making the menu bar R2L is tricky due
@@ -23531,7 +23533,7 @@ display_menu_bar (struct window *w)
23531 /* Display the item, pad with one space. */ 23533 /* Display the item, pad with one space. */
23532 if (it.current_x < it.last_visible_x) 23534 if (it.current_x < it.last_visible_x)
23533 display_string (NULL, string, Qnil, 0, 0, &it, 23535 display_string (NULL, string, Qnil, 0, 0, &it,
23534 SCHARS (string) + 1, 0, 0, -1); 23536 SCHARS (string) + 1, 0, 0, STRING_MULTIBYTE (string));
23535 } 23537 }
23536 23538
23537 /* Fill out the line with spaces. */ 23539 /* Fill out the line with spaces. */
diff --git a/src/xwidget.c b/src/xwidget.c
index 121510ebac0..ecb37936293 100644
--- a/src/xwidget.c
+++ b/src/xwidget.c
@@ -31,14 +31,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
31#include <webkit2/webkit2.h> 31#include <webkit2/webkit2.h>
32#include <JavaScriptCore/JavaScript.h> 32#include <JavaScriptCore/JavaScript.h>
33 33
34/* Suppress GCC deprecation warnings starting in WebKitGTK+ 2.21.1 for
35 webkit_javascript_result_get_global_context and
36 webkit_javascript_result_get_value (Bug#33679).
37 FIXME: Use the JavaScriptCore GLib API instead, and remove this hack. */
38#if WEBKIT_CHECK_VERSION (2, 21, 1) && GNUC_PREREQ (4, 2, 0)
39# pragma GCC diagnostic ignored "-Wdeprecated-declarations"
40#endif
41
42static struct xwidget * 34static struct xwidget *
43allocate_xwidget (void) 35allocate_xwidget (void)
44{ 36{
@@ -284,95 +276,70 @@ webkit_view_load_changed_cb (WebKitWebView *webkitwebview,
284 276
285/* Recursively convert a JavaScript value to a Lisp value. */ 277/* Recursively convert a JavaScript value to a Lisp value. */
286static Lisp_Object 278static Lisp_Object
287webkit_js_to_lisp (JSContextRef context, JSValueRef value) 279webkit_js_to_lisp (JSCValue *value)
288{ 280{
289 switch (JSValueGetType (context, value)) 281 if (jsc_value_is_string (value))
290 { 282 {
291 case kJSTypeString: 283 gchar *str_value = jsc_value_to_string (value);
292 { 284 Lisp_Object ret = build_string (str_value);
293 JSStringRef js_str_value; 285 g_free (str_value);
294 gchar *str_value; 286
295 gsize str_length; 287 return ret;
296 288 }
297 js_str_value = JSValueToStringCopy (context, value, NULL); 289 else if (jsc_value_is_boolean (value))
298 str_length = JSStringGetMaximumUTF8CStringSize (js_str_value); 290 {
299 str_value = (gchar *)g_malloc (str_length); 291 return (jsc_value_to_boolean (value)) ? Qt : Qnil;
300 JSStringGetUTF8CString (js_str_value, str_value, str_length); 292 }
301 JSStringRelease (js_str_value); 293 else if (jsc_value_is_number (value))
302 return build_string (str_value); 294 {
303 } 295 return make_fixnum (jsc_value_to_int32 (value));
304 case kJSTypeBoolean: 296 }
305 return (JSValueToBoolean (context, value)) ? Qt : Qnil; 297 else if (jsc_value_is_array (value))
306 case kJSTypeNumber: 298 {
307 return make_fixnum (JSValueToNumber (context, value, NULL)); 299 JSCValue *len = jsc_value_object_get_property (value, "length");
308 case kJSTypeObject: 300 const gint32 dlen = jsc_value_to_int32 (len);
309 { 301
310 if (JSValueIsArray (context, value)) 302 Lisp_Object obj;
311 { 303 if (! (0 <= dlen && dlen < PTRDIFF_MAX + 1.0))
312 JSStringRef pname = JSStringCreateWithUTF8CString("length"); 304 memory_full (SIZE_MAX);
313 JSValueRef len = JSObjectGetProperty (context, (JSObjectRef) value, 305
314 pname, NULL); 306 ptrdiff_t n = dlen;
315 double dlen = JSValueToNumber (context, len, NULL); 307 struct Lisp_Vector *p = allocate_vector (n);
316 JSStringRelease(pname); 308
317 309 for (ptrdiff_t i = 0; i < n; ++i)
318 Lisp_Object obj; 310 {
319 if (! (0 <= dlen && dlen < PTRDIFF_MAX + 1.0)) 311 p->contents[i] =
320 memory_full (SIZE_MAX); 312 webkit_js_to_lisp (jsc_value_object_get_property_at_index (value, i));
321 ptrdiff_t n = dlen; 313 }
322 struct Lisp_Vector *p = allocate_vector (n); 314 XSETVECTOR (obj, p);
323 315 return obj;
324 for (ptrdiff_t i = 0; i < n; ++i) 316 }
325 { 317 else if (jsc_value_is_object (value))
326 p->contents[i] = 318 {
327 webkit_js_to_lisp (context, 319 char **properties_names = jsc_value_object_enumerate_properties (value);
328 JSObjectGetPropertyAtIndex (context, 320 guint n = g_strv_length (properties_names);
329 (JSObjectRef) value, 321
330 i, NULL)); 322 Lisp_Object obj;
331 } 323 if (PTRDIFF_MAX < n)
332 XSETVECTOR (obj, p); 324 memory_full (n);
333 return obj; 325 struct Lisp_Vector *p = allocate_vector (n);
334 } 326
335 else 327 for (ptrdiff_t i = 0; i < n; ++i)
336 { 328 {
337 JSPropertyNameArrayRef properties = 329 const char *name = properties_names[i];
338 JSObjectCopyPropertyNames (context, (JSObjectRef) value); 330 JSCValue *property = jsc_value_object_get_property (value, name);
339 331
340 size_t n = JSPropertyNameArrayGetCount (properties); 332 p->contents[i] =
341 Lisp_Object obj; 333 Fcons (build_string (name), webkit_js_to_lisp (property));
342 334 }
343 /* TODO: can we use a regular list here? */ 335
344 if (PTRDIFF_MAX < n) 336 g_strfreev (properties_names);
345 memory_full (n); 337
346 struct Lisp_Vector *p = allocate_vector (n); 338 XSETVECTOR (obj, p);
347 339 return obj;
348 for (ptrdiff_t i = 0; i < n; ++i)
349 {
350 JSStringRef name = JSPropertyNameArrayGetNameAtIndex (properties, i);
351 JSValueRef property = JSObjectGetProperty (context,
352 (JSObjectRef) value,
353 name, NULL);
354 gchar *str_name;
355 gsize str_length;
356 str_length = JSStringGetMaximumUTF8CStringSize (name);
357 str_name = (gchar *)g_malloc (str_length);
358 JSStringGetUTF8CString (name, str_name, str_length);
359 JSStringRelease (name);
360
361 p->contents[i] =
362 Fcons (build_string (str_name),
363 webkit_js_to_lisp (context, property));
364 }
365
366 JSPropertyNameArrayRelease (properties);
367 XSETVECTOR (obj, p);
368 return obj;
369 }
370 }
371 case kJSTypeUndefined:
372 case kJSTypeNull:
373 default:
374 return Qnil;
375 } 340 }
341
342 return Qnil;
376} 343}
377 344
378static void 345static void
@@ -380,41 +347,39 @@ webkit_javascript_finished_cb (GObject *webview,
380 GAsyncResult *result, 347 GAsyncResult *result,
381 gpointer arg) 348 gpointer arg)
382{ 349{
383 WebKitJavascriptResult *js_result; 350 GError *error = NULL;
384 JSValueRef value; 351 struct xwidget *xw = g_object_get_data (G_OBJECT (webview), XG_XWIDGET);
385 JSGlobalContextRef context;
386 GError *error = NULL;
387 struct xwidget *xw = g_object_get_data (G_OBJECT (webview),
388 XG_XWIDGET);
389 ptrdiff_t script_idx = (intptr_t) arg;
390 Lisp_Object script_callback = AREF (xw->script_callbacks, script_idx);
391 ASET (xw->script_callbacks, script_idx, Qnil);
392 if (!NILP (script_callback))
393 xfree (xmint_pointer (XCAR (script_callback)));
394
395 js_result = webkit_web_view_run_javascript_finish
396 (WEBKIT_WEB_VIEW (webview), result, &error);
397
398 if (!js_result)
399 {
400 g_warning ("Error running javascript: %s", error->message);
401 g_error_free (error);
402 return;
403 }
404 352
405 if (!NILP (script_callback) && !NILP (XCDR (script_callback))) 353 ptrdiff_t script_idx = (intptr_t) arg;
406 { 354 Lisp_Object script_callback = AREF (xw->script_callbacks, script_idx);
407 context = webkit_javascript_result_get_global_context (js_result); 355 ASET (xw->script_callbacks, script_idx, Qnil);
408 value = webkit_javascript_result_get_value (js_result); 356 if (!NILP (script_callback))
409 Lisp_Object lisp_value = webkit_js_to_lisp (context, value); 357 xfree (xmint_pointer (XCAR (script_callback)));
410 358
411 /* Register an xwidget event here, which then runs the callback. 359 WebKitJavascriptResult *js_result =
412 This ensures that the callback runs in sync with the Emacs 360 webkit_web_view_run_javascript_finish
413 event loop. */ 361 (WEBKIT_WEB_VIEW (webview), result, &error);
414 store_xwidget_js_callback_event (xw, XCDR (script_callback), lisp_value); 362
415 } 363 if (!js_result)
364 {
365 g_warning ("Error running javascript: %s", error->message);
366 g_error_free (error);
367 return;
368 }
369
370 if (!NILP (script_callback) && !NILP (XCDR (script_callback)))
371 {
372 JSCValue *value = webkit_javascript_result_get_js_value (js_result);
373
374 Lisp_Object lisp_value = webkit_js_to_lisp (value);
375
376 /* Register an xwidget event here, which then runs the callback.
377 This ensures that the callback runs in sync with the Emacs
378 event loop. */
379 store_xwidget_js_callback_event (xw, XCDR (script_callback), lisp_value);
380 }
416 381
417 webkit_javascript_result_unref (js_result); 382 webkit_javascript_result_unref (js_result);
418} 383}
419 384
420 385
generated by cgit v1.2.1 (git 2.18.0) at 2026-01-13 04:16:58 +0000