commit 6b40dbda6ad6d677c69263785ff4db7010840b6e (HEAD, refs/remotes/origin/master) Author: Paul Eggert Date: Sat Feb 1 22:20:04 2025 -0800 Improve format-seconds on negative args * lisp/calendar/time-date.el (format-seconds): Work better with negative seconds (Bug#75849). * test/lisp/calendar/time-date-tests.el (test-format-seconds): Test it. diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index 09b4cfb0edf..1d792952f98 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -305,7 +305,7 @@ right of \"%x\", trailing zero units are not output." ("x"))) (case-fold-search t) spec match usedunits zeroflag larger prev name unit num - leading-zeropos trailing-zeropos fraction + leading-zeropos trailing-zeropos fraction minus chop-leading chop-trailing) (while (string-match "%\\.?[0-9]*\\(,[0-9]\\)?\\(.\\)" string start) (setq start (match-end 0) @@ -327,8 +327,11 @@ right of \"%x\", trailing zero units are not output." (error "Units are not in decreasing order of size")) (unless (numberp seconds) (setq seconds (float-time seconds))) - (setq fraction (mod seconds 1) - seconds (round seconds)) + (setq minus (when (< seconds 0) "-") ; Treat -0.0 like 0.0. + seconds (abs seconds) + seconds (let ((s (floor seconds))) + (setq fraction (- seconds s)) + s)) (dolist (u units) (setq spec (car u) name (cadr u) @@ -392,8 +395,8 @@ right of \"%x\", trailing zero units are not output." ;; string in full. (when (equal string "") (setq string pre))) - (setq string (replace-regexp-in-string "%[zx]" "" string))) - (string-trim (string-replace "%%" "%" string))) + (setq string (replace-regexp-in-string "%[zx]" "" string)) + (concat minus (string-trim (string-replace "%%" "%" string))))) (defvar seconds-to-string (list (list 1 "ms" 0.001) diff --git a/test/lisp/calendar/time-date-tests.el b/test/lisp/calendar/time-date-tests.el index 3a69a0c7b18..b8d3381528e 100644 --- a/test/lisp/calendar/time-date-tests.el +++ b/test/lisp/calendar/time-date-tests.el @@ -106,24 +106,31 @@ (should-error (date-days-in-month 2020 'foo))) (ert-deftest test-format-seconds () - (should (equal (format-seconds "%y %d %h %m %s %%" 0) "0 0 0 0 0 %")) - (should (equal (format-seconds "%y %d %h %m %s %%" 9999999) "0 115 17 46 39 %")) - (should (equal (format-seconds "%y %d %h %m %z %s %%" 1) "1 %")) - (should (equal (format-seconds "%mm %ss" 66) "1m 6s")) - (should (equal (format-seconds "%mm %5ss" 66) "1m 6s")) - (should (equal (format-seconds "%mm %.5ss" 66.4) "1m 00006s")) - - (should (equal (format-seconds "%mm %,1ss" 66.4) "1m 6.4s")) - (should (equal (format-seconds "%mm %5,1ss" 66.4) "1m 6.4s")) - (should (equal (format-seconds "%mm %.5,1ss" 66.4) "1m 006.4s")) - - (should (equal (format-seconds "%hh %z%x%mm %ss" (* 60 2)) "2m")) - (should (equal (format-seconds "%hh %z%mm %ss" (* 60 2)) "2m 0s")) - (should (equal (format-seconds "%hh %x%mm %ss" (* 60 2)) "0h 2m")) - (should (equal (format-seconds "%hh %x%mm %ss" 0) "0h 0m 0s")) - ;; Bug#70322 - (should (equal (format-seconds "%y %z%d %h %m %s %%" 9999999) "115 17 46 39 %")) - (should (equal (format-seconds "%Y, %D, %H, %M, %z%S" 0) "0 seconds"))) + (let ((format-seconds-list + '(("%y %d %h %m %s %%" 0 "0 0 0 0 0 %") + ("%y %d %h %m %s %%" 0 "0 0 0 0 0 %") + ("%y %d %h %m %s %%" 9999999 "0 115 17 46 39 %") + ("%y %d %h %m %z %s %%" 1 "1 %") + ("%mm %ss" 66 "1m 6s") + ("%mm %5ss" 66 "1m 6s") + ("%mm %.5ss" 66.4 "1m 00006s") + ("%mm %,1ss" 66.4 "1m 6.4s") + ("%mm %5,1ss" 66.4 "1m 6.4s") + ("%mm %.5,1ss" 66.4 "1m 006.4s") + ("%hh %z%x%mm %ss" 120 "2m") + ("%hh %z%mm %ss" 120 "2m 0s") + ("%hh %x%mm %ss" 120 "0h 2m") + ("%hh %x%mm %ss" 0 "0h 0m 0s") + ("%y %z%d %h %m %s %%" 9999999 "115 17 46 39 %") + ("%Y, %D, %H, %M, %z%S" 0 "0 seconds")))) + (dolist (fs format-seconds-list) + (let ((string (nth 0 fs)) + (seconds (nth 1 fs)) + (expected (nth 2 fs))) + (should (equal (format-seconds string seconds) expected)) + (when (< 0 seconds) + (should (equal (format-seconds string (- seconds)) + (concat "-" expected)))))))) (ert-deftest test-ordinal () (should (equal (date-ordinal-to-time 2008 271) commit 7ac05c33b182ce3f3bd26b730a9c87ad4ec8cdd5 Author: Paul Eggert Date: Sat Feb 1 22:20:04 2025 -0800 Improve malloc Lisp alignment commentary Prompted by a private email from Pip Cet. diff --git a/src/alloc.c b/src/alloc.c index c39459e1f2e..7fa05e54202 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -608,23 +608,28 @@ buffer_memory_full (ptrdiff_t nbytes) #define COMMON_MULTIPLE(a, b) \ ((a) % (b) == 0 ? (a) : (b) % (a) == 0 ? (b) : (a) * (b)) -/* Alignment needed for memory blocks that are allocated via malloc - and that contain Lisp objects. */ +/* Alignment needed for memory blocks managed by the garbage collector. */ enum { LISP_ALIGNMENT = alignof (union { union emacs_align_type x; GCALIGNED_UNION_MEMBER }) }; static_assert (LISP_ALIGNMENT % GCALIGNMENT == 0); -/* Verify Emacs's assumption that malloc (N) returns storage suitably - aligned for Lisp objects whenever N is a multiple of LISP_ALIGNMENT. - This assumption holds for current Emacs porting targets; - if the assumption fails on a new platform, this check should - cause compilation to fail and some porting work will need to be done. - - In practice the assumption holds when alignof (max_align_t) is also a - multiple of LISP_ALIGNMENT. This works even for buggy platforms - like MinGW circa 2020, where alignof (max_align_t) is 16 even though - the malloc alignment is only 8, and where Emacs still works because - it never does anything that requires an alignment of 16. */ +/* Emacs assumes that malloc (N) returns storage suitably aligned for + any Lisp object whenever N is a multiple of LISP_ALIGNMENT. + This Emacs assumption holds for current Emacs porting targets. + + On all current Emacs porting targets, it also happens that + alignof (max_align_t) is a multiple of LISP_ALIGNMENT. + Check this with a static_assert. If the static_assert fails on an + unusual platform, Emacs may well not work, so inspect this module's + source code carefully with the unusual platform's quirks in mind. + + In practice the static_assert works even for buggy platforms where + malloc can yield an unaligned address if given a large but unaligned + size; Emacs avoids the bug because it aligns the size before calling + malloc. The static_assert also works for MinGW circa 2020, where + alignof (max_align_t) is 16 even though the malloc alignment is only 8; + Emacs avoids the bug because on this platform it never does anything + that requires an alignment of 16. */ enum { MALLOC_IS_LISP_ALIGNED = alignof (max_align_t) % LISP_ALIGNMENT == 0 }; static_assert (MALLOC_IS_LISP_ALIGNED); @@ -900,7 +905,8 @@ void *lisp_malloc_loser EXTERNALLY_VISIBLE; #endif /* Allocate memory for Lisp data. - NBYTES is the number of bytes to allocate; it must be Lisp-aligned. + NBYTES is the number of bytes to allocate; + it must be a multiple of LISP_ALIGNMENT. If CLEARIT, arrange for the allocated memory to be cleared by using calloc, which can be faster than malloc+memset. TYPE describes the intended use of the allocated memory block diff --git a/src/lisp.h b/src/lisp.h index 5595038f7c7..6aea51f8322 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -257,7 +257,7 @@ DEFINE_GDB_SYMBOL_END (VALMASK) # define alignas(a) #endif -/* Minimum alignment requirement for Lisp objects, imposed by the +/* The minimum alignment requirement for Lisp objects that is imposed by the internal representation of tagged pointers. It is 2**GCTYPEBITS if USE_LSB_TAG, 1 otherwise. It must be a literal integer constant, for older versions of GCC (through at least 4.9). */ commit 354b2907fce6a4ce9f5e8ea0faf69974e21e749b Author: Eli Zaretskii Date: Sun Feb 2 08:23:02 2025 +0200 Fix mouse pointer inside mouse-face on text with 'pointer' property * src/dispnew.c (gui_update_window_end): Don't consider mouse face overwritten. * src/xdisp.c (show_mouse_face): Accept an additional argument; redefine the mouse cursor only if that argument is 'true'. All callers changed. (Bug#75931) diff --git a/src/dispnew.c b/src/dispnew.c index c062ea42f3d..5f5575d484b 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -4597,9 +4597,6 @@ gui_update_window_end (struct window *w, bool cursor_on_p, w->output_cursor.hpos, w->output_cursor.vpos, w->output_cursor.x, w->output_cursor.y); - if (cursor_in_mouse_face_p (w) && cursor_on_p) - mouse_face_overwritten_p = 1; - if (draw_window_fringes (w, true)) { if (WINDOW_RIGHT_DIVIDER_WIDTH (w)) diff --git a/src/xdisp.c b/src/xdisp.c index 0b8dbf514c1..36e82f873ab 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -1229,7 +1229,7 @@ static void get_cursor_offset_for_mouse_face (struct window *w, static void produce_special_glyphs (struct it *, enum display_element_type); static void pad_mode_line (struct it *, bool); -static void show_mouse_face (Mouse_HLInfo *, enum draw_glyphs_face); +static void show_mouse_face (Mouse_HLInfo *, enum draw_glyphs_face, bool); static bool coords_in_mouse_face_p (struct window *, int, int); static void reset_box_start_end_flags (struct it *); @@ -15052,14 +15052,14 @@ handle_tab_bar_click (struct frame *f, int x, int y, bool down_p, { /* Show the clicked button in pressed state. */ if (!NILP (Vmouse_highlight)) - show_mouse_face (hlinfo, DRAW_IMAGE_SUNKEN); + show_mouse_face (hlinfo, DRAW_IMAGE_SUNKEN, true); f->last_tab_bar_item = prop_idx; /* record the pressed tab */ } else { /* Show item in released state. */ if (!NILP (Vmouse_highlight)) - show_mouse_face (hlinfo, DRAW_IMAGE_RAISED); + show_mouse_face (hlinfo, DRAW_IMAGE_RAISED, true); f->last_tab_bar_item = -1; } @@ -15157,7 +15157,7 @@ note_tab_bar_highlight (struct frame *f, int x, int y) hlinfo->mouse_face_face_id = TAB_BAR_FACE_ID; /* Display it as active. */ - show_mouse_face (hlinfo, draw); + show_mouse_face (hlinfo, draw, true); } set_help_echo: @@ -16074,7 +16074,7 @@ handle_tool_bar_click_with_device (struct frame *f, int x, int y, bool down_p, { /* Show item in pressed state. */ if (!NILP (Vmouse_highlight)) - show_mouse_face (hlinfo, DRAW_IMAGE_SUNKEN); + show_mouse_face (hlinfo, DRAW_IMAGE_SUNKEN, true); f->last_tool_bar_item = prop_idx; } else @@ -16085,7 +16085,7 @@ handle_tool_bar_click_with_device (struct frame *f, int x, int y, bool down_p, /* Show item in released state. */ if (!NILP (Vmouse_highlight)) - show_mouse_face (hlinfo, DRAW_IMAGE_RAISED); + show_mouse_face (hlinfo, DRAW_IMAGE_RAISED, true); key = AREF (f->tool_bar_items, prop_idx + TOOL_BAR_ITEM_KEY); @@ -16181,7 +16181,7 @@ note_tool_bar_highlight (struct frame *f, int x, int y) hlinfo->mouse_face_face_id = TOOL_BAR_FACE_ID; /* Display it as active. */ - show_mouse_face (hlinfo, draw); + show_mouse_face (hlinfo, draw, true); } set_help_echo: @@ -34196,12 +34196,13 @@ erase_phys_cursor (struct window *w) /* Since erasing the phys cursor will probably lead to corruption of the mouse face display if the glyph's pixel_width is not kept up to date with the :box property of the mouse face, just redraw the - mouse face. */ + mouse face, but leave the mouse cursor as it was. */ if (FRAME_WINDOW_P (WINDOW_XFRAME (w)) && mouse_face_here_p) { w->phys_cursor_on_p = false; w->phys_cursor_type = NO_CURSOR; - show_mouse_face (MOUSE_HL_INFO (WINDOW_XFRAME (w)), DRAW_MOUSE_FACE); + show_mouse_face (MOUSE_HL_INFO (WINDOW_XFRAME (w)), DRAW_MOUSE_FACE, + false); return; } #endif @@ -34462,7 +34463,8 @@ draw_row_with_mouse_face (struct window *w, int start_x, struct glyph_row *row, /* Display the active region described by mouse_face_* according to DRAW. */ static void -show_mouse_face (Mouse_HLInfo *hlinfo, enum draw_glyphs_face draw) +show_mouse_face (Mouse_HLInfo *hlinfo, enum draw_glyphs_face draw, + bool define_mouse_cursor) { /* Don't bother doing anything if the mouse-face window is not set up. */ @@ -34604,7 +34606,7 @@ show_mouse_face (Mouse_HLInfo *hlinfo, enum draw_glyphs_face draw) #ifdef HAVE_WINDOW_SYSTEM /* Change the mouse cursor. */ - if (FRAME_WINDOW_P (f) && NILP (track_mouse)) + if (FRAME_WINDOW_P (f) && NILP (track_mouse) && define_mouse_cursor) { if (draw == DRAW_NORMAL_TEXT #ifndef HAVE_EXT_TOOL_BAR @@ -34612,8 +34614,7 @@ show_mouse_face (Mouse_HLInfo *hlinfo, enum draw_glyphs_face draw) #endif && !EQ (hlinfo->mouse_face_window, f->tab_bar_window)) FRAME_RIF (f)->define_frame_cursor (f, FRAME_OUTPUT_DATA (f)->text_cursor); - else - if (draw == DRAW_MOUSE_FACE) + else if (draw == DRAW_MOUSE_FACE) FRAME_RIF (f)->define_frame_cursor (f, FRAME_OUTPUT_DATA (f)->hand_cursor); else FRAME_RIF (f)->define_frame_cursor (f, FRAME_OUTPUT_DATA (f)->nontext_cursor); @@ -34632,7 +34633,7 @@ clear_mouse_face (Mouse_HLInfo *hlinfo) bool cleared = !hlinfo->mouse_face_hidden && !NILP (hlinfo->mouse_face_window); if (cleared) - show_mouse_face (hlinfo, DRAW_NORMAL_TEXT); + show_mouse_face (hlinfo, DRAW_NORMAL_TEXT, true); hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1; hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; hlinfo->mouse_face_window = Qnil; @@ -35199,7 +35200,7 @@ mouse_face_from_buffer_pos (Lisp_Object window, = face_at_buffer_position (w, mouse_charpos, &ignore, mouse_charpos + 1, !hlinfo->mouse_face_hidden, -1, 0); - show_mouse_face (hlinfo, DRAW_MOUSE_FACE); + show_mouse_face (hlinfo, DRAW_MOUSE_FACE, true); } /* The following function is not used anymore (replaced with @@ -35909,7 +35910,7 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y, face_at_string_position (w, string, charpos, 0, &ignore, glyph->face_id, true, 0); - show_mouse_face (hlinfo, DRAW_MOUSE_FACE); + show_mouse_face (hlinfo, DRAW_MOUSE_FACE, true); mouse_face_shown = true; if (NILP (pointer)) @@ -36448,7 +36449,7 @@ note_mouse_highlight (struct frame *f, int x, int y) hlinfo->mouse_face_face_id = face_at_string_position (w, object, pos, 0, &ignore, glyph->face_id, true, 0); - show_mouse_face (hlinfo, DRAW_MOUSE_FACE); + show_mouse_face (hlinfo, DRAW_MOUSE_FACE, true); cursor = No_Cursor; } else commit 42f1318e6579f94b90ef101f3f03ca65fb229262 Author: Gerd Möllmann Date: Sun Feb 2 05:39:47 2025 +0100 Fix hiding tty cursor for overlapping children * src/dispnew.c (is_cursor_obscured): If selected frame is in the z-order of the root frame, use that, otherwise use the root frame. diff --git a/src/dispnew.c b/src/dispnew.c index 35c8d347616..c062ea42f3d 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -3909,10 +3909,12 @@ frame_selected_window_frame (struct frame *f) static bool is_cursor_obscured (struct frame *root) { - /* Determine in which frame on ROOT the cursor could be. */ - struct frame *sf = frame_selected_window_frame (root); - if (sf == NULL) - return false; + /* Which frame contains the cursor? If the selected frame is in + root's z-order, it's the selected frame. Otherwise fall back to + the root itself. */ + struct frame *sf = (frame_ancestor_p (root, SELECTED_FRAME ()) + ? SELECTED_FRAME () + : root); /* Give up if we can't tell where the cursor currently is. */ int x, y; commit c91c591f0f0cc774647c32bdcf05bb3a9551e340 Author: Paul Eggert Date: Sat Feb 1 14:09:06 2025 -0800 Omit 2 ‘volatile’s in internal_lisp_condition_case * src/eval.c (internal_lisp_condition_case): Omit an unnecessary ‘volatile’ and an unnecessary pointer-to-volatile local var. Perhaps these were needed in previous versions of Emacs, or to pacify older versions of GCC when using --enable-gcc-warnings, but they are not needed to pacify current GCC. diff --git a/src/eval.c b/src/eval.c index 666d49f03fe..70f533842b9 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1478,7 +1478,7 @@ Lisp_Object internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform, Lisp_Object handlers) { - struct handler *volatile oldhandlerlist = handlerlist; + struct handler *oldhandlerlist = handlerlist; /* The number of non-success handlers, plus 1 for a sentinel. */ ptrdiff_t clausenb = 1; @@ -1543,12 +1543,11 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform, if (!CONSP (condition)) condition = list1 (condition); struct handler *c = push_handler (condition, CONDITION_CASE); - Lisp_Object volatile *clauses_volatile = clauses; if (sys_setjmp (c->jmp)) { var = var_volatile; val = handlerlist->val; - Lisp_Object volatile *chosen_clause = clauses_volatile; + Lisp_Object volatile *chosen_clause = clauses; struct handler *oldh = oldhandlerlist; for (struct handler *h = handlerlist->next; h != oldh; h = h->next) chosen_clause++; commit 3ae7c9069fa9320ce2cff5b421dc8d9d4c4b8430 Author: Eli Zaretskii Date: Sat Feb 1 22:08:38 2025 +0200 ; Fix last change. diff --git a/lisp/savehist.el b/lisp/savehist.el index 7d755bc5047..7cfb358dd6d 100644 --- a/lisp/savehist.el +++ b/lisp/savehist.el @@ -104,6 +104,8 @@ the user's privacy." (cancel-timer savehist-timer)) (setq savehist-timer nil)) +(defvar savehist-autosave-interval) + (defun savehist--manage-timer () "Set or cancel an invocation of `savehist-autosave' on a timer. If `savehist-mode' is enabled, set the timer, otherwise cancel the timer. commit c7889d0545d5e684fc5cec5d50e249ab9c24da44 Author: shipmints Date: Sat Jan 25 13:12:56 2025 -0500 Add missing custom :set to 'savehist-autosave-interval' * lisp/savehist.el (savehist-autosave-interval): Correctly reset 'savehist-timer' when 'savehist-autosave-interval' changes via setopt or a Customize command. (Bug#75834) diff --git a/lisp/savehist.el b/lisp/savehist.el index 153e2db8706..7d755bc5047 100644 --- a/lisp/savehist.el +++ b/lisp/savehist.el @@ -96,11 +96,37 @@ the user's privacy." :type '(choice (natnum :tag "Specify") (const :tag "Use default" :value nil))) +(defvar savehist-timer nil) + +(defun savehist--cancel-timer () + "Cancel `savehist-autosave' timer, if set." + (when (timerp savehist-timer) + (cancel-timer savehist-timer)) + (setq savehist-timer nil)) + +(defun savehist--manage-timer () + "Set or cancel an invocation of `savehist-autosave' on a timer. +If `savehist-mode' is enabled, set the timer, otherwise cancel the timer. +This should not cause noticeable delays for users -- `savehist-autosave' +executes in under 5 ms on my system." + (if (and savehist-mode + savehist-autosave-interval + (null savehist-timer)) + (setq savehist-timer + (run-with-timer savehist-autosave-interval + savehist-autosave-interval #'savehist-autosave)) + (savehist--cancel-timer))) + (defcustom savehist-autosave-interval (* 5 60) "The interval between autosaves of minibuffer history. -If set to nil, disables timer-based autosaving." +If set to nil, disables timer-based autosaving. +Use `setopt' or Customize commands to set this option." :type '(choice (const :tag "Disabled" nil) - (integer :tag "Seconds"))) + (integer :tag "Seconds")) + :set (lambda (sym val) + (set-default sym val) + (savehist--cancel-timer) + (savehist--manage-timer))) (defcustom savehist-mode-hook nil "Hook called when Savehist mode is turned on." @@ -122,8 +148,6 @@ unwise, unless you know what you are doing.") ;; Internal variables. -(defvar savehist-timer nil) - (defvar savehist-last-checksum nil) (defvar savehist-minibuffer-history-variables nil @@ -197,23 +221,14 @@ Installs `savehist-autosave' in `kill-emacs-hook' and on a timer. To undo this, call `savehist-uninstall'." (add-hook 'minibuffer-setup-hook #'savehist-minibuffer-hook) (add-hook 'kill-emacs-hook #'savehist-autosave) - ;; Install an invocation of savehist-autosave on a timer. This - ;; should not cause noticeable delays for users -- savehist-autosave - ;; executes in under 5 ms on my system. - (when (and savehist-autosave-interval - (null savehist-timer)) - (setq savehist-timer - (run-with-timer savehist-autosave-interval - savehist-autosave-interval #'savehist-autosave)))) + (savehist--manage-timer)) (defun savehist-uninstall () "Undo installing savehist. Normally invoked by calling `savehist-mode' to unset the minor mode." (remove-hook 'minibuffer-setup-hook #'savehist-minibuffer-hook) (remove-hook 'kill-emacs-hook #'savehist-autosave) - (when savehist-timer - (cancel-timer savehist-timer) - (setq savehist-timer nil))) + (savehist--manage-timer)) (defvar savehist--has-given-file-warning nil) (defun savehist-save (&optional auto-save) commit 1292b64216f636bacea7fedf578b373f03affdd8 Author: shipmints Date: Sat Jan 25 14:04:51 2025 -0500 Add auto save timer to save-place (bug#75837) * lisp/saveplace.el (save-place-autosave-interval): New user option 'save-place-autosave-interval' which defaults to nil, and has a custom :set to manage the timer. Add 'save-place--manage-timer' to enable or cancel the timer if the mode is enabled and 'save-place-autosave-interval' is non-nil. Amend 'save-place-mode' to invoke save-place--manage-timer. Add 'save-place--cancel-timer'. Add 'save-place--autosave'. diff --git a/etc/NEWS b/etc/NEWS index 93e2d0ebc65..259b6e03549 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -465,6 +465,25 @@ This user option controls the width of the type column on the bookmark menu 'bookmark-bmenu-list'. The default value is 8 which is backwards compatible. +** Saveplace + +--- +*** You can now regularly auto-save places. +Customize 'save-place-autosave-interval' to the number of seconds +between auto saving places. For example, to save places every 5 +minutes: + + M-x customize-option RET save-place-autosave-interval RET and set to + 300 seconds. + +Or in elisp: + + (setopt save-place-autosave-interval (* 60 5)) + +If 'save-place-autosave-interval' is nil, auto saving is disabled; this +is the default. As before, saved places are scheduled to be saved at +Emacs exit. + ** Gnus --- diff --git a/lisp/saveplace.el b/lisp/saveplace.el index c2e68f39730..37b657073cc 100644 --- a/lisp/saveplace.el +++ b/lisp/saveplace.el @@ -208,6 +208,45 @@ disabled, i.e., no files are excluded." (declare-function dired-current-directory "dired" (&optional localp)) +(defvar save-place--autosave-timer nil) + +(defun save-place--cancel-timer () + "Cancel `save-place-autosave' timer, if set." + (when (timerp save-place--autosave-timer) + (cancel-timer save-place--autosave-timer)) + (setq save-place--autosave-timer nil)) + +(defvar save-place-autosave-interval) + +(defun save-place--manage-timer () + "Set or cancel an invocation of `save-place--autosave' on a timer. +If `save-place-mode' is enabled, set the timer, otherwise cancel the timer." + (if (and save-place-mode + save-place-autosave-interval + (null save-place--autosave-timer)) + (setq save-place--autosave-timer + (run-with-timer + save-place-autosave-interval + save-place-autosave-interval #'save-place--autosave)) + (save-place--cancel-timer))) + +(defcustom save-place-autosave-interval nil + "The interval between auto saves of buffer places. +If set to nil, disables timer-based auto saving. +Use `setopt' or Customize commands to set this option." + :type '(choice (const :tag "Disabled" nil) + (integer :tag "Seconds")) + :version "31.1" + :set (lambda (sym val) + (set-default sym val) + (save-place--cancel-timer) + (save-place--manage-timer))) + +(defun save-place--autosave () + "Called by `save-place--autosave-timer'." + (save-places-to-alist) + (save-place-alist-to-file)) + (defun save-place--setup-hooks (add) (cond (add @@ -235,7 +274,8 @@ This means when you visit a file, point goes to the last place where it was when you previously visited the same file." :global t :group 'save-place - (save-place--setup-hooks save-place-mode)) + (save-place--setup-hooks save-place-mode) + (save-place--manage-timer)) (make-variable-buffer-local 'save-place-mode) @@ -258,7 +298,8 @@ file: dired-subdir-alist (dired-current-directory)))) (message "Buffer `%s' not visiting a file or directory" (buffer-name)) - (save-place--setup-hooks save-place-mode))) + (save-place--setup-hooks save-place-mode) + (save-place--manage-timer))) (declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep)) commit c5731a74c73678de34ccbacf6977a0e55a239bc8 Author: Michael Albinus Date: Sat Feb 1 18:52:13 2025 +0100 Minor Tramp changes * doc/misc/tramp.texi (External methods): Precise remark on rsync speed. * lisp/net/tramp-cache.el (tramp-connection-properties): Add link to the Tramp manual in the docstring. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 9aad087c510..86ffba29744 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -1154,7 +1154,8 @@ command to transfer is similar to the @option{scp} method. @command{rsync} performs much better than @command{scp} when transferring files that exist on both hosts. However, this advantage -is lost if the file exists only on one side of the connection. +is lost if the file exists only on one side of the connection, during +the first file transfer. This method supports the @samp{-p} argument. diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 37c82e4922b..a5245deaf2b 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -98,8 +98,11 @@ Every entry has the form (REGEXP PROPERTY VALUE). The regexp matches remote file names. It can be nil. PROPERTY is a string, and VALUE the corresponding value. They are used, if there is no -matching entry for PROPERTY in `tramp-cache-data'. For more -details see the info pages." +matching entry for PROPERTY in `tramp-cache-data'. + +PROPERTY can also be a string representing a parameter in +`tramp-methods'. For more details see the Info node `(tramp) Predefined +connection information'." :group 'tramp :version "24.4" :type '(repeat (list (choice :tag "File Name regexp" regexp (const nil)) commit 3a86774ce55e9dc4dc6de01f6aca19fcaa41a5d3 Author: Jonas Bernoulli Date: Sat Feb 1 18:14:47 2025 +0100 Update to Transient v0.8.4-7-gabee7353 diff --git a/doc/misc/transient.texi b/doc/misc/transient.texi index fb8b6da145c..4740663e987 100644 --- a/doc/misc/transient.texi +++ b/doc/misc/transient.texi @@ -31,7 +31,7 @@ General Public License for more details. @finalout @titlepage @title Transient User and Developer Manual -@subtitle for version 0.8.3 +@subtitle for version 0.8.4 @author Jonas Bernoulli @page @vskip 0pt plus 1filll @@ -53,7 +53,7 @@ resource to get over that hurdle is Psionic K's interactive tutorial, available at @uref{https://github.com/positron-solutions/transient-showcase}. @noindent -This manual is for Transient version 0.8.3. +This manual is for Transient version 0.8.4. @insertcopying @end ifnottex @@ -93,6 +93,7 @@ Defining New Commands * Binding Suffix and Infix Commands:: * Defining Suffix and Infix Commands:: * Using Infix Arguments:: +* Using Prefix Scope:: * Current Suffix Command:: * Current Prefix Command:: * Transient State:: @@ -553,6 +554,48 @@ the level specified by @code{transient-default-level} are temporarily available anyway. @end table +@defun transient-set-default-level suffix level +This function sets the default level of the suffix COMMAND to LEVEL@. + +If a suffix command appears in multiple menus, it may make sense to +consistently change its level in all those menus at once. For +example, the @code{--gpg-sign} argument (which is implemented using the +command @code{magit:--gpg-sign}), is bound in all of Magit's menu which +create commits. Users who sometimes sign their commits would want +that argument to be available in all of these menus, while for users +who never sign it is just unnecessary noise in any menus. + +To always make @code{--gpg-sign} available, use: + +@lisp +(transient-set-default-level 'magit:--gpg-sign 1) +@end lisp + +To never make @code{--gpg-sign} available, use: + +@lisp +(transient-set-default-level 'magit:--gpg-sign 0) +@end lisp + +This sets the level in the suffix prototype object for this command. +Commands only have a suffix prototype if they were defined using one +of @code{transient-define-argument}, @code{transient-define-infix} and +@code{transient-define-suffix}. For all other commands this would signal +an error. (This is one of the reasons why package authors should +use one of these functions to define shared suffix commands, and +especially shared arguments.) + +If the user changes the level of a suffix in a particular menu, +using @kbd{C-x l} as shown above, then that obviously shadows the default. + +It is also possible to set the level of a suffix binding in a +particular menu, either when defining the menu using +@code{transient-define-prefix,} or later using @code{transient-insert-suffix}. If +such bindings specify a level, then that also overrides the default. +(Per-suffix default levels is a new feature, so you might encounter +this quite often.) +@end defun + @node Other Commands @section Other Commands @@ -1017,6 +1060,7 @@ signal an error. * Binding Suffix and Infix Commands:: * Defining Suffix and Infix Commands:: * Using Infix Arguments:: +* Using Prefix Scope:: * Current Suffix Command:: * Current Prefix Command:: * Transient State:: @@ -1323,6 +1367,13 @@ be replaced with an error. The boolean @code{:pad-keys} argument controls whether keys of all suffixes contained in a group are right padded, effectively aligning the descriptions. + +@item +If a keyword argument accepts a function as value, you an use a +@code{lambda} expression. As a special case, the @code{##} macro (which returns a +@code{lambda} expression and is implemented in the @code{llama} package) is also +supported. Inside group specifications, the use of @code{##} is not +supported anywhere but directly following a keyword symbol. @end itemize The @var{ELEMENT}s are either all subgroups, or all suffixes and strings. @@ -1446,6 +1497,12 @@ Finally, details can be specified using optional @var{KEYWORD}-@var{VALUE} pairs Each keyword has to be a keyword symbol, either @code{:class} or a keyword argument supported by the constructor of that class. @xref{Suffix Slots}. +If a keyword argument accepts a function as value, you an use a @code{lambda} +expression. As a special case, the @code{##} macro (which returns a @code{lambda} +expression and is implemented in the @code{llama} package) is also supported. +Inside suffix bindings, the use of @code{##} is not supported anywhere but +directly following a keyword symbol. + @node Defining Suffix and Infix Commands @section Defining Suffix and Infix Commands @@ -1568,6 +1625,55 @@ used if you need the objects (as opposed to just their values) and if the current command is not being invoked from @var{PREFIX}. @end defun +@node Using Prefix Scope +@section Using Prefix Scope + +Some transients have a sort of secondary value, called a scope. A +prefix's scope can be accessed using @code{transient-scope}; similar to how +its value can be accessed using @code{transient-args}. + +@defun transient-scope prefixes classes +This function returns the scope of the active or current transient +prefix command. + +If optional PREFIXES and CLASSES are both nil, return the scope of +the prefix currently being setup, making this variation useful, e.g., +in @code{:if*} predicates. If no prefix is being setup, but the current +command was invoked from some prefix, then return the scope of that. + +If PREFIXES is non-nil, it must be a prefix command or a list of such +commands. If CLASSES is non-nil, it must be a prefix class or a list +of such classes. When this function is called from the body or the +@code{interactive} form of a suffix command, PREFIXES and/or CLASSES should +be non-nil. If either is non-nil, try the following in order: + +@itemize +@item +If the current suffix command was invoked from a prefix, which +appears in PREFIXES, return the scope of that prefix. + +@item +If the current suffix command was invoked from a prefix, and its +class derives from one of the CLASSES, return the scope of that +prefix. + +@item +If a prefix is being setup and it appears in PREFIXES, return its +scope. + +@item +If a prefix is being setup and its class derives from one of the +CLASSES, return its scope. + +@item +Finally try to return the default scope of the first command in +PREFIXES@. This only works if that slot is set in the respective +class definition or using its `transient-init-scope' method. +@end itemize + +If no prefix matches, return nil. +@end defun + @node Current Suffix Command @section Current Suffix Command @@ -2458,8 +2564,9 @@ being initialized. This slot is still experimental. @code{transient-mode-line-format}. It should have the same type. @item -@code{column-width} is only respected inside @code{transient-columns} groups and -allows aligning columns across separate instances of that. +@code{column-widths} is only respected inside @code{transient-columns} groups and +allows aligning columns across separate instances of that. A list +of integers. @item @code{variable-pitch} controls whether alignment is done pixel-wise to @@ -2535,8 +2642,9 @@ Also see @ref{Suffix Classes}. @subheading Slots of @code{transient-child} This is the abstract superclass of @code{transient-suffix} and @code{transient-group}. -This is where the shared @code{if*} and @code{inapt-if*} slots (see @ref{Predicate Slots}) -and the @code{level} slot (see @ref{Enabling and Disabling Suffixes}) are defined. +This is where the shared @code{if*} and @code{inapt-if*} slots (see @ref{Predicate Slots}), +the @code{level} slot (see @ref{Enabling and Disabling Suffixes}), and the @code{advice} +and @code{advice*} slots (see @ref{Slots of @code{transient-suffix}}) are defined. @itemize @item @@ -2595,6 +2703,24 @@ for details. defining a command using @code{transient-define-suffix}. @end itemize +The following two slots are experimental. They can also be set for a +group, in which case they apply to all suffixes in that group, except +for suffixes that set the same slot to a non-nil value. + +@itemize +@item +@code{advice} A function used to advise the command. The advise is called +using @code{(apply advice command args)}, i.e., it behaves like an "around" +advice. + +@item +@code{advice*} A function used to advise the command. Unlike @code{advice}, this +advises not only the command body but also its @code{interactive} spec. If +both slots are non-nil, @code{advice} is used for the body and @code{advice*} is +used for the @code{interactive} form. When advising the @code{interactive} spec, +called using @code{(funcall advice #'advice-eval-interactive-spec spec)}. +@end itemize + @anchor{Slots of @code{transient-infix}} @subheading Slots of @code{transient-infix} diff --git a/lisp/transient.el b/lisp/transient.el index 24ab56e830b..610e5871ccc 100644 --- a/lisp/transient.el +++ b/lisp/transient.el @@ -5,7 +5,7 @@ ;; Author: Jonas Bernoulli ;; URL: https://github.com/magit/transient ;; Keywords: extensions -;; Version: 0.8.3 +;; Version: 0.8.4 ;; SPDX-License-Identifier: GPL-3.0-or-later @@ -32,7 +32,7 @@ ;;; Code: -(defconst transient-version "v0.8.3-2-gf0478b29-builtin") +(defconst transient-version "v0.8.4-7-gabee7353-builtin") (require 'cl-lib) (require 'eieio) @@ -281,6 +281,20 @@ number is positive, or hide the menu if it is negative." :format "\n %t: %v" :value -20))) +(defcustom transient-show-docstring-format "%s" + "How to display suffix docstrings. + +The command `transient-toggle-docstrings' toggles between showing suffix +descriptions as usual, and instead or additionally displaying the suffix +docstrings. The format specified here controls how that is done. %c is +the description and %s is the docstring. Use \"%-14c %s\" or similar to +display both. + +This command is not bound by default, see its docstring for instructions." + :package-version '(transient . "0.8.4") + :group 'transient + :type 'string) + (defcustom transient-read-with-initial-input nil "Whether to use the last history element as initial minibuffer input." :package-version '(transient . "0.2.0") @@ -709,7 +723,7 @@ the prototype is stored in the clone's `prototype' slot.") :documentation "The parent group object.") (level :initarg :level - :initform (symbol-value 'transient--default-child-level) + :initform nil :documentation "Enable if level of prefix is equal or greater.") (if :initarg :if @@ -779,7 +793,15 @@ the prototype is stored in the clone's `prototype' slot.") (inapt-if-not-derived :initarg :inapt-if-not-derived :initform nil - :documentation "Inapt if major-mode does not derive from value.")) + :documentation "Inapt if major-mode does not derive from value.") + (advice + :initarg :advice + :initform nil + :documentation "Advise applied to the command body.") + (advice* + :initarg :advice* + :initform nil + :documentation "Advise applied to the command body and interactive spec.")) "Abstract superclass for group and suffix classes. It is undefined which predicates are used if more than one `if*' @@ -1188,14 +1210,15 @@ commands are aliases for." (cond ((eq key :class) (setq class val)) ((or (symbolp val) - (and (listp val) (not (eq (car val) 'lambda)))) + (and (listp val) + (not (memq (car val) (list 'lambda (intern "")))))) (setq args (plist-put args key (macroexp-quote val)))) ((setq args (plist-put args key val)))))) (unless (or spec class (not (plist-get args :setup-children))) (message "WARNING: %s: When %s is used, %s must also be specified" 'transient-define-prefix :setup-children :class)) (list 'vector - (or level transient--default-child-level) + level (list 'quote (cond (class) ((cl-typep (car spec) @@ -1286,7 +1309,8 @@ commands are aliases for." ((guard (eq (car-safe val) '\,)) (use key (cadr val))) ((guard (or (symbolp val) - (and (listp val) (not (eq (car val) 'lambda))))) + (and (listp val) + (not (memq (car val) (list 'lambda (intern ""))))))) (use key (macroexp-quote val))) (_ (use key val))))) (when spec @@ -1295,7 +1319,7 @@ commands are aliases for." (shortarg (plist-get args :shortarg))) (use :key shortarg))) (list 'list - (or level transient--default-child-level) + level (macroexp-quote (or class 'transient-suffix)) (cons 'list args)))) @@ -1530,6 +1554,21 @@ See info node `(transient)Modifying Existing Transients'." (defun transient--nthcdr (n list) (nthcdr (if (< n 0) (- (length list) (abs n)) n) list)) +(defun transient-set-default-level (command level) + "Set the default level of suffix COMMAND to LEVEL. + +The default level is shadowed if the binding of the suffix in a +prefix menu specifies a level, and also if the user changes the +level of such a binding. + +The default level can only be set for commands that were defined +using `transient-define-suffix', `transient-define-infix' or +`transient-define-argument'." + (if-let ((proto (transient--suffix-prototype command))) + (oset proto level level) + (user-error "Cannot set level for `%s'; no prototype object exists" + command))) + ;;; Variables (defvar transient-current-prefix nil @@ -2216,7 +2255,8 @@ value. Otherwise return CHILDREN as is.") (string (list spec)))) (defun transient--init-group (levels spec parent) - (pcase-let ((`(,level ,class ,args ,children) (append spec nil))) + (pcase-let* ((`(,level ,class ,args ,children) (append spec nil)) + (level (or level transient--default-child-level))) (and-let* (((transient--use-level-p level)) (obj (apply class :parent parent :level level args)) ((transient--use-suffix-p obj)) @@ -2233,9 +2273,12 @@ value. Otherwise return CHILDREN as is.") (pcase-let* ((`(,level ,class ,args) spec) (cmd (plist-get args :command)) (key (transient--kbd (plist-get args :key))) + (proto (and cmd (transient--suffix-prototype cmd))) (level (or (alist-get (cons cmd key) levels nil nil #'equal) (alist-get cmd levels) - level))) + level + (and proto (oref proto level)) + transient--default-child-level))) (let ((fn (and (symbolp cmd) (symbol-function cmd)))) (when (autoloadp fn) @@ -2246,7 +2289,7 @@ value. Otherwise return CHILDREN as is.") (apply class :parent parent :level level args) (unless (and cmd (symbolp cmd)) (error "BUG: Non-symbolic suffix command: %s" cmd)) - (if-let* ((proto (and cmd (transient--suffix-prototype cmd)))) + (if proto (apply #'clone proto :level level args) (apply class :command cmd :parent parent :level level args))))) @@ -2436,6 +2479,8 @@ value. Otherwise return CHILDREN as is.") (setq transient--redisplay-map nil) (setq transient--redisplay-key nil) (setq transient--helpp nil) + (unless (eq transient--docsp 'permanent) + (setq transient--docsp nil)) (setq transient--editp nil) (setq transient--prefix nil) (setq transient--layout nil) @@ -2563,7 +2608,13 @@ value. Otherwise return CHILDREN as is.") (let ((abort t)) (unwind-protect (prog1 (let ((debugger #'transient--exit-and-debug)) - (advice-eval-interactive-spec spec)) + (if-let* ((obj (transient-suffix-object suffix)) + (grp (oref obj parent)) + (adv (or (oref obj advice*) + (oref grp advice*)))) + (funcall + adv #'advice-eval-interactive-spec spec) + (advice-eval-interactive-spec spec))) (setq abort nil)) (when abort (when-let* ((unwind (oref prefix unwind-suffix))) @@ -2573,7 +2624,14 @@ value. Otherwise return CHILDREN as is.") (oset prefix unwind-suffix nil)))))) (unwind-protect (let ((debugger #'transient--exit-and-debug)) - (apply fn args)) + (if-let* ((obj (transient-suffix-object suffix)) + (grp (oref obj parent)) + (adv (or (oref obj advice) + (oref grp advice) + (oref obj advice*) + (oref grp advice*)))) + (apply adv fn args) + (apply fn args))) (when-let* ((unwind (oref prefix unwind-suffix))) (transient--debug 'unwind-command) (funcall unwind suffix)) @@ -3212,12 +3270,21 @@ For example: (interactive) (setq transient-show-common-commands (not transient-show-common-commands))) -(transient-define-suffix transient-toggle-docstrings () +(transient-define-suffix transient-toggle-docstrings (&optional permanent) "Toggle whether to show docstrings instead of suffix descriptions. -To make this available in all menus, bind it in `transient-map'." + +By default this is only enabled temporarily for the current transient +menu invocation. With a prefix argument, enable this until explicitly +disabled again. + +Infix arguments are not affected by this, because otherwise many menus +would likely become unreadable. To make this command available in all +menus, bind it in `transient-map'. `transient-show-docstring-format' +controls how the docstrings are displayed and whether descriptions are +also displayed." :transient t - (interactive) - (setq transient--docsp (not transient--docsp))) + (interactive (list current-prefix-arg)) + (setq transient--docsp (if permanent 'permanent (not transient--docsp)))) (defun transient-toggle-debug () "Toggle debugging statements for transient commands." @@ -3789,37 +3856,48 @@ a default implementation, which is a noop.") ;;;; Get -(defun transient-scope (&optional prefixes) +(defun transient-scope (&optional prefixes classes) "Return the scope of the active or current transient prefix command. -If optional PREFIXES is nil, return the scope of the prefix currently -being setup, making this variant useful, e.g., in `:if*' predicates. -If no prefix is being setup, but the current command was invoked from -some prefix, then return the scope of that. - -When this function is called from the body or `interactive' form of a -suffix command, PREFIXES should be non-nil. +If optional PREFIXES and CLASSES are both nil, return the scope of +the prefix currently being setup, making this variation useful, e.g., +in `:if*' predicates. If no prefix is being setup, but the current +command was invoked from some prefix, then return the scope of that. If PREFIXES is non-nil, it must be a prefix command or a list of such -commands. In this case try the following in order: +commands. If CLASSES is non-nil, it must be a prefix class or a list +of such classes. When this function is called from the body or the +`interactive' form of a suffix command, PREFIXES and/or CLASSES should +be non-nil. If either is non-nil, try the following in order: - If the current suffix command was invoked from a prefix, which - appears in PREFIXES, then return the scope of that prefix. + appears in PREFIXES, return the scope of that prefix. + +- If the current suffix command was invoked from a prefix, and its + class derives from one of the CLASSES, return the scope of that + prefix. + +- If a prefix is being setup and it appears in PREFIXES, return its + scope. -- If a prefix is being setup and it appears in PREFIXES, then return - its scope. +- If a prefix is being setup and its class derives from one of the + CLASSES, return its scope. -- Finally try to return the default scope of the first prefix in +- Finally try to return the default scope of the first command in PREFIXES. This only works if that slot is set in the respective class definition or using its `transient-init-scope' method. If no prefix matches, return nil." - (if prefixes - (let ((prefixes (ensure-list prefixes))) - (if-let* ((obj (or (and-let* ((obj transient-current-prefix)) - (and (memq (oref obj command) prefixes) obj)) - (and-let* ((obj transient--prefix)) - (and (memq (oref obj command) prefixes) obj))))) + (if (or prefixes classes) + (let ((prefixes (ensure-list prefixes)) + (type (if (symbolp classes) classes (cons 'or classes)))) + (if-let ((obj (cl-flet ((match (obj) + (and obj + (or (memq (oref obj command) prefixes) + (cl-typep obj type)) + obj))) + (or (match transient-current-prefix) + (match transient--prefix))))) (oref obj scope) (and (get (car prefixes) 'transient--prefix) (oref (transient--init-prefix (car prefixes)) scope)))) @@ -4247,16 +4325,21 @@ face `transient-heading' to the complete string." If the result is nil, then use \"(BUG: no description)\" as the description. If the OBJ's `key' is currently unreachable, then apply the face `transient-unreachable' to the complete string." - (let ((desc (if-let* ((transient--docsp) - (cmd (oref obj command)) - (doc (ignore-errors (documentation cmd))) - ((not (equal doc (documentation - 'transient--default-infix-command))))) - (substring doc 0 (string-match "\\.?\n" doc)) - (or (cl-call-next-method obj) - (and (slot-boundp transient--prefix 'suffix-description) - (funcall (oref transient--prefix suffix-description) - obj)))))) + (let ((desc (or (cl-call-next-method obj) + (and (slot-boundp transient--prefix 'suffix-description) + (funcall (oref transient--prefix suffix-description) + obj))))) + (when-let* ((transient--docsp) + (cmd (oref obj command)) + ((not (memq 'transient--default-infix-command + (function-alias-p cmd)))) + (docstr (ignore-errors (documentation cmd))) + (docstr (string-trim + (substring docstr 0 (string-match "\\.?\n" docstr)))) + ((not (equal docstr "")))) + (setq desc (format-spec transient-show-docstring-format + `((?c . ,desc) + (?s . ,docstr))))) (if desc (when-let* ((face (transient--get-face obj 'face))) (setq desc (transient--add-face desc face t))) @@ -4568,34 +4651,44 @@ Select the help window, and make the help buffer current and return it." (insert "\n")) (when transient--helpp (insert - (format (propertize "\ + (format + (propertize "\ Type a %s to show help for that suffix command, or %s to show manual. Type %s to exit help.\n" - 'face 'transient-heading) - (propertize "" 'face 'transient-key) - (propertize "?" 'face 'transient-key) - (propertize "C-g" 'face 'transient-key)))) + 'face 'transient-heading) + (propertize "" 'face 'transient-key) + (propertize "?" 'face 'transient-key) + (propertize "C-g" 'face 'transient-key)))) (when transient--editp (unless transient--helpp (insert - (format (propertize "\ -Type a %s to set level for that suffix command. -Type %s to set what levels are available for this prefix command.\n" - 'face 'transient-heading) - (propertize "" 'face 'transient-key) - (propertize "C-x l" 'face 'transient-key)))) + (format + (propertize "\ +Type %s and then %s to put the respective suffix command on level %s. +Type %s and then %s to display suffixes up to level %s in this menu. +Type %s and then %s to describe the respective suffix command.\n" + 'face 'transient-heading) + (propertize "" 'face 'transient-key) + (propertize "" 'face 'transient-key) + (propertize " N " 'face 'transient-enabled-suffix) + (propertize "C-x l" 'face 'transient-key) + (propertize "" 'face 'transient-key) + (propertize " N " 'face 'transient-enabled-suffix) + (propertize "C-h" 'face 'transient-key) + (propertize "" 'face 'transient-key)))) (with-slots (level) transient--prefix (insert - (format (propertize " -Suffixes on levels %s are available. -Suffixes on levels %s and %s are unavailable.\n" - 'face 'transient-heading) - (propertize (format "1-%s" level) - 'face 'transient-enabled-suffix) - (propertize " 0 " - 'face 'transient-disabled-suffix) - (propertize (format ">=%s" (1+ level)) - 'face 'transient-disabled-suffix)))))) + (format + (propertize " +The current level of this menu is %s, so + commands on levels %s are displayed, and + commands on levels %s and %s are not displayed.\n" + 'face 'transient-heading) + (propertize (format " %s " level) 'face 'transient-enabled-suffix) + (propertize (format " 1..%s " level) 'face 'transient-enabled-suffix) + (propertize (format " >= %s " (1+ level)) + 'face 'transient-disabled-suffix) + (propertize " 0 " 'face 'transient-disabled-suffix)))))) (cl-defgeneric transient-show-summary (obj &optional return) "Show brief summary about the command at point in the echo area. commit 5a5706f943ae2677c6d73fed8de11affd3ef04aa Author: Pip Cet Date: Sat Feb 1 17:08:27 2025 +0000 ; src/pdumper.c (dump_hash_table): Bump CHECK_STRUCTS hash. diff --git a/src/pdumper.c b/src/pdumper.c index 20f2c426c53..dee13fb9a81 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2737,7 +2737,7 @@ dump_hash_table_contents (struct dump_context *ctx, struct Lisp_Hash_Table *h) static dump_off dump_hash_table (struct dump_context *ctx, Lisp_Object object) { -#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_267C58D687 +#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_2A3C3E2B62 # error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment in config.h." #endif const struct Lisp_Hash_Table *hash_in = XHASH_TABLE (object); commit 4eabfd68c91185909be307435e5db8b8f0fb4102 Author: Pip Cet Date: Sat Jan 18 20:55:18 2025 +0000 Use #$ for lambda fixups in native compilation data vectors The "#$" syntax is recognized by Fread, which substitutes Vload_file_name in its place. If Vload_file_name is bound appropriately, no other value can produce an object EQ to the one produced by "#$". We use this to check the data vector for entries that we know should have been initialized: if the value is still equal to what we bound Vload_file_name to when it was read, it wasn't initialized, and we abort. * lisp/emacs-lisp/comp.el (comp--#$): New defvar. (comp--finalize-container): Use it. * src/comp.c (ABI_VERSION): Bump. (emit_static_object): Ensure 'comp--#$' prints as "#$". (load_static_obj): Ensure '#$' reads as Vcomp__hashdollar. (check_comp_unit_relocs): Adjust assertion. (syms_of_comp): Define 'comp--#$'. * src/pdumper.c (dump_do_dump_relocation): Adjust assertion. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index dd94e75966c..0da007afebb 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -42,6 +42,7 @@ (defvar comp-subr-arities-h) (defvar native-comp-eln-load-path) (defvar native-comp-enable-subr-trampolines) +(defvar comp--\#$) (declare-function comp--compile-ctxt-to-file0 "comp.c") (declare-function comp--init-ctxt "comp.c") @@ -3254,10 +3255,9 @@ Set it into the `type' slot." ;; from the corresponding m-var. collect (if (gethash obj (comp-ctxt-byte-func-to-func-h comp-ctxt)) - ;; Hack not to have `--lambda-fixup' in - ;; data relocations as it would trigger the - ;; check in 'check_comp_unit_relocs'. - (intern (concat (make-string 1 ?-) "-lambda-fixup")) + ;; This prints as #$, so we can assert this + ;; value does not remain in the data vector + comp--\#$ obj)))) (defun comp--finalize-relocs () diff --git a/src/comp.c b/src/comp.c index 2b2ac073214..692b28e00cb 100644 --- a/src/comp.c +++ b/src/comp.c @@ -468,7 +468,7 @@ load_gccjit_if_necessary (bool mandatory) /* Increase this number to force a new Vcomp_abi_hash to be generated. */ -#define ABI_VERSION "9" +#define ABI_VERSION "10" /* Length of the hashes used for eln file naming. */ #define HASH_LENGTH 8 @@ -2666,6 +2666,12 @@ emit_static_object (const char *name, Lisp_Object obj) specbind (intern_c_string ("print-quoted"), Qt); specbind (intern_c_string ("print-gensym"), Qt); specbind (intern_c_string ("print-circle"), Qt); + /* Bind print-number-table and print-continuous-numbering so comp--#$ + prints as #$. */ + Lisp_Object print_number_table = CALLN (Fmake_hash_table, QCtest, Qeq); + Fputhash (Vcomp__hashdollar, build_string ("#$") , print_number_table); + specbind (intern_c_string ("print-number-table"), print_number_table); + specbind (intern_c_string ("print-continuous-numbering"), Qt); Lisp_Object str = Fprin1_to_string (obj, Qnil, Qnil); unbind_to (count, Qnil); @@ -5129,18 +5135,25 @@ typedef char *(*comp_lit_str_func) (void); static Lisp_Object load_static_obj (struct Lisp_Native_Comp_Unit *comp_u, const char *name) { + specpdl_ref count = SPECPDL_INDEX (); static_obj_t *blob = dynlib_sym (comp_u->handle, format_string ("%s_blob", name)); + /* Special value so we can recognize #$, which is used for entries in + the static vector that must be overwritten at load time. This is a + specific string that contains "#$", which is not EQ to any + legitimate object returned by Fread. */ + specbind (intern_c_string ("load-file-name"), + Vcomp__hashdollar); if (blob) /* New blob format. */ - return Fread (make_string (blob->data, blob->len)); + return unbind_to (count, Fread (make_string (blob->data, blob->len))); static_obj_t *(*f)(void) = dynlib_sym (comp_u->handle, name); if (!f) xsignal1 (Qnative_lisp_file_inconsistent, comp_u->file); blob = f (); - return Fread (make_string (blob->data, blob->len)); + return unbind_to (count, Fread (make_string (blob->data, blob->len))); } @@ -5157,7 +5170,7 @@ check_comp_unit_relocs (struct Lisp_Native_Comp_Unit *comp_u) for (ptrdiff_t i = 0; i < d_vec_len; i++) { Lisp_Object x = data_relocs[i]; - if (EQ (x, Q__lambda_fixup)) + if (EQ (x, Vcomp__hashdollar)) return false; else if (NATIVE_COMP_FUNCTIONP (x)) { @@ -5610,7 +5623,6 @@ natively-compiled one. */); DEFSYM (Qfixnum, "fixnum"); DEFSYM (Qscratch, "scratch"); DEFSYM (Qlate, "late"); - DEFSYM (Q__lambda_fixup, "--lambda-fixup"); DEFSYM (Qgccjit, "gccjit"); DEFSYM (Qcomp_subr_trampoline_install, "comp-subr-trampoline-install"); DEFSYM (Qnative_comp_warning_on_missing_source, @@ -5792,6 +5804,10 @@ This is intended to be used only for development and verification of the native compiler. */); comp_sanitizer_active = false; + DEFVAR_LISP ("comp--#$", Vcomp__hashdollar, + doc: /* Special value which will print as "#$". */); + Vcomp__hashdollar = build_string ("#$"); + Fprovide (intern_c_string ("native-compile"), Qnil); #endif /* #ifdef HAVE_NATIVE_COMP */ diff --git a/src/pdumper.c b/src/pdumper.c index b2ceea2f8bd..20f2c426c53 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -5513,7 +5513,7 @@ dump_do_dump_relocation (const uintptr_t dump_base, XSETSUBR (tem, subr); Lisp_Object *fixup = &(comp_u->data_relocs[XFIXNUM (lambda_data_idx)]); - eassert (EQ (*fixup, Q__lambda_fixup)); + eassert (EQ (*fixup, Vcomp__hashdollar)); *fixup = tem; Fputhash (tem, Qt, comp_u->lambda_gc_guard_h); } commit 20e3959dc37685334579394b320ab93f751243fb Author: Eli Zaretskii Date: Sat Feb 1 15:44:47 2025 +0200 ; * lisp/progmodes/etags.el (tags-verify-table): Improve comment (bug#75946). diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index 22f946c5698..42057a3aacb 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -445,8 +445,9 @@ Returns non-nil if it is a valid table." (set-buffer (get-file-buffer file)) (or verify-tags-table-function (tags-table-mode)) (unless (or (verify-visited-file-modtime (current-buffer)) - ;; Avoid an infinte loop of questions about - ;; re-reading content if file was removed. + ;; 'verify-visited-file-modtime' return non-nil if + ;; the tags table file was meanwhile deleted. Avoid + ;; asking the question below again if so. (not (file-exists-p file)) ;; Decide whether to revert the file. ;; revert-without-query can say to revert commit eb12b6d153b8ad3f9e3fe23761a98021d8071293 Author: Konstantin Kharlamov Date: Thu Jan 30 17:09:48 2025 +0300 Avoid infinite questions if TAGS file was removed When the visited TAGS file was removed, commands that depend on TAGS, such as auto-completion, may invoke an interactive question whether a user wants to re-read the file. From that point on, the question will be asked over and over, because the file no longer exists, which results in mtime mismatch and inability to "fix the mismatch" by reading from the file. Fix that by simply ignoring the mismatch if the file no longer exists. * lisp/progmodes/etags.el (tags-verify-table): Avoid infinite questions if TAGS file was removed. (Bug#75946) diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index b322b35ed63..22f946c5698 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -445,6 +445,9 @@ Returns non-nil if it is a valid table." (set-buffer (get-file-buffer file)) (or verify-tags-table-function (tags-table-mode)) (unless (or (verify-visited-file-modtime (current-buffer)) + ;; Avoid an infinte loop of questions about + ;; re-reading content if file was removed. + (not (file-exists-p file)) ;; Decide whether to revert the file. ;; revert-without-query can say to revert ;; or the user can say to revert. commit 532ff6e29df87b9fdc84c56cddd9c587c5895e48 Author: Po Lu Date: Sat Feb 1 20:59:24 2025 +0800 Fix compilation warnings on Android * src/alloc.c (pointer_align): Only define if !USE_ALIGNED_ALLOC. diff --git a/src/alloc.c b/src/alloc.c index 40a59854a87..c39459e1f2e 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -501,14 +501,6 @@ Lisp_Object const *staticvec[NSTATICS]; int staticidx; -#ifndef HAVE_ALIGNED_ALLOC -static void * -pointer_align (void *ptr, int alignment) -{ - return (void *) ROUNDUP ((uintptr_t) ptr, alignment); -} -#endif - /* Extract the pointer hidden within O. */ static ATTRIBUTE_NO_SANITIZE_UNDEFINED void * @@ -1095,6 +1087,16 @@ struct ablocks /* The list of free ablock. */ static struct ablock *free_ablock; +#if !USE_ALIGNED_ALLOC + +static void * +pointer_align (void *ptr, int alignment) +{ + return (void *) ROUNDUP ((uintptr_t) ptr, alignment); +} + +#endif /* !USE_ALIGNED_ALLOC */ + /* Allocate an aligned block of nbytes. Alignment is on a multiple of BLOCK_ALIGN and `nbytes' has to be smaller or equal to BLOCK_BYTES. */ commit d58fe6619f9b31069ebb420f0e85c7ce00a5fcb7 Merge: 25fc7799867 ba271938951 Author: Eli Zaretskii Date: Sat Feb 1 07:40:19 2025 -0500 Merge from origin/emacs-30 ba271938951 ; * etc/NEWS: Fix wording. fdc6842a44e Remove bookmark fringe marks when deleting all bookmarks 3bccd04c5c6 Improve wording in symbols.texi 6441b9ea7af Fix typo in Gnus manual 87be3aa1491 eglot: Allow omnisharp binary to be capitalized "OmniSharp" 5485ea6aef9 Do not set `trusted-content` in major modes d11488fd6fb ; * lisp/subr.el (sit-for): Doc fix. # Conflicts: # etc/NEWS commit 25fc779986744913a97bbd4349907877bde68d38 Merge: 5f7ef7ca8ce 0b3e050c6ce Author: Eli Zaretskii Date: Sat Feb 1 07:40:14 2025 -0500 ; Merge from origin/emacs-30 The following commits were skipped: 0b3e050c6ce * src/puresize.h (BASE_PURESIZE): Increase (bug#75907). 0c6aa27cde5 ; Fix Cygw32 build (bug#75926) commit 5f7ef7ca8cec1fb37fc71d18a370e85ac3788136 Merge: 68d516532dd d0907a43888 Author: Eli Zaretskii Date: Sat Feb 1 07:40:14 2025 -0500 Merge from origin/emacs-30 d0907a43888 ; * admin/MAINTAINERS: Prefer "website" to "home page". commit 68d516532dd5b1ae0a70a7d0a92f22a4b61db110 Merge: 7c0a93d7e5c 1969c2c3eda Author: Eli Zaretskii Date: Sat Feb 1 07:40:14 2025 -0500 ; Merge from origin/emacs-30 The following commit was skipped: 1969c2c3eda ; * admin/MAINTAINERS: Remove Bastien Guerry. commit 7c0a93d7e5cda0786d8462d906f77743a3561b55 Merge: 0ef78b131b4 6447634f171 Author: Eli Zaretskii Date: Sat Feb 1 07:39:56 2025 -0500 Merge from origin/emacs-30 6447634f171 ; * admin/MAINTAINERS: Add CC Mode. 486d5d524ca Update cc-mode URL to point to nongnu.org 17ef46e849d ; * etc/NEWS: Note CVE-2024-53920 further up also. 05ee2b741f0 ; * CONTRIBUTE: Suggest to run more tests sometimes. e74efd9a428 * CONTRIBUTE: Recommend running the unit test prior to co... a9cde2463ab Don't signal an error in treesit-node-at 5d021a711a9 ; Improve documentation of '.dir-locals.el' 84595cbcc78 ; (let-alist): Document double-dot escape syntax. (Bug#75... 5617b07a45b ; Prefer HTTPS to HTTP in docs fdd23023c84 ; * admin/MAINTAINERS: Sort external packages alphabetica... 74dcfe155a9 ; * etc/NEWS: Remove temporary documentation markers. a87c382caba ; * etc/NEWS: Add missing temporary documentation tags. 3c820cd2650 Document insert-directory-program as a user option 2c1edf5f62a doc/lispref/modes.texi (Syntactic Font Lock): Update for ... # Conflicts: # etc/NEWS commit 0ef78b131b4e232f064e370699a7ae2413715a44 Author: Jostein Kjønigsen Date: Mon Jan 6 15:08:36 2025 +0100 lisp/progmodes/csharp-mode.el: Fix fontification of typeof (bug#75406). diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el index 3e07da40cdd..9d19456179b 100644 --- a/lisp/progmodes/csharp-mode.el +++ b/lisp/progmodes/csharp-mode.el @@ -748,6 +748,12 @@ compilation and evaluation time conflicts." (treesit-query-compile 'c-sharp "(type_of_expression)" t) t)) +(defun csharp-ts-mode--test-typeof-expression () + "Return non-nil if (type_of_expression) is in the grammar." + (ignore-errors + (treesit-query-compile 'c-sharp "(typeof_expression)" t) + t)) + (defun csharp-ts-mode--test-name-equals () "Return non-nil if (name_equals) is in the grammar." (ignore-errors @@ -871,7 +877,9 @@ compilation and evaluation time conflicts." (type_parameter_constraint (type type: (generic_name (identifier) @font-lock-type-face))))) ,@(when (csharp-ts-mode--test-type-of-expression) - '((type_of_expression (identifier) @font-lock-type-face)) + '((type_of_expression (identifier) @font-lock-type-face))) + + ,@(when (csharp-ts-mode--test-typeof-expression) '((typeof_expression (identifier) @font-lock-type-face))) (object_creation_expression commit 3a5aba81ca0739ff3f877a77c41cc0cd5a3c8fc7 Author: Eli Zaretskii Date: Sat Feb 1 13:26:06 2025 +0200 ; Fix last change * etc/NEWS: Announce the change in 'ispell-help-timeout'. * lisp/textmodes/ispell.el (ispell-help-timeout): Change :version. (Bug#75804) diff --git a/etc/NEWS b/etc/NEWS index fd0d3ece5eb..93e2d0ebc65 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -733,6 +733,13 @@ the 'mutool' program after their initial conversion to PDF format. The name of the 'djvused' program can be customized by changing the user option 'doc-view-djvused-program'. +** Ispell + +--- +*** The default value of 'ispell-help-timeout' has changed. +The default value is now 30 seconds, as the old value was too short to +allow reading the help text. + ** Flyspell --- diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index fbd1746b96e..f53732098ea 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -405,7 +405,7 @@ re-start Emacs." (defcustom ispell-help-timeout 30 "The number of seconds to display the help text." :type 'number - :version "28.1") + :version "31.1") (defvar ispell-dictionary-base-alist '((nil ; default commit ba2719389515cee54874588d76b9244c17f568d5 (refs/remotes/origin/emacs-30) Author: Michael Albinus Date: Sat Feb 1 12:24:27 2025 +0100 ; * etc/NEWS: Fix wording. diff --git a/etc/NEWS b/etc/NEWS index da3a1d670e7..ec14e447859 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -194,7 +194,7 @@ and disables itself with an "untrusted content" warning if the file is not listed. Emacs Lisp authors should note that a major or minor mode must never set -this variable to the ':all' value. +this option to the ':all' value. This option is used to fix CVE-2024-53920. See below for details. commit 89eac993c76b58384e1e5d5ffb7402a8bcdb6290 Author: Rudolf Adamkovič Date: Sat Jan 25 11:24:34 2025 +0100 Ispell: Increase help timeout * lisp/textmodes/ispell.el (ispell-help-timeout): Increase the timeout from 5 to 30 seconds to allow users, especially new users, read the Ispell help menu comfortably and act confidently (bug#75804). diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index abe3abefc26..fbd1746b96e 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -402,7 +402,7 @@ re-start Emacs." (const :tag "default" nil)) (coding-system :tag "Coding System")))) -(defcustom ispell-help-timeout 5 +(defcustom ispell-help-timeout 30 "The number of seconds to display the help text." :type 'number :version "28.1") commit 4aa53f293455e690a9aa07eac13011020b887e0e Author: Stefan Monnier Date: Sat Feb 1 06:07:24 2025 -0500 (defcustom): Improve doc of `:group` * lisp/custom.el (defcustom): Mention the use of a default group and the fact that `:group` can be repeated. diff --git a/lisp/custom.el b/lisp/custom.el index 3abc326e674..9e6eb930467 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -306,7 +306,8 @@ The following keywords are meaningful: The following common keywords are also meaningful. :group VALUE should be a customization group. - Add SYMBOL (or FACE with `defface') to that group. + Add SYMBOL (or FACE with `defface') to that group instead of + the default group. Can be repeated. :link LINK-DATA Include an external link after the documentation string for this item. This is a sentence containing an active field which commit f40aff4c5d2d8dc83074addc568abcdf564e6b01 Author: Pengji Zhang Date: Mon Jan 27 19:42:00 2025 +0800 New user option 'Buffer-menu-human-readable-sizes' * lisp/buff-menu.el (Buffer-menu-human-readable-sizes): New user option. (list-buffers--refresh): Use it. * etc/NEWS: Announce the new user option. (Bug#75825) diff --git a/etc/NEWS b/etc/NEWS index 4859ac414e3..fd0d3ece5eb 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -402,6 +402,12 @@ set to 'title'. *** New user option 'ibuffer-human-readable-size'. When non-nil, buffer sizes are shown in human readable format. +--- +** Buffer Menu +*** New user option 'Buffer-menu-human-readable-sizes'. +When non-nil, buffer sizes are shown in human readable format. The +default is nil, which retains the old format. + ** Smerge *** New command 'smerge-extend' extends a conflict over surrounding lines. diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 4418db01724..36268b3512a 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -135,6 +135,14 @@ If this is nil, group names are unsorted." :group 'Buffer-menu :version "30.1") +(defcustom Buffer-menu-human-readable-sizes nil + "If non-nil, show buffer sizes in human-readable format. +That means to use `file-size-human-readable' (which see) to format the +buffer sizes in the buffer size column." + :type 'boolean + :group 'Buffer-menu + :version "31.1") + (defvar-local Buffer-menu-files-only nil "Non-nil if the current Buffer Menu lists only file buffers. This is set by the prefix argument to `buffer-menu' and related @@ -831,7 +839,10 @@ See more at `Buffer-menu-filter-predicate'." (if buffer-read-only "%" " ") (if (buffer-modified-p) "*" " ") (Buffer-menu--pretty-name name) - (number-to-string (buffer-size)) + (funcall (if Buffer-menu-human-readable-sizes + #'file-size-human-readable + #'number-to-string) + (buffer-size)) (concat (format-mode-line mode-name nil nil buffer) (if mode-line-process commit ed0ca7c23e60696148b986ac15fb20e40aec7dea Author: Eli Zaretskii Date: Sat Feb 1 12:34:26 2025 +0200 * etc/NEWS: Fix punctuation. diff --git a/etc/NEWS b/etc/NEWS index 05008a5524b..4859ac414e3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -456,7 +456,7 @@ default), the 'whitespace-cleanup' function will now add the newline. --- *** New user option 'bookmark-bmenu-type-column-width'. This user option controls the width of the type column on the bookmark -menu 'bookmark-bmenu-list'. The default value is 8 which is backwards +menu 'bookmark-bmenu-list'. The default value is 8 which is backwards compatible. ** Gnus commit 004600e0142fb6f9c7ab492f855ee9668bb0421e Author: shipmints Date: Mon Jan 27 11:16:04 2025 -0500 Add new user option bookmark-bmenu-type-column-width * lisp/bookmark.el (bookmark-bmenu-mode): Add new user option bookmark-bmenu-type-column-width, defaulting to 8 for backwards compatibility, and use it when creating the tabulated bookmark list. (Bug#75826) diff --git a/etc/NEWS b/etc/NEWS index 5b9e356737e..05008a5524b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -451,6 +451,14 @@ Such bindings make it possible to compute which function to bind to FUNC. If 'whitespace-style' includes 'missing-newline-at-eof' (which is the default), the 'whitespace-cleanup' function will now add the newline. +** Bookmark + +--- +*** New user option 'bookmark-bmenu-type-column-width'. +This user option controls the width of the type column on the bookmark +menu 'bookmark-bmenu-list'. The default value is 8 which is backwards +compatible. + ** Gnus --- diff --git a/lisp/bookmark.el b/lisp/bookmark.el index d68e9308208..c86101217d6 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -165,6 +165,10 @@ This includes the annotations column.") You can toggle whether files are shown with \\\\[bookmark-bmenu-toggle-filenames]." :type 'natnum) +(defcustom bookmark-bmenu-type-column-width 8 + "Column width for bookmark type in a buffer listing bookmarks." + :type 'natnum + :version "31.1") (defcustom bookmark-bmenu-toggle-filenames t "Non-nil means show filenames when listing bookmarks. @@ -2061,7 +2065,7 @@ At any time you may use \\[revert-buffer] to go back to sorting by creation orde `[("" 1) ;; Space to add "*" for bookmark with annotation ("Bookmark Name" ,bookmark-bmenu-file-column bookmark-bmenu--name-predicate) - ("Type" 8 bookmark-bmenu--type-predicate) + ("Type" ,bookmark-bmenu-type-column-width bookmark-bmenu--type-predicate) ,@(if bookmark-bmenu-toggle-filenames '(("File" 0 bookmark-bmenu--file-predicate)))]) (setq tabulated-list-padding bookmark-bmenu-marks-width) commit e067f2763fd52b78342b5c759205032227e82ebe Author: Eli Zaretskii Date: Sat Feb 1 12:22:13 2025 +0200 Rename a recently-added variable (bug#56197) * lisp/emacs-lisp/lisp-mode.el (lisp-fill-paragraphs-as-doc-string): Renamed from 'lisp-fill-paragraph-as-displayed' and default value reversed. (lisp-fill-paragraph): Adjust to the change. * test/lisp/emacs-lisp/lisp-mode-tests.el (lisp-fill-paragraph-as-displayed): Likewise. diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 3b1d34bf7cd..1349a5212ed 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -1431,16 +1431,17 @@ Any non-integer value means do not use a different value of :group 'lisp :version "30.1") -(defvar lisp-fill-paragraph-as-displayed nil - "Modify the behavior of `lisp-fill-paragraph'. +(defvar lisp-fill-paragraphs-as-doc-string t + "Whether `lisp-fill-paragraph' should fill strings as ELisp doc strings. The default behavior of `lisp-fill-paragraph' is tuned for filling Emacs Lisp doc strings, with their special treatment for the first line. -Particularly, strings are filled in a narrowed context to avoid filling +Specifically, strings are filled in a narrowed context to avoid filling surrounding code, which means any leading indent is disregarded, which can cause the filled string to extend passed the configured `fill-column' variable value. If you would rather fill the string in -its original context and ensure the `fill-column' value is more strictly -respected, set this variable to true. Doing so makes +its original context, disregarding the special conventions of ELisp doc +strings, and want to ensure the `fill-column' value is more strictly +respected, set this variable to nil. Doing so makes `lisp-fill-paragraph' behave as it used to in Emacs 27 and prior versions.") @@ -1506,7 +1507,7 @@ and initial semicolons." ;; code. (if (not string-start) (lisp--fill-line-simple) - (unless lisp-fill-paragraph-as-displayed + (when lisp-fill-paragraphs-as-doc-string ;; If we're in a string, then narrow (roughly) to that ;; string before filling. This avoids filling Lisp ;; statements that follow the string. diff --git a/test/lisp/emacs-lisp/lisp-mode-tests.el b/test/lisp/emacs-lisp/lisp-mode-tests.el index 96e37114276..676d4f2ab4a 100644 --- a/test/lisp/emacs-lisp/lisp-mode-tests.el +++ b/test/lisp/emacs-lisp/lisp-mode-tests.el @@ -333,7 +333,7 @@ Here is some more text.\" (ert-deftest lisp-fill-paragraph-as-displayed () "Test bug#56197 -- more specifically, validate that a leading indentation for a string is preserved in the filled string." - (let ((lisp-fill-paragraph-as-displayed t) ;variable under test + (let ((lisp-fill-paragraphs-as-doc-string nil) ;variable under test ;; The following is a contrived example that demonstrates the ;; fill-column problem when the string to fill is indented. (source "\ commit 22ab03e155adc4df0623e3ee9c2cc56a228e148a Author: Eli Zaretskii Date: Sat Feb 1 12:21:51 2025 +0200 ; Avoid compiler warnings in the MS-Windows build * src/w32heap.c: Remove unused variables, to avoid compilation warnings. This removes variables that were used only in the unexec build. diff --git a/src/w32heap.c b/src/w32heap.c index 2ba36f01751..f767e5781bf 100644 --- a/src/w32heap.c +++ b/src/w32heap.c @@ -89,51 +89,6 @@ typedef struct _RTL_HEAP_PARAMETERS { /* Info for keeping track of our dynamic heap used after dumping. */ unsigned char *data_region_base = NULL; unsigned char *data_region_end = NULL; -static DWORD_PTR committed = 0; - -/* The maximum block size that can be handled by a non-growable w32 - heap is limited by the MaxBlockSize value below. - - This point deserves an explanation. - - The W32 heap allocator can be used for a growable heap or a - non-growable one. - - A growable heap is not compatible with a fixed base address for the - heap. Only a non-growable one is. One drawback of non-growable - heaps is that they can hold only objects smaller than a certain - size (the one defined below). Most of the larger blocks are GC'ed - before dumping. In any case, and to be safe, we implement a simple - first-fit allocation algorithm starting at the end of the - dumped_data[] array as depicted below: - - ---------------------------------------------- - | | | | - | Private heap |-> <-| Big chunks | - | | | | - ---------------------------------------------- - ^ ^ ^ - dumped_data dumped_data bc_limit - + committed - -*/ - -/* Info for managing our preload heap, which is essentially a fixed size - data area in the executable. */ -#define PAGE_SIZE 0x1000 -#define MaxBlockSize (0x80000 - PAGE_SIZE) - -#define MAX_BLOCKS 0x40 - -static struct -{ - unsigned char *address; - size_t size; - DWORD occupied; -} blocks[MAX_BLOCKS]; - -static DWORD blocks_number = 0; -static unsigned char *bc_limit; /* Handle for the private heap: - inside the dumped_data[] array before dump with unexec, commit fdc6842a44e76db35432305455a05f2125962a62 Author: Eli Zaretskii Date: Sat Feb 1 11:33:34 2025 +0200 Remove bookmark fringe marks when deleting all bookmarks * lisp/bookmark.el (bookmark-delete-all): Remove fringe marks for all the bookmarks. (Bug#75953) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index cd59293e0a4..153646c1fff 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -1584,6 +1584,8 @@ confirmation." (when (or no-confirm (yes-or-no-p "Permanently delete all bookmarks? ")) (bookmark-maybe-load-default-file) + (dolist (bm bookmark-alist) + (bookmark--remove-fringe-mark bm)) (setq bookmark-alist-modification-count (+ bookmark-alist-modification-count (length bookmark-alist))) (setq bookmark-alist nil) commit a001202b993cf0ef59c46d15fe3f1a011493ad9c Author: Stefan Kangas Date: Sat Feb 1 05:02:36 2025 +0100 Revert "Don't use obsolete face variables in lisp-mode.el" This reverts commit ba60fa3deaa030eb4815caa8c180ac841709e86a. diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 8c241723465..3b1d34bf7cd 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -433,10 +433,10 @@ This will generate compile-time constants from BINDINGS." "\\(([ \t']*\\)?" ;; An opening paren. "\\(\\(setf\\)[ \t]+" (rx lisp-mode-symbol) "\\|" (rx lisp-mode-symbol) "\\)?") - (1 'font-lock-keyword-face) + (1 font-lock-keyword-face) (3 (let ((type (get (intern-soft (match-string 1)) 'lisp-define-type))) - (cond ((eq type 'var) 'font-lock-variable-name-face) - ((eq type 'type) 'font-lock-type-face) + (cond ((eq type 'var) font-lock-variable-name-face) + ((eq type 'type) font-lock-type-face) ;; If match-string 2 is non-nil, we encountered a ;; form like (defalias (intern (concat s "-p"))), ;; unless match-string 4 is also there. Then its a @@ -444,12 +444,12 @@ This will generate compile-time constants from BINDINGS." ((or (not (match-string 2)) ;; Normal defun. (and (match-string 2) ;; Setf method. (match-string 4))) - 'font-lock-function-name-face))) + font-lock-function-name-face))) nil t)) ;; Emacs Lisp autoload cookies. Supports the slightly different ;; forms used by mh-e, calendar, etc. - (,lisp-mode-autoload-regexp (3 'font-lock-warning-face prepend) - (2 'font-lock-function-name-face prepend t))) + (,lisp-mode-autoload-regexp (3 font-lock-warning-face prepend) + (2 font-lock-function-name-face prepend t))) "Subdued level highlighting for Emacs Lisp mode.") (defconst lisp-cl-font-lock-keywords-1 @@ -460,14 +460,14 @@ This will generate compile-time constants from BINDINGS." "\\(([ \t']*\\)?" ;; An opening paren. "\\(\\(setf\\)[ \t]+" (rx lisp-mode-symbol) "\\|" (rx lisp-mode-symbol) "\\)?") - (1 'font-lock-keyword-face) + (1 font-lock-keyword-face) (3 (let ((type (get (intern-soft (match-string 1)) 'lisp-define-type))) - (cond ((eq type 'var) 'font-lock-variable-name-face) - ((eq type 'type) 'font-lock-type-face) + (cond ((eq type 'var) font-lock-variable-name-face) + ((eq type 'type) font-lock-type-face) ((or (not (match-string 2)) ;; Normal defun. (and (match-string 2) ;; Setf function. (match-string 4))) - 'font-lock-function-name-face))) + font-lock-function-name-face))) nil t))) "Subdued level highlighting for Lisp modes.") @@ -477,17 +477,17 @@ This will generate compile-time constants from BINDINGS." (append lisp-el-font-lock-keywords-1 `( ;; Regexp negated char group. - ("\\[\\(\\^\\)" 1 'font-lock-negation-char-face prepend) + ("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend) ;; Erroneous structures. (,(concat "(" el-errs-re "\\_>") - (1 'font-lock-warning-face)) + (1 font-lock-warning-face)) ;; Control structures. Common Lisp forms. (lisp--el-match-keyword . 1) ;; Exit/Feature symbols as constants. (,(concat "(\\(catch\\|throw\\|featurep\\|provide\\|require\\)\\_>" "[ \t']*\\(" (rx lisp-mode-symbol) "\\)?") - (1 'font-lock-keyword-face) - (2 'font-lock-constant-face nil t)) + (1 font-lock-keyword-face) + (2 font-lock-constant-face nil t)) ;; Words inside \\[], \\<>, \\{} or \\`' tend to be for ;; `substitute-command-keys'. (,(rx "\\\\" (or (seq "[" @@ -496,27 +496,27 @@ This will generate compile-time constants from BINDINGS." ;; allow multiple words, e.g. "C-x a" lisp-mode-symbol (* " " lisp-mode-symbol)) "'"))) - (1 'font-lock-constant-face prepend)) + (1 font-lock-constant-face prepend)) (,(rx "\\\\" (or (seq "<" (group-n 1 (seq lisp-mode-symbol (not "\\"))) ">") (seq "{" (group-n 1 (seq lisp-mode-symbol (not "\\"))) "}"))) - (1 'font-lock-variable-name-face prepend)) + (1 font-lock-variable-name-face prepend)) ;; Ineffective backslashes (typically in need of doubling). ("\\(\\\\\\)\\([^\"\\]\\)" (1 (elisp--font-lock-backslash) prepend)) ;; Words inside ‘’, '' and `' tend to be symbol names. (,(concat "[`‘']\\(" (rx lisp-mode-symbol) "\\)['’]") - (1 'font-lock-constant-face prepend)) + (1 font-lock-constant-face prepend)) ;; \\= tends to be an escape in doc strings. (,(rx "\\\\=") - (0 'font-lock-builtin-face prepend)) + (0 font-lock-builtin-face prepend)) ;; Constant values. (,(lambda (bound) (lisp-mode--search-key ":" bound)) - (0 'font-lock-builtin-face)) + (0 font-lock-builtin-face)) ;; ELisp and CLisp `&' keywords as types. (,(lambda (bound) (lisp-mode--search-key "&" bound)) - (0 'font-lock-type-face)) + (0 font-lock-type-face)) ;; ELisp regexp grouping constructs (,(lambda (bound) (catch 'found @@ -534,11 +534,11 @@ This will generate compile-time constants from BINDINGS." (1 'font-lock-regexp-grouping-backslash prepend) (3 'font-lock-regexp-grouping-construct prepend)) (lisp--match-hidden-arg - (0 '(face 'font-lock-warning-face + (0 '(face font-lock-warning-face help-echo "Easy to misread; consider moving the element to the next line") prepend)) (lisp--match-confusable-symbol-character - 0 '(face 'font-lock-warning-face + 0 '(face font-lock-warning-face help-echo "Confusable character")) )) "Gaudy level highlighting for Emacs Lisp mode.") @@ -547,29 +547,29 @@ This will generate compile-time constants from BINDINGS." (append lisp-cl-font-lock-keywords-1 `( ;; Regexp negated char group. - ("\\[\\(\\^\\)" 1 'font-lock-negation-char-face prepend) + ("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend) ;; Control structures. Common Lisp forms. (,(concat "(" cl-kws-re "\\_>") . 1) ;; Exit/Feature symbols as constants. (,(concat "(\\(catch\\|throw\\|provide\\|require\\)\\_>" "[ \t']*\\(" (rx lisp-mode-symbol) "\\)?") - (1 'font-lock-keyword-face) - (2 'font-lock-constant-face nil t)) + (1 font-lock-keyword-face) + (2 font-lock-constant-face nil t)) ;; Erroneous structures. (,(concat "(" cl-errs-re "\\_>") - (1 'font-lock-warning-face)) + (1 font-lock-warning-face)) ;; Words inside ‘’ and `' tend to be symbol names. (,(concat "[`‘]\\(" (rx lisp-mode-symbol) "\\)['’]") - (1 'font-lock-constant-face prepend)) + (1 font-lock-constant-face prepend)) ;; Uninterned symbols, e.g., (defpackage #:my-package ...) ;; must come before keywords below to have effect - (,(concat "#:" (rx lisp-mode-symbol) "") 0 'font-lock-builtin-face) + (,(concat "#:" (rx lisp-mode-symbol) "") 0 font-lock-builtin-face) ;; Constant values. (,(lambda (bound) (lisp-mode--search-key ":" bound)) - (0 'font-lock-builtin-face)) + (0 font-lock-builtin-face)) ;; ELisp and CLisp `&' keywords as types. (,(lambda (bound) (lisp-mode--search-key "&" bound)) - (0 'font-lock-type-face)) + (0 font-lock-type-face)) ;; ELisp regexp grouping constructs ;; This is too general -- rms. ;; A user complained that he has functions whose names start with `do' @@ -577,9 +577,9 @@ This will generate compile-time constants from BINDINGS." ;; That user has violated the https://www.cliki.net/Naming+conventions: ;; CL (but not EL!) `with-' (context) and `do-' (iteration) (,(concat "(\\(\\(do-\\|with-\\)" (rx lisp-mode-symbol) "\\)") - (1 'font-lock-keyword-face)) + (1 font-lock-keyword-face)) (lisp--match-hidden-arg - (0 '(face 'font-lock-warning-face + (0 '(face font-lock-warning-face help-echo "Easy to misread; consider moving the element to the next line") prepend)) )) commit bf97946d7dc460b7d3c3ce03193041b891b51faf Merge: a4a0957b6b3 aa07e94439c Author: Stefan Kangas Date: Sat Feb 1 04:56:52 2025 +0100 Merge branch 'scratch/no-purespace' into 'master' commit 3bccd04c5c659307231f9e03895d71d26c1d5f8f Author: Stefan Kangas Date: Sat Feb 1 04:08:43 2025 +0100 Improve wording in symbols.texi * doc/lispref/symbols.texi (Symbol Components): Improve wording (Bug#75512). Reported by Matt Trzcinski . diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi index 24b4e892024..2fd3da9812d 100644 --- a/doc/lispref/symbols.texi +++ b/doc/lispref/symbols.texi @@ -106,11 +106,11 @@ reference any object. (This is not the same thing as holding the symbol a value cell that is void results in an error, such as @samp{Symbol's value as variable is void}. - Because each symbol has separate value and function cells, variables -names and function names do not conflict. For example, the symbol -@code{buffer-file-name} has a value (the name of the file being -visited in the current buffer) as well as a function definition (a -primitive function that returns the name of the file): + Because each symbol has separate value and function cells, the names +of variables and functions do not conflict. For example, the symbol +@code{buffer-file-name} has a value (the name of the file being visited +in the current buffer) as well as a function definition (a primitive +function that returns the name of the file): @example buffer-file-name commit 6441b9ea7af143a882fc1222be345b9260d5bbae Author: Manuel Giraud Date: Fri Jan 31 19:25:03 2025 +0100 Fix typo in Gnus manual * doc/misc/gnus.texi (Comparing Mail Back Ends): Fix a missing verb. (Bug#75974) diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 4d278dc3754..1eace0d5b5a 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -17204,7 +17204,7 @@ filename is unrelated to the article number in Gnus. @code{nnmaildir} also stores the equivalent of @code{nnml}'s overview files in one file per article, so it uses about twice as many inodes as @code{nnml}. (Use @code{df -i} to see how plentiful your inode supply is.) If this -slows you down or takes up very much space, a non-block-structured +slows you down or takes up very much space, use a non-block-structured file system. Since maildirs don't require locking for delivery, the maildirs you use commit a4a0957b6b3b1db858524ac6d4dc3d951f65960b Author: Jostein Kjønigsen Date: Wed Oct 16 09:52:08 2024 +0200 Improve typescript-ts-mode fontification (bug#75824) * lisp/progmodes/typescript-ts-mode.el: (typescript-ts-mode--operators): Add syntax-highlighting ?? operator. (typescript-ts-mode--font-lock-settings): Add "undefined" as recognized constant. diff --git a/lisp/progmodes/typescript-ts-mode.el b/lisp/progmodes/typescript-ts-mode.el index 937146ddf23..e91c42069be 100644 --- a/lisp/progmodes/typescript-ts-mode.el +++ b/lisp/progmodes/typescript-ts-mode.el @@ -188,7 +188,7 @@ Argument LANGUAGE is either `typescript' or `tsx'." (defvar typescript-ts-mode--operators '("=" "+=" "-=" "*=" "/=" "%=" "**=" "<<=" ">>=" ">>>=" "&=" "^=" - "|=" "&&=" "||=" "??=" "==" "!=" "===" "!==" ">" ">=" "<" "<=" "+" + "|=" "&&=" "||=" "??" "??=" "==" "!=" "===" "!==" ">" ">=" "<" "<=" "+" "-" "*" "/" "%" "++" "--" "**" "&" "|" "^" "~" "<<" ">>" ">>>" "&&" "||" "!" "?.") "TypeScript operators for tree-sitter font-locking.") @@ -271,7 +271,7 @@ Argument LANGUAGE is either `typescript' or `tsx'." :feature 'constant `(((identifier) @font-lock-constant-face (:match "\\`[A-Z_][0-9A-Z_]*\\'" @font-lock-constant-face)) - [(true) (false) (null)] @font-lock-constant-face) + [(true) (false) (null) (undefined)] @font-lock-constant-face) :language language :feature 'keyword commit 87be3aa1491d5016da8ddb2e896720c53d153643 Author: Damien Cassou Date: Thu Jan 30 21:44:31 2025 +0100 eglot: Allow omnisharp binary to be capitalized "OmniSharp" Some distributors (e.g. nixpkgs) provide a binary "OmniSharp" instead of "omnisharp", which breaks on case-sensitive file-systems. * lisp/progmodes/eglot.el (eglot-server-programs): Add "OmniSharp" as a valid binary name to search for. (Bug#75954) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 9eb28e34faf..45e0e7d16cd 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -327,6 +327,7 @@ automatically)." ((csharp-mode csharp-ts-mode) . ,(eglot-alternatives '(("omnisharp" "-lsp") + ("OmniSharp" "-lsp") ("csharp-ls")))) (purescript-mode . ("purescript-language-server" "--stdio")) ((perl-mode cperl-mode) commit 3a7809f9cc7214e843c20e3c216933bf8bbcdbb2 Author: Paul Eggert Date: Fri Jan 31 14:42:33 2025 -0800 Don’t use garbage after tty_frame_at returns nil * src/term.c (handle_one_term_event): Don’t access possibly uninitialized storage if frame is nil. This fixes an issue introduced in commit 5eae7f5227c7789dea45cef26fec17c057024670 dated 2025-01-26 14:43:51 -0800. Issue caught by --enable-gcc-warnings, which enables -Wanalyzer-use-of-uninitialized-value with gcc (GCC) 14.2.1 20250110 (Red Hat 14.2.1-7). diff --git a/src/term.c b/src/term.c index a058cb1f62a..f307d709316 100644 --- a/src/term.c +++ b/src/term.c @@ -2767,8 +2767,8 @@ term_mouse_click (struct input_event *result, Gpm_Event *event, int handle_one_term_event (struct tty_display_info *tty, const Gpm_Event *event_in) { - int child_x, child_y; - Lisp_Object frame = tty_frame_at (event_in->x, event_in->y, &child_x, &child_y); + int child_x = event_in->x, child_y = event_in->y; + Lisp_Object frame = tty_frame_at (child_x, child_y, &child_x, &child_y); Gpm_Event event = *event_in; event.x = child_x; event.y = child_y; commit e8ae77e9395162a473c91038019c676f23a19edf Author: Pip Cet Date: Fri Jan 31 14:42:33 2025 -0800 Revert "Prefer static switch-case checking in pdumper" This reverts commit 6e2e7265a04f63f482db7fbdfd8e2519d8bfe03e. diff --git a/src/pdumper.c b/src/pdumper.c index 45a44db0243..71d82629b56 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2392,6 +2392,8 @@ dump_fwd (struct dump_context *ctx, lispfwd fwd) case Lisp_Fwd_Kboard_Obj: offset = dump_fwd_kboard_obj (ctx, p); break; + default: + emacs_abort (); } return offset; @@ -2523,6 +2525,8 @@ dump_symbol (struct dump_context *ctx, case SYMBOL_FORWARDED: dump_field_fixup_later (ctx, &out, symbol, &symbol->u.s.val.fwd); break; + default: + emacs_abort (); } dump_field_lv (ctx, &out, symbol, &symbol->u.s.function, WEIGHT_NORMAL); dump_field_lv (ctx, &out, symbol, &symbol->u.s.plist, WEIGHT_NORMAL); @@ -3603,6 +3607,8 @@ dump_drain_cold_data (struct dump_context *ctx) dump_cold_native_subr (ctx, data); break; #endif + default: + emacs_abort (); } } @@ -4067,6 +4073,8 @@ dump_do_fixup (struct dump_context *ctx, do_write = false; break; } + default: + emacs_abort (); } if (do_write) dump_write (ctx, &dump_value, sizeof (dump_value)); @@ -4525,6 +4533,8 @@ dump_anonymous_allocate_w32 (void *base, mem_type = MEM_COMMIT; mem_prot = PAGE_READWRITE; break; + default: + emacs_abort (); } ret = VirtualAlloc (base, size, mem_type, mem_prot); @@ -4563,6 +4573,8 @@ dump_anonymous_allocate_posix (void *base, case DUMP_MEMORY_ACCESS_READWRITE: mem_prot = PROT_READ | PROT_WRITE; break; + default: + emacs_abort (); } int mem_flags = MAP_PRIVATE | MAP_ANONYMOUS; @@ -4655,6 +4667,7 @@ dump_map_file_w32 (void *base, int fd, off_t offset, size_t size, case DUMP_MEMORY_ACCESS_READWRITE: protect = PAGE_WRITECOPY; /* for Windows 9X */ break; + default: case DUMP_MEMORY_ACCESS_NONE: case DUMP_MEMORY_ACCESS_READ: protect = PAGE_READONLY; @@ -4682,6 +4695,8 @@ dump_map_file_w32 (void *base, int fd, off_t offset, size_t size, case DUMP_MEMORY_ACCESS_READWRITE: map_access = FILE_MAP_COPY; break; + default: + emacs_abort (); } ret = MapViewOfFileEx (section, @@ -4724,6 +4739,8 @@ dump_map_file_posix (void *base, int fd, off_t offset, size_t size, mem_prot = PROT_READ | PROT_WRITE; mem_flags = MAP_PRIVATE; break; + default: + emacs_abort (); } if (base) @@ -5590,6 +5607,8 @@ dump_do_emacs_relocation (const uintptr_t dump_base, memcpy (emacs_ptr_at (reloc.emacs_offset), &lv, sizeof (lv)); break; } + default: + fatal ("unrecognied relocation type %d", (int) reloc.type); } } commit 6cfac8e3a37d7d2812a42fdfba420992208e49df Author: Pip Cet Date: Fri Jan 31 14:42:33 2025 -0800 Revert "Pacify -Wanalyzer-use-of-uninitialized-value" This reverts commit 1ed769a3cb753a86badba8a2878fa788a6fdc1f8. diff --git a/src/pdumper.c b/src/pdumper.c index 9f0447eb5aa..45a44db0243 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2292,12 +2292,11 @@ dump_float (struct dump_context *ctx, const struct Lisp_Float *lfloat) } static dump_off -dump_fwd_int (struct dump_context *ctx, void const *fwdptr) +dump_fwd_int (struct dump_context *ctx, const struct Lisp_Intfwd *intfwd) { #if CHECK_STRUCTS && !defined HASH_Lisp_Intfwd_4D887A7387 # error "Lisp_Intfwd changed. See CHECK_STRUCTS comment in config.h." #endif - struct Lisp_Intfwd const *intfwd = fwdptr; dump_emacs_reloc_immediate_intmax_t (ctx, intfwd->intvar, *intfwd->intvar); struct Lisp_Intfwd out; dump_object_start (ctx, &out, sizeof (out)); @@ -2307,12 +2306,11 @@ dump_fwd_int (struct dump_context *ctx, void const *fwdptr) } static dump_off -dump_fwd_bool (struct dump_context *ctx, void const *fwdptr) +dump_fwd_bool (struct dump_context *ctx, const struct Lisp_Boolfwd *boolfwd) { #if CHECK_STRUCTS && !defined (HASH_Lisp_Boolfwd_0EA1C7ADCC) # error "Lisp_Boolfwd changed. See CHECK_STRUCTS comment in config.h." #endif - struct Lisp_Boolfwd const *boolfwd = fwdptr; dump_emacs_reloc_immediate_bool (ctx, boolfwd->boolvar, *boolfwd->boolvar); struct Lisp_Boolfwd out; dump_object_start (ctx, &out, sizeof (out)); @@ -2322,12 +2320,11 @@ dump_fwd_bool (struct dump_context *ctx, void const *fwdptr) } static dump_off -dump_fwd_obj (struct dump_context *ctx, void const *fwdptr) +dump_fwd_obj (struct dump_context *ctx, const struct Lisp_Objfwd *objfwd) { #if CHECK_STRUCTS && !defined (HASH_Lisp_Objfwd_45D3E513DC) # error "Lisp_Objfwd changed. See CHECK_STRUCTS comment in config.h." #endif - struct Lisp_Objfwd const *objfwd = fwdptr; if (NILP (Fgethash (dump_off_to_lisp (emacs_offset (objfwd->objvar)), ctx->staticpro_table, Qnil))) @@ -2340,12 +2337,12 @@ dump_fwd_obj (struct dump_context *ctx, void const *fwdptr) } static dump_off -dump_fwd_buffer_obj (struct dump_context *ctx, void const *fwdptr) +dump_fwd_buffer_obj (struct dump_context *ctx, + const struct Lisp_Buffer_Objfwd *buffer_objfwd) { #if CHECK_STRUCTS && !defined (HASH_Lisp_Buffer_Objfwd_611EBD13FF) # error "Lisp_Buffer_Objfwd changed. See CHECK_STRUCTS comment in config.h." #endif - struct Lisp_Buffer_Objfwd const *buffer_objfwd = fwdptr; struct Lisp_Buffer_Objfwd out; dump_object_start (ctx, &out, sizeof (out)); DUMP_FIELD_COPY (&out, buffer_objfwd, type); @@ -2356,12 +2353,12 @@ dump_fwd_buffer_obj (struct dump_context *ctx, void const *fwdptr) } static dump_off -dump_fwd_kboard_obj (struct dump_context *ctx, void const *fwdptr) +dump_fwd_kboard_obj (struct dump_context *ctx, + const struct Lisp_Kboard_Objfwd *kboard_objfwd) { #if CHECK_STRUCTS && !defined (HASH_Lisp_Kboard_Objfwd_CAA7E71069) # error "Lisp_Intfwd changed. See CHECK_STRUCTS comment in config.h." #endif - struct Lisp_Kboard_Objfwd const *kboard_objfwd = fwdptr; struct Lisp_Kboard_Objfwd out; dump_object_start (ctx, &out, sizeof (out)); DUMP_FIELD_COPY (&out, kboard_objfwd, type); @@ -2375,16 +2372,29 @@ dump_fwd (struct dump_context *ctx, lispfwd fwd) #if CHECK_STRUCTS && !defined (HASH_Lisp_Fwd_Type_9CBA6EE55E) # error "Lisp_Fwd_Type changed. See CHECK_STRUCTS comment in config.h." #endif - typedef dump_off (*dump_fwd_fnptr) (struct dump_context *, void const *); - static dump_fwd_fnptr const dump_fwd_table[] = { - [Lisp_Fwd_Int] = dump_fwd_int, - [Lisp_Fwd_Bool] = dump_fwd_bool, - [Lisp_Fwd_Obj] = dump_fwd_obj, - [Lisp_Fwd_Buffer_Obj] = dump_fwd_buffer_obj, - [Lisp_Fwd_Kboard_Obj] = dump_fwd_kboard_obj, - }; + void const *p = fwd.fwdptr; + dump_off offset; - return dump_fwd_table[XFWDTYPE (fwd)] (ctx, fwd.fwdptr); + switch (XFWDTYPE (fwd)) + { + case Lisp_Fwd_Int: + offset = dump_fwd_int (ctx, p); + break; + case Lisp_Fwd_Bool: + offset = dump_fwd_bool (ctx, p); + break; + case Lisp_Fwd_Obj: + offset = dump_fwd_obj (ctx, p); + break; + case Lisp_Fwd_Buffer_Obj: + offset = dump_fwd_buffer_obj (ctx, p); + break; + case Lisp_Fwd_Kboard_Obj: + offset = dump_fwd_kboard_obj (ctx, p); + break; + } + + return offset; } static dump_off @@ -4534,19 +4544,26 @@ dump_anonymous_allocate_w32 (void *base, # define MAP_ANONYMOUS MAP_ANON # endif -static int const mem_prot_posix_table[] = { - [DUMP_MEMORY_ACCESS_NONE] = PROT_NONE, - [DUMP_MEMORY_ACCESS_READ] = PROT_READ, - [DUMP_MEMORY_ACCESS_READWRITE] = PROT_READ | PROT_WRITE, -}; - static void * dump_anonymous_allocate_posix (void *base, size_t size, enum dump_memory_protection protection) { void *ret; - int mem_prot = mem_prot_posix_table[protection]; + int mem_prot; + + switch (protection) + { + case DUMP_MEMORY_ACCESS_NONE: + mem_prot = PROT_NONE; + break; + case DUMP_MEMORY_ACCESS_READ: + mem_prot = PROT_READ; + break; + case DUMP_MEMORY_ACCESS_READWRITE: + mem_prot = PROT_READ | PROT_WRITE; + break; + } int mem_flags = MAP_PRIVATE | MAP_ANONYMOUS; if (mem_prot != PROT_NONE) @@ -4690,9 +4707,25 @@ dump_map_file_posix (void *base, int fd, off_t offset, size_t size, enum dump_memory_protection protection) { void *ret; - int mem_prot = mem_prot_posix_table[protection]; - int mem_flags = (protection == DUMP_MEMORY_ACCESS_READWRITE - ? MAP_PRIVATE : MAP_SHARED); + int mem_prot; + int mem_flags; + + switch (protection) + { + case DUMP_MEMORY_ACCESS_NONE: + mem_prot = PROT_NONE; + mem_flags = MAP_SHARED; + break; + case DUMP_MEMORY_ACCESS_READ: + mem_prot = PROT_READ; + mem_flags = MAP_SHARED; + break; + case DUMP_MEMORY_ACCESS_READWRITE: + mem_prot = PROT_READ | PROT_WRITE; + mem_flags = MAP_PRIVATE; + break; + } + if (base) mem_flags |= MAP_FIXED; commit fa6eb08dc068144281dee0b8d9c0d8bf1aa8a2d7 Author: Pip Cet Date: Fri Jan 31 14:42:33 2025 -0800 Revert "; * src/pdumper.c (dump_do_fixup): Pacify GCC. This reverts commit a99ba59aa02ef8cfd314737950b6cd8d97015925. diff --git a/src/pdumper.c b/src/pdumper.c index bfa790b963a..9f0447eb5aa 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -3990,7 +3990,7 @@ dump_do_fixup (struct dump_context *ctx, Lisp_Object arg = dump_pop (&fixup); eassert (NILP (fixup)); dump_seek (ctx, dump_fixup_offset); - intptr_t dump_value UNINIT; + intptr_t dump_value; bool do_write = true; switch (type) { commit c1006565184b945aaf5c7d98afe6ee97e6cdb090 Author: Paul Eggert Date: Fri Jan 31 14:42:33 2025 -0800 Port dest-mountpoint test to suspicious bwrap * test/lisp/emacs-lisp/bytecomp-tests.el: (bytecomp-tests--dest-mountpoint): Skip test if bwrap prohibits even ‘true’, which it does on my Ubuntu 24.10 platform. diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index f70c67875cf..25e5f483f4b 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -1736,6 +1736,12 @@ mountpoint (Bug#44631)." (set-file-modes input-file #o400) (set-file-modes output-file #o200) (set-file-modes directory #o500) + (skip-unless + (zerop (call-process + bwrap nil nil nil + "--ro-bind" "/" "/" + "--bind" unquoted-file unquoted-file + "true"))) (with-temp-buffer (let ((status (call-process bwrap nil t nil commit bd39ec062d0078c97140b8ad4ddf7c47e6f6e4ee Author: João Távora Date: Fri Jan 31 10:31:37 2025 +0000 Eglot: add server menu into main menu * lisp/progmodes/eglot.el (eglot-menu): Add separator at end and add in eglot-server menu at load-time. (eglot-server-menu): Rework menu title and description. diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index c2a8562eb97..76648f310e6 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2283,10 +2283,11 @@ If it is activated, also signal textDocument/didOpen." ["Rewrite" eglot-code-action-rewrite :visible (eglot-server-capable :codeActionProvider)] ["Quickfix" eglot-code-action-quickfix - :visible (eglot-server-capable :codeActionProvider)])) + :visible (eglot-server-capable :codeActionProvider)] + "--")) -(easy-menu-define eglot-server-menu nil "Monitor server communication" - '("Debugging the server communication" +(easy-menu-define eglot-server-menu nil "Manage server communication" + '("Server menu" ["Reconnect to server" eglot-reconnect] ["Quit server" eglot-shutdown] "--" @@ -2297,6 +2298,9 @@ If it is activated, also signal textDocument/didOpen." (interactive) (customize-variable 'eglot-events-buffer-size))])) +(add-to-list 'eglot-menu + `(eglot-server-menu menu-item "Server menu" ,eglot-server-menu) t) + ;;; Mode-line ;;; commit c2822650a214d08ad49863f8d09b6435642c9bf1 Merge: f54f798588e 4354cf73d7a Author: Eli Zaretskii Date: Fri Jan 31 10:43:35 2025 +0200 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit f54f798588ee5f0b6ba4ebbc1c1b395c19845a2f Author: Eli Zaretskii Date: Fri Jan 31 10:41:28 2025 +0200 Avoid stack overflow on MS-Windows due to 'make-temp-name' * src/fileio.c (Fexpand_file_name) [DOS_NT]: Use 'SAFE_ALLOCA' instead of 'alloca'. (Bug#75938) diff --git a/src/fileio.c b/src/fileio.c index d832967bb6b..cb131264492 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -1450,7 +1450,7 @@ the root directory. */) char *adir = NULL; if (!IS_DIRECTORY_SEP (nm[0])) { - adir = alloca (MAXPATHLEN + 1); + adir = SAFE_ALLOCA (MAXPATHLEN + 1); if (!getdefdir (c_toupper (drive) - 'A' + 1, adir)) adir = NULL; else if (multibyte) @@ -1467,7 +1467,7 @@ the root directory. */) if (!adir) { /* Either nm starts with /, or drive isn't mounted. */ - adir = alloca (4); + adir = SAFE_ALLOCA (4); adir[0] = DRIVE_LETTER (drive); adir[1] = ':'; adir[2] = '/'; @@ -1540,7 +1540,7 @@ the root directory. */) { ptrdiff_t nmlen = nmlim - nm; ptrdiff_t newdirlen = newdirlim - newdir; - char *tmp = alloca (newdirlen + file_name_as_directory_slop + char *tmp = SAFE_ALLOCA (newdirlen + file_name_as_directory_slop + nmlen + 1); ptrdiff_t dlen = file_name_as_directory (tmp, newdir, newdirlen, multibyte); @@ -1548,7 +1548,7 @@ the root directory. */) nm = tmp; nmlim = nm + dlen + nmlen; } - adir = alloca (adir_size); + adir = SAFE_ALLOCA (adir_size); if (drive) { if (!getdefdir (c_toupper (drive) - 'A' + 1, adir)) @@ -1584,7 +1584,7 @@ the root directory. */) if (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]) && !IS_DIRECTORY_SEP (newdir[2])) { - char *adir = strcpy (alloca (newdirlim - newdir + 1), newdir); + char *adir = strcpy (SAFE_ALLOCA (newdirlim - newdir + 1), newdir); char *p = adir + 2; while (*p && !IS_DIRECTORY_SEP (*p)) p++; p++; @@ -1614,7 +1614,7 @@ the root directory. */) /* Reserve space for drive specifier and escape prefix, since either or both may need to be inserted. (The Microsoft x86 compiler produces incorrect code if the following two lines are combined.) */ - target = alloca (tlen + 4); + target = SAFE_ALLOCA (tlen + 4); target += 4; #else /* not DOS_NT */ target = SAFE_ALLOCA (tlen); commit 4354cf73d7a5bdd18a5e5b385a06d9d140e8e472 Author: Martin Rudalics Date: Fri Jan 31 09:31:05 2025 +0100 In 'replace-buffer-in-windows' try to preserve current buffer (Bug#75949) * lisp/window.el (replace-buffer-in-windows): Preserve current buffer when 'kill-buffer-quit-windows' is non-nil and a window showing BUFFER shall be quit. Running 'kill-buffer-hook' relies on it (Bug#75949). diff --git a/lisp/window.el b/lisp/window.el index b91c45226a1..74bb2985254 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -5224,7 +5224,12 @@ buffer by itself." (cond ((window-minibuffer-p window)) (kill-buffer-quit-windows - (quit-restore-window window 'killing)) + ;; Try to preserve the current buffer set up by 'kill-buffer' + ;; before running the hooks on 'kill-buffer-hook' (Bug#75949). + (let ((current-buffer (current-buffer))) + (quit-restore-window window 'killing) + (when (buffer-live-p current-buffer) + (set-buffer current-buffer)))) (t (let ((dedicated-side (eq (window-dedicated-p window) 'side))) (when (or dedicated-side (not (window--delete window t 'kill))) commit 5485ea6aef91c65a0ce300347db3c0ac138ad550 Author: Stefan Kangas Date: Sun Jan 26 14:53:49 2025 +0100 Do not set `trusted-content` in major modes * lisp/progmodes/elisp-mode.el (lisp-interaction-mode): * lisp/ielm.el (inferior-emacs-lisp-mode): Do not set `trusted-content. * lisp/ielm.el (ielm): * lisp/simple.el (get-scratch-buffer-create): Set `trusted-content` here instead. * lisp/files.el (trusted-content): Doc fix; warn against setting this option to :all in a major or mode mode. Problem reported by Max Nikulin . diff --git a/etc/NEWS b/etc/NEWS index fbfb9086430..da3a1d670e7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -193,6 +193,9 @@ For example, Flymake's backend for Emacs Lisp consults this option and disables itself with an "untrusted content" warning if the file is not listed. +Emacs Lisp authors should note that a major or minor mode must never set +this variable to the ':all' value. + This option is used to fix CVE-2024-53920. See below for details. ** Emacs now supports Unicode Standard version 15.1. diff --git a/lisp/files.el b/lisp/files.el index b64935e8d9e..380721f1fe2 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -724,11 +724,12 @@ enabled (for example, when it is added to a mode hook). Each element of the list should be a string: - If it ends in \"/\", it is considered as a directory name and means that Emacs should trust all the files whose name has this directory as a prefix. -- else it is considered as a file name. +- Otherwise, it is considered a file name. Use abbreviated file names. For example, an entry \"~/mycode/\" means that Emacs will trust all the files in your directory \"mycode\". This variable can also be set to `:all', in which case Emacs will trust -all files, which opens a gaping security hole." +all files, which opens a gaping security hole. Emacs Lisp authors +should note that this value must never be set by a major or minor mode." :type '(choice (repeat :tag "List" file) (const :tag "Trust everything (DANGEROUS!)" :all)) :version "30.1") diff --git a/lisp/ielm.el b/lisp/ielm.el index 561185a738a..b3cd02b4dc0 100644 --- a/lisp/ielm.el +++ b/lisp/ielm.el @@ -580,7 +580,6 @@ Customized bindings may be defined in `ielm-map', which currently contains: ielm-fontify-input-enable (comint-fontify-input-mode)) - (setq-local trusted-content :all) (setq comint-prompt-regexp (concat "^" (regexp-quote ielm-prompt))) (setq-local paragraph-separate "\\'") (setq-local paragraph-start comint-prompt-regexp) @@ -684,7 +683,8 @@ See `inferior-emacs-lisp-mode' for details." (unless (comint-check-proc buf-name) (with-current-buffer (get-buffer-create buf-name) (unless (zerop (buffer-size)) (setq old-point (point))) - (inferior-emacs-lisp-mode))) + (inferior-emacs-lisp-mode) + (setq-local trusted-content :all))) (pop-to-buffer-same-window buf-name) (when old-point (push-mark old-point)))) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 59c33c09f0f..a573d9ef864 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -1337,8 +1337,7 @@ Semicolons start comments. \\{lisp-interaction-mode-map}" :abbrev-table nil - (setq-local lexical-binding t) - (setq-local trusted-content :all)) + (setq-local lexical-binding t)) ;;; Emacs Lisp Byte-Code mode diff --git a/lisp/simple.el b/lisp/simple.el index da4d20e4f78..152a8c451ac 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -11154,7 +11154,9 @@ too short to have a dst element. (when initial-scratch-message (insert (substitute-command-keys initial-scratch-message)) (set-buffer-modified-p nil)) - (funcall initial-major-mode)) + (funcall initial-major-mode) + (when (eq initial-major-mode 'lisp-interaction-mode) + (setq-local trusted-content :all))) scratch))) (defun scratch-buffer () commit d11488fd6fb72acd9f9356b95b2f905c59a1095d Author: Eli Zaretskii Date: Thu Jan 30 11:37:40 2025 +0200 ; * lisp/subr.el (sit-for): Doc fix. diff --git a/lisp/subr.el b/lisp/subr.el index 9666cc09a5c..7aca542dab4 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3529,13 +3529,15 @@ causes it to evaluate `help-form' and display the result." char)) (defun sit-for (seconds &optional nodisp) - "Redisplay, then wait for SECONDS seconds. Stop when input is available. + "Redisplay, then wait for SECONDS seconds; stop when input is available. SECONDS may be a floating-point value. \(On operating systems that do not support waiting for fractions of a second, floating-point values are rounded down to the nearest integer.) -If optional arg NODISP is t, don't redisplay, just wait for input. -Redisplay does not happen if input is available before it starts. +If there's pending input, return nil immediately without redisplaying +and without waiting. +If optional arg NODISP is t, don't redisplay, just wait for input (but +still return nil immediately if there's pending input). Value is t if waited the full time with no input arriving, and nil otherwise." ;; This used to be implemented in C until the following discussion: commit 0b3e050c6ce07e7b87aaab1185f605a1d8c16ba1 Author: Eli Zaretskii Date: Thu Jan 30 08:38:05 2025 +0200 * src/puresize.h (BASE_PURESIZE): Increase (bug#75907). diff --git a/src/puresize.h b/src/puresize.h index e9cbdd86022..f2576666a66 100644 --- a/src/puresize.h +++ b/src/puresize.h @@ -47,7 +47,7 @@ INLINE_HEADER_BEGIN #endif #ifndef BASE_PURESIZE -#define BASE_PURESIZE (3000000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA) +#define BASE_PURESIZE (3400000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA) #endif /* Increase BASE_PURESIZE by a ratio depending on the machine's word size. */ commit 0c6aa27cde5dc911cfd3646d5789124fecb06f46 Author: Eli Zaretskii Date: Wed Jan 29 17:55:58 2025 +0200 ; Fix Cygw32 build (bug#75926) (cherry picked from commit cb62a47896bb21420a709c655034e8acfcb08082) diff --git a/src/treesit.c b/src/treesit.c index 2805fa69aed..655eab8af8a 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -4374,7 +4374,7 @@ the symbol of that THING. For example, (or sexp sentence). */); defsubr (&Streesit_subtree_stat); #endif /* HAVE_TREE_SITTER */ defsubr (&Streesit_available_p); -#ifdef WINDOWSNT +#ifdef HAVE_NTGUI DEFSYM (Qtree_sitter__library_abi, "tree-sitter--library-abi"); Fset (Qtree_sitter__library_abi, #if HAVE_TREE_SITTER commit d0907a43888ea531a94d46d4fdbb45df9a23cc95 Author: Stefan Kangas Date: Tue Jan 28 18:45:52 2025 +0100 ; * admin/MAINTAINERS: Prefer "website" to "home page". diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS index 0851aa94674..a47af03eeee 100644 --- a/admin/MAINTAINERS +++ b/admin/MAINTAINERS @@ -397,8 +397,8 @@ Modus themes etc/themes/modus*.el Org Mode - Home Page: https://orgmode.org/ Maintainer: Org Mode developers + Website: https://orgmode.org/ Repository: https://git.savannah.gnu.org/git/emacs/org-mode.git Mailing list: emacs-orgmode@gnu.org Bug Reports: M-x org-submit-bug-report commit 1969c2c3eda4af152037a5a7fdf82a834541db41 Author: Bastien Guerry Date: Tue Jan 28 14:25:22 2025 +0100 ; * admin/MAINTAINERS: Remove Bastien Guerry. (cherry picked from commit eb73dd0d45126e693645ead7a34f113217fa48bb) diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS index 5060fc20506..0851aa94674 100644 --- a/admin/MAINTAINERS +++ b/admin/MAINTAINERS @@ -52,11 +52,6 @@ Stefan Monnier minibuffer completion lisp/outline.el -Bastien Guerry - Org - lisp/org/* - doc/misc/org.texi - Artur Malabarba lisp/emacs-lisp/let-alist.el commit 6447634f1714cbf4211b682a62915e72c934af6b Author: Stefan Kangas Date: Sun Jan 26 22:02:07 2025 +0100 ; * admin/MAINTAINERS: Add CC Mode. diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS index 8841dc0905b..5060fc20506 100644 --- a/admin/MAINTAINERS +++ b/admin/MAINTAINERS @@ -386,6 +386,14 @@ Spencer Baugh 3. Externally maintained packages. ============================================================================== +CC Mode + Maintainer: Alan Mackenzie + Website: https://www.nongnu.org/cc-mode + Repository: https://hg.savannah.nongnu.org/hgweb/cc-mode/ + Bug reports: bug-cc-mode@gnu.org + + lisp/progmodes/cc-*.el + Modus themes Maintainer: Protesilaos Stavrou Repository: https://github.com/protesilaos/modus-themes commit 486d5d524ca116a2aaed3069536a2372497551b9 Author: Stefan Kangas Date: Sun Jan 26 21:57:34 2025 +0100 Update cc-mode URL to point to nongnu.org * doc/misc/cc-mode.texi (Getting Started) (Custom Filling and Breaking, Updating CC Mode) (Mailing Lists and Bug Reports): * lisp/progmodes/cc-mode.el: Update cc-mode URL to point to nongnu.org, instead of old URL on SourceForge. diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi index abfcf03d08f..9c3e1a85fb1 100644 --- a/doc/misc/cc-mode.texi +++ b/doc/misc/cc-mode.texi @@ -581,7 +581,7 @@ you are going to be editing AWK files, @file{README} describes how to configure your (X)Emacs so that @ccmode{} will supersede the obsolete @code{awk-mode.el} which might have been supplied with your (X)Emacs. @ccmode{} might not work with older versions of Emacs or XEmacs. See -the @ccmode{} release notes at @uref{https://cc-mode.sourceforge.net} +the @ccmode{} release notes at @uref{https://www.nongnu.org/cc-mode/} for the latest information on Emacs version and package compatibility (@pxref{Updating CC Mode}). @@ -3193,7 +3193,7 @@ E. Jones' Filladapt package@footnote{It's available from lack a feature that makes it work suboptimally when @code{c-comment-prefix-regexp} matches the empty string (which it does by default). A patch for that is available from -@uref{https://cc-mode.sourceforge.net/,, the CC Mode web site}.}, +@uref{https://www.nongnu.org/cc-mode/,, the CC Mode web site}.}, @c 2005/11/22: The above is still believed to be the case. which handles things like bulleted lists nicely. There's a convenience function @code{c-setup-filladapt} that tunes the relevant variables in @@ -7660,7 +7660,7 @@ have old versions of @ccmode{} and so should be upgraded. Access to the compatibility, etc.@: are all available on the web site: @quotation -@uref{https://cc-mode.sourceforge.net/} +@uref{https://www.nongnu.org/cc-mode/} @end quotation @@ -7694,7 +7694,7 @@ the GNU Bug Tracker at @url{https://debbugs.gnu.org}, then sends it on to @email{bug-cc-mode@@gnu.org}. You can also send reports, other questions, and suggestions (kudos?@: @t{;-)} to that address. It's a mailing list which you can join or browse an archive of; see the web site at -@uref{https://cc-mode.sourceforge.net/} for further details. +@uref{https://www.nongnu.org/cc-mode/} for further details. @cindex announcement mailing list If you want to get announcements of new @ccmode{} releases, send the diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index b1b2f6268e9..992f7878a8b 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -66,7 +66,7 @@ ;; You can get the latest version of CC Mode, including PostScript ;; documentation and separate individual files from: ;; -;; https://cc-mode.sourceforge.net/ +;; https://www.nongnu.org/cc-mode/ ;; ;; You can join a moderated CC Mode announcement-only mailing list by ;; visiting @@ -172,8 +172,8 @@ ;; `c-font-lock-init' too to set up CC Mode's font lock support. ;; ;; See cc-langs.el for further info. A small example of a derived mode -;; is also available at . +;; is also available at +;; . (defun c-leave-cc-mode-mode () (when c-buffer-is-cc-mode commit 17ef46e849dd1073fc4445834519f983985135fa Author: Stefan Kangas Date: Sun Jan 26 22:58:13 2025 +0100 ; * etc/NEWS: Note CVE-2024-53920 further up also. diff --git a/etc/NEWS b/etc/NEWS index 53f75d120d2..fbfb9086430 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -188,10 +188,13 @@ expectations. This option lists those files and directories whose content Emacs should consider as sufficiently trusted to run any part of the code contained therein even without any explicit user request. + For example, Flymake's backend for Emacs Lisp consults this option and disables itself with an "untrusted content" warning if the file is not listed. +This option is used to fix CVE-2024-53920. See below for details. + ** Emacs now supports Unicode Standard version 15.1. ** Emacs now comes with Org v9.7. commit 05ee2b741f074b64c46a1063ec331e111099fc31 Author: Eli Zaretskii Date: Tue Jan 28 16:57:47 2025 +0200 ; * CONTRIBUTE: Suggest to run more tests sometimes. diff --git a/CONTRIBUTE b/CONTRIBUTE index 2b5c438c055..aa6a59cd432 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -175,6 +175,19 @@ tests via make && make -C test xt-mouse-tests +Changes in code that implements infrastructure capabilities might affect +many tests in the test suite, not just the tests for the source files +you changed. For such changes, we recommend running unit tests that +invoke the functions you have changed. You can search for the tests +that might be affected using tools like Grep. For example, suppose you +make a change in the 'rename-file' primitive. Then + + grep -Rl rename-file test --include="*.el" + +will show all the unit tests which invoke rename-file; run them all to +be sure your changes didn't break the test suite. If in doubt, run the +entire suite. + ** Commit messages Ordinarily, a changeset you commit should contain a description of the commit e74efd9a428491288be46ce56f1d6f4f7cf79ed9 Author: Michael Albinus Date: Tue Jan 28 10:12:09 2025 +0100 * CONTRIBUTE: Recommend running the unit test prior to committing. diff --git a/CONTRIBUTE b/CONTRIBUTE index e03674e5d14..2b5c438c055 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -157,8 +157,8 @@ If your test lasts longer than some few seconds, mark it in its 'ert-deftest' definition with ":tags '(:expensive-test)". To run tests on the entire Emacs tree, run "make check" from the -top-level directory. Most tests are in the directory "test/". From -the "test/" directory, run "make " to run the tests for +top-level directory. Most tests are in the directory "test/". From the +"test/" directory, run "make -tests" to run the tests for .el(c). See "test/README" for more information. If you're making changes that involve the Emacs build system, please @@ -169,6 +169,12 @@ test 'out-of-tree' builds as well, i.e.: ../path-to-emacs-sources/configure make +It is a good practice to run the unit test of a change prior to committing. +If you have changed, e.g., the file "xt-mouse.el", you can run the unit +tests via + + make && make -C test xt-mouse-tests + ** Commit messages Ordinarily, a changeset you commit should contain a description of the commit a9cde2463abd6677e9d44d306473beef00983aad Author: Yuan Fu Date: Mon Jan 20 20:36:41 2025 -0800 Don't signal an error in treesit-node-at * lisp/treesit.el (treesit-node-at): Wrap treesit-buffer-root-node within condition-case. diff --git a/lisp/treesit.el b/lisp/treesit.el index 2887521110b..2aa49a596d8 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -213,9 +213,11 @@ language and doesn't match the language of the local parser." (car (treesit-local-parsers-at pos parser-or-lang)))) (treesit-parser-root-node parser)) - (treesit-buffer-root-node - (or parser-or-lang - (treesit-language-at pos)))))) + (condition-case nil + (treesit-buffer-root-node + (or parser-or-lang + (treesit-language-at pos))) + (treesit-no-parser nil))))) (node root) (node-before root) (pos-1 (max (1- pos) (point-min))) commit 5d021a711a9885100e4ab9d5bb286505a2a16827 Author: Eli Zaretskii Date: Mon Jan 27 15:19:06 2025 +0200 ; Improve documentation of '.dir-locals.el' * doc/lispref/variables.texi (Directory Local Variables): * doc/emacs/custom.texi (Directory Variables): Document that '.dir-locals-2.el' must be in the same directory as '.dir-locals.el'. (Bug#75890) diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index 22c8bf417e3..4432a0834aa 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -1421,10 +1421,11 @@ this search is skipped for remote files. If needed, the search can be extended for remote files by setting the variable @code{enable-remote-dir-locals} to @code{t}. - You can also use @file{.dir-locals-2.el}; if found, Emacs loads it -in addition to @file{.dir-locals.el}. This is useful when -@file{.dir-locals.el} is under version control in a shared repository -and can't be used for personal customizations. + You can also use @file{.dir-locals-2.el}; if found in the same +directory as @file{.dir-locals.el}, Emacs loads it in addition to +@file{.dir-locals.el}. This is useful when @file{.dir-locals.el} is +under version control in a shared repository and can't be used for +personal customizations. The @file{.dir-locals.el} file should hold a specially-constructed list, which maps major mode names (symbols) to alists diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 106a7a592b9..b56dfb6077b 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -2205,8 +2205,9 @@ If some of the subdirectories have their own @file{.dir-locals.el} files, Emacs uses the settings from the deepest file it finds starting from the file's directory and moving up the directory tree. This constant is also used to derive the name of a second dir-locals file -@file{.dir-locals-2.el}. If this second dir-locals file is present, -then that is loaded in addition to @file{.dir-locals.el}. This is useful +@file{.dir-locals-2.el}. If this second dir-locals file is present in +the same directory as @file{.dir-locals.el}, then it will be loaded in +addition to @file{.dir-locals.el}. This is useful when @file{.dir-locals.el} is under version control in a shared repository and cannot be used for personal customizations. The file specifies local variables as a specially formatted list; see commit 84595cbcc78b1ea44302f22b83a7d722940c6e49 Author: Eshel Yaron Date: Sun Jan 26 08:56:15 2025 +0100 ; (let-alist): Document double-dot escape syntax. (Bug#75852) diff --git a/lisp/emacs-lisp/let-alist.el b/lisp/emacs-lisp/let-alist.el index 27ce3e5c137..15a9bb89a42 100644 --- a/lisp/emacs-lisp/let-alist.el +++ b/lisp/emacs-lisp/let-alist.el @@ -141,6 +141,12 @@ the variables of the outer one. You can, however, access alists inside the original alist by using dots inside the symbol, as displayed in the example above. +To refer to a non-`let-alist' variable starting with a dot in BODY, use +two dots instead of one. For example, in the following form `..foo' +refers to the variable `.foo' bound outside of the `let-alist': + + (let ((.foo 42)) (let-alist \\='((foo . nil)) ..foo)) + Note that there is no way to differentiate the case where a key is missing from when it is present, but its value is nil. Thus, the following form evaluates to nil: commit 5617b07a45bedcaa94591e941d06a3255e06302f Author: Stefan Kangas Date: Sun Jan 26 22:39:10 2025 +0100 ; Prefer HTTPS to HTTP in docs * doc/emacs/android.texi (Android Software): * doc/lispref/frames.texi (X Selections): * doc/misc/cc-mode.texi (Custom Filling and Breaking): * doc/misc/efaq.texi (Basic editing): * doc/misc/gnus.texi (Propagating marks, Spam Statistics Package): * doc/misc/org.org (External Links, Images in HTML export) (LaTeX Export, LaTeX math snippets): Prefer HTTPS to HTTP. Fix or mark some broken links while we're at it. diff --git a/doc/emacs/android.texi b/doc/emacs/android.texi index 53c53723074..a1801d378ea 100644 --- a/doc/emacs/android.texi +++ b/doc/emacs/android.texi @@ -1179,7 +1179,7 @@ from improved reproductions of Unix command-line utilities to package repositories providing extensive collections of free GNU and Unix software. - @uref{http://busybox.net, Busybox} provides Unix utilities and + @uref{https://busybox.net, Busybox} provides Unix utilities and limited replicas of certain popular GNU programs such as @command{wget} in a single statically-linked Linux binary, which is capable of running under Android. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 53cc73a1650..2426c9c890f 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -4222,7 +4222,7 @@ selection targets that the owner supports, and @code{MULTIPLE}, used for internal purposes by X clients. A selection owner may support any number of other targets, some of which may be standardized by the X Consortium's -@url{http://x.org/releases/X11R7.6/doc/xorg-docs/specs/ICCCM/icccm.html, +@url{https://x.org/releases/X11R7.6/doc/xorg-docs/specs/ICCCM/icccm.html, Inter-Client Communication Conventions Manual}, while others, such as @code{UTF8_STRING}, were meant to be standardized by the XFree86 Project, but their standardization was never completed. diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi index 65f178c2fa5..abfcf03d08f 100644 --- a/doc/misc/cc-mode.texi +++ b/doc/misc/cc-mode.texi @@ -3189,7 +3189,7 @@ margins of the texts kept intact: @cindex Filladapt mode It's also possible to use other adaptive filling packages, notably Kyle E. Jones' Filladapt package@footnote{It's available from -@uref{http://www.wonderworks.com/}. As of version 2.12, it does however +@uref{https://elpa.gnu.org/packages/filladapt.html}. As of version 2.12, it does however lack a feature that makes it work suboptimally when @code{c-comment-prefix-regexp} matches the empty string (which it does by default). A patch for that is available from diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index 5e4117d4898..4f936014ed1 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -481,7 +481,7 @@ Emacs help works best if it is invoked by a single key whose value should be stored in the variable @code{help-char}. Some Emacs slides and tutorials can be found at -@uref{http://web.psung.name/emacs/}. +@uref{https://web.psung.name/emacs/}. @node Learning how to do something @section How do I find out how to do something in Emacs? diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 7bfe580f768..4d278dc3754 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -22380,6 +22380,7 @@ First of: you really need a patched mairix binary for using the marks propagation feature efficiently. Otherwise, you would have to update the mairix database all the time. You can get the patch at +@c FIXME: This link is broken as of 2025-01-26. @uref{http://www.randomsample.de/mairix-maildir-patch.tar} You need the mairix v0.21 source code for this patch; everything else @@ -26049,7 +26050,7 @@ never install such a back end. @cindex spam filtering, naive Bayesian Paul Graham has written an excellent essay about spam filtering using -statistics: @uref{http://www.paulgraham.com/spam.html,A Plan for +statistics: @uref{https://www.paulgraham.com/spam.html,A Plan for Spam}. In it he describes the inherent deficiency of rule-based filtering as used by SpamAssassin, for example: Somebody has to write the rules, and everybody else has to install these rules. You are diff --git a/doc/misc/org.org b/doc/misc/org.org index 98c416c5da4..363a95fa65c 100644 --- a/doc/misc/org.org +++ b/doc/misc/org.org @@ -3403,7 +3403,7 @@ options: | Link Type | Example | |------------+--------------------------------------------------------------------| -| http | =http://staff.science.uva.nl/c.dominik/= | +| http | =https://staff.science.uva.nl/c.dominik/= | | https | =https://orgmode.org/= | | doi | =doi:10.1000/182= | | file | =file:/home/dominik/images/jupiter.jpg= | @@ -13633,7 +13633,7 @@ backend by default in-lines that image. For example: ~org-html-inline-images~. On the other hand, if the description part of the Org link is itself -another link, such as =file:= or =http:= URL pointing to an image, the +another link, such as =file:= or =https:= URL pointing to an image, the HTML export backend in-lines this image and links to the main image. This Org syntax enables the backend to link low-resolution thumbnail to the high-resolution version of the image, as shown in this example: @@ -13938,7 +13938,7 @@ terminology. You may refer to https://tug.org/begin.html to get familiar with LaTeX basics. Users with LaTeX installed may also run =texdoc latex= from terminal to open LaTeX introduction [fn:: The command will open a PDF file, which is also available for download -from http://mirrors.ctan.org/info/latex-doc-ptr/latex-doc-ptr.pdf] +from https://mirrors.ctan.org/info/latex-doc-ptr/latex-doc-ptr.pdf] *** LaTeX/PDF export commands :PROPERTIES: @@ -15220,7 +15220,7 @@ document in one of the following ways: ~org-latex-to-mathml-jar-file~. If you prefer to use MathToWeb[fn:: See - [[http://www.mathtoweb.com/cgi-bin/mathtoweb_home.pl][MathToWeb]].] + [[https://mathtoweb.sourceforge.io/][MathToWeb]].] as your converter, you can configure the above variables as shown below. commit fdd23023c84f873984aed62ef58699c09ee5ef20 Author: Stefan Kangas Date: Sun Jan 26 21:52:21 2025 +0100 ; * admin/MAINTAINERS: Sort external packages alphabetically. diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS index 2317337303b..8841dc0905b 100644 --- a/admin/MAINTAINERS +++ b/admin/MAINTAINERS @@ -386,25 +386,6 @@ Spencer Baugh 3. Externally maintained packages. ============================================================================== -Tramp - Maintainer: Michael Albinus - Repository: https://git.savannah.gnu.org/git/tramp.git - Mailing List: tramp-devel@gnu.org - Bug Reports: M-x tramp-bug - Notes: For backward compatibility requirements, see - lisp/net/trampver.el. - - lisp/net/tramp*.el - doc/misc/tramp*.texi - test/lisp/net/tramp*-tests.el - -Transient - Maintainer: Jonas Bernoulli - Repository: https://github.com/magit/transient - - lisp/transient.el - doc/misc/transient.texi - Modus themes Maintainer: Protesilaos Stavrou Repository: https://github.com/protesilaos/modus-themes @@ -429,6 +410,25 @@ Org Mode doc/misc/org.org doc/misc/org-setup.org +Tramp + Maintainer: Michael Albinus + Repository: https://git.savannah.gnu.org/git/tramp.git + Mailing List: tramp-devel@gnu.org + Bug Reports: M-x tramp-bug + Notes: For backward compatibility requirements, see + lisp/net/trampver.el. + + lisp/net/tramp*.el + doc/misc/tramp*.texi + test/lisp/net/tramp*-tests.el + +Transient + Maintainer: Jonas Bernoulli + Repository: https://github.com/magit/transient + + lisp/transient.el + doc/misc/transient.texi + ;;; Local Variables: ;;; coding: utf-8 commit 74dcfe155a9cd42fe4d352f031297169bf3abb41 Author: Stefan Kangas Date: Sun Jan 26 21:37:56 2025 +0100 ; * etc/NEWS: Remove temporary documentation markers. diff --git a/etc/NEWS b/etc/NEWS index 69ee6da62e9..53f75d120d2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -15,16 +15,9 @@ in older Emacs versions. You can narrow news to a specific version by calling 'view-emacs-news' with a prefix argument or by typing 'C-u C-h C-n'. -Temporary note: -+++ indicates that all relevant manuals in doc/ have been updated. ---- means no change in the manuals is needed. -When you add a new item, use the appropriate mark if you are sure it -applies, and please also update docstrings as needed. - * Installation Changes in Emacs 30.1 ---- ** Native compilation is now enabled by default. 'configure' will enable the Emacs Lisp native compiler, so long as libgccjit is present and functional on the system. To disable native @@ -32,20 +25,17 @@ compilation, configure Emacs with the option: ./configure --with-native-compilation=no -+++ ** Emacs has been ported to the Android operating system. This requires Emacs to be compiled on another computer. The Android NDK, SDK, and a suitable Java compiler must also be installed. See the file "java/INSTALL" for more details. ---- ** Native JSON support is now always available; libjansson is no longer used. No external library is required. The '--with-json' configure option has been removed. 'json-available-p' now always returns non-nil and is only kept for compatibility. ---- ** Emacs now defaults to the ossaudio library for sound on NetBSD and OpenBSD. Previously, configure used ALSA libraries if installed on the system when configured '--with-sound=yes' (which is the default), with fallback @@ -55,7 +45,6 @@ and to resolve potential incompatibilities between GNU/Linux and *BSD versions of ALSA. Use '--with-sound=alsa' to build with ALSA on these operating systems instead. ---- ** New configuration option '--disable-gc-mark-trace'. This disables the GC mark trace buffer for about 5% better garbage collection performance. Doing so may make it more difficult for Emacs @@ -65,7 +54,6 @@ why the mark trace buffer is enabled by default. * Startup Changes in Emacs 30.1 ---- ** On GNU/Linux, Emacs is now the default application for 'org-protocol'. Org mode provides a way to quickly capture bookmarks, notes, and links using 'emacsclient': @@ -79,7 +67,6 @@ arranges for Emacs to be the default application for the 'org-protocol' URI scheme. See the Org mode manual, Info node "(org) Protocols" for more details. -+++ ** New variable lets Lisp code read emacsclient arguments. When '--eval' is passed to emacsclient and Emacs is evaluating each argument, the new variable 'server-eval-args-left' is set to those @@ -92,7 +79,6 @@ escaping (to protect them from the shell). * Incompatible Changes in Emacs 30.1 ---- ** Tree-Sitter modes are now declared as submodes of the non-TS modes. In order to help the use of those Tree-Sitter modes, they are now declared to have the corresponding non-Tree-Sitter mode as an @@ -133,7 +119,6 @@ variants of major modes are available, because that variable overrides the remapping Emacs might decide to perform as result of loading Lisp files and features. ---- ** Mouse wheel events should now always be 'wheel-up/down/left/right'. At those places where the old 'mouse-4/5/6/7' events could still occur (i.e., X11 input in the absence of XInput2, and 'xterm-mouse-mode'), @@ -143,7 +128,6 @@ The old variables 'mouse-wheel-up-event', 'mouse-wheel-down-event', 'mouse-wheel-left-event', and 'mouse-wheel-right-event' are thereby obsolete. -+++ ** 'completion-auto-help' now affects 'icomplete-in-buffer'. Previously, 'completion-auto-help' mostly affected only minibuffer completion. Now, if 'completion-auto-help' has the value 'lazy', then @@ -153,7 +137,6 @@ after the 'completion-at-point' command has been invoked twice, and if completely suppressed. Thus, if you use 'icomplete-in-buffer', ensure 'completion-auto-help' is not customized to 'lazy' or nil. -+++ ** The "*Completions*" buffer now always accompanies 'icomplete-in-buffer'. Previously, it was not consistent whether the "*Completions*" buffer would appear when using 'icomplete-in-buffer'. Now the "*Completions*" buffer @@ -164,27 +147,23 @@ to your init file: (advice-add 'completion-at-point :after #'minibuffer-hide-completions) ---- ** The default process filter was rewritten in native code. The round-trip through the Lisp function 'internal-default-process-filter' is skipped when the process filter is the default one. It is reimplemented in native code, reducing GC churn. To undo this change, set 'fast-read-process-output' to nil. -+++ ** Network Security Manager now warns about 3DES by default. This cypher is no longer recommended owing to a major vulnerability disclosed in 2016, and its small 112 bit key size. Emacs now warns about its use also when 'network-security-level' is set to 'medium' (the default). See 'network-security-protocol-checks'. ---- ** Network Security Manager now warns about <2048 bits in DH key exchange. Emacs used to warn for ephemeral Diffie-Hellman (DHE) key exchanges with prime numbers smaller than 1024 bits. Since more servers now support it, this number has been bumped to 2048 bits. -+++ ** URL now never sends user email addresses in HTTP requests. Emacs never sent email addresses by default, but it used to be possible to customize 'url-privacy-level' so that the user's email @@ -196,7 +175,6 @@ removed, as it was considered more dangerous than useful. RFC 9110 To send an email address in the header of individual HTTP requests, see the variable 'url-request-extra-headers'. ---- ** 'pixel-scroll-precision-mode' sets 'make-cursor-line-fully-visible'. 'pixel-scroll-precision-mode' sets 'make-cursor-line-fully-visible' to a nil value globally, since the usual requirement of the Emacs display to @@ -206,7 +184,6 @@ expectations. * Changes in Emacs 30.1 -+++ ** New user option 'trusted-content' to allow potentially dangerous features. This option lists those files and directories whose content Emacs should consider as sufficiently trusted to run any part of the code contained @@ -215,14 +192,11 @@ For example, Flymake's backend for Emacs Lisp consults this option and disables itself with an "untrusted content" warning if the file is not listed. ---- ** Emacs now supports Unicode Standard version 15.1. -+++ ** Emacs now comes with Org v9.7. See the file "etc/ORG-NEWS" for user-visible changes in Org. -+++ ** Improved support for touchscreen devices. On systems that understand them (at present X, Android, PGTK, and MS-Windows), many touch screen gestures are now implemented and @@ -231,7 +205,6 @@ bar buttons and opening menus has been added. Countless packages, such as Dired and Custom, have been adjusted to better understand touch screen input. -+++ ** Support for styled underline face attributes. These are implemented as new values of the 'style' attribute in a face underline specification, 'double-line', 'dots', and 'dashes', and are @@ -240,36 +213,30 @@ database entry defines the 'Su' or 'Smulx' capability, Emacs will also emit the prescribed escape sequence to render faces with such styles on TTY frames. ---- ** Support for underline colors on TTY frames. Colors specified in the underline face will now also be displayed on TTY frames on terminals that support the 'Su' or 'Smulx' capabilities. -+++ ** Modeline elements can now be right-aligned. Anything following the symbol 'mode-line-format-right-align' in 'mode-line-format' will be right-aligned. Exactly where it is right-aligned to is controlled by the new user option 'mode-line-right-align-edge'. ---- ** X selection requests are now handled much faster and asynchronously. This means it should be less necessary to disable the likes of 'select-active-regions' when Emacs is running over a slow network connection. ---- ** Emacs now updates invisible frames that are made visible by a compositor. If an invisible or an iconified frame is shown to the user by the compositing manager, Emacs will now redisplay such a frame even though 'frame-visible-p' returns nil or 'icon' for it. This can happen, for example, as part of preview for iconified frames. -+++ ** Most file notification backends detect unmounting of a watched filesystem. The only exception is w32notify. -+++ ** The ':map' property of images is now recomputed when image is transformed. Images with clickable maps now work as expected after you run commands such as 'image-increase-size', 'image-decrease-size', 'image-rotate', @@ -279,13 +246,11 @@ from recomputing image maps. ** Minibuffer and Completions -+++ *** New commands 'previous-line-completion' and 'next-line-completion'. Bound to '' and '' arrow keys, respectively, they navigate the "*Completions*" buffer vertically by lines, wrapping at the top/bottom when 'completion-auto-wrap' is non-nil. -+++ *** New user option 'minibuffer-visible-completions'. When customized to non-nil, you can use arrow keys in the minibuffer to navigate the completions displayed in the "*Completions*" window. @@ -294,7 +259,6 @@ completions window. When the completions window is not visible, then all these keys have their usual meaning in the minibuffer. This option is supported for in-buffer completion as well. ---- *** Selected completion candidates are deselected on typing. When you type at the minibuffer prompt, the current completion candidate will be un-highlighted, and point in the "*Completions*" window @@ -306,13 +270,11 @@ the minibuffer contents instead. This deselection behavior can be controlled with the new user option 'completion-auto-deselect', which is t by default. -+++ *** New value 'historical' for user option 'completions-sort'. When 'completions-sort' is set to 'historical', completion candidates will be first sorted alphabetically, and then re-sorted by their order in the minibuffer history, with more recent candidates appearing first. -+++ *** 'completion-category-overrides' supports more metadata. The new supported completion properties are 'cycle-sort-function', 'display-sort-function', 'annotation-function', 'affixation-function', @@ -320,21 +282,18 @@ and 'group-function'. You can now customize them for any category in 'completion-category-overrides' that will override the properties defined in completion metadata. -+++ *** 'completion-extra-properties' supports more metadata. The new supported completion properties are 'category', 'group-function', 'display-sort-function', and 'cycle-sort-function'. ** Windows -+++ *** New command 'toggle-window-dedicated'. This makes it easy to interactively mark a specific window as dedicated, so it won't be reused by 'display-buffer'. This can be useful for complicated window setups. It is bound to 'C-x w d' globally. -+++ *** "d" in the mode line now indicates that the window is dedicated. Windows have always been able to be dedicated to a specific buffer; see 'window-dedicated-p'. Now the mode line indicates the dedicated @@ -343,7 +302,6 @@ dedicated and "D" if the window is strongly dedicated. This indicator appears before the buffer name, and after the buffer modification and remote buffer indicators (usually "---" together). -+++ *** New action alist entry 'some-window' for 'display-buffer'. It specifies which window 'display-buffer-use-some-window' should prefer. For example, when 'display-buffer-base-action' is customized to @@ -351,25 +309,21 @@ For example, when 'display-buffer-base-action' is customized to in the same most recently used window from consecutive calls of 'display-buffer' (in a configuration with more than two windows). -+++ *** New action alist entry 'category' for 'display-buffer'. If the caller of 'display-buffer' passes '(category . symbol)' in its 'action' argument, you can match the displayed buffer by adding '(category . symbol)' to the condition part of 'display-buffer-alist' entries. -+++ *** New action alist entry 'post-command-select-window' for 'display-buffer'. It specifies whether the window of the displayed buffer should be selected or deselected at the end of executing the current command. -+++ *** New variable 'window-restore-killed-buffer-windows'. It specifies how 'set-window-configuration' and 'window-state-put' should proceed with windows whose buffer was killed after the corresponding configuration or state was recorded. ---- *** New variable 'window-point-context-set-function'. It can be used to set a context for window point in all windows by 'window-point-context-set' before calling 'current-window-configuration' @@ -379,14 +333,12 @@ and 'window-state-get'. Then later another new variable 'window-state-put' to restore positions of window points according to the context stored in a window parameter. -+++ *** New functions 'set-window-cursor-type' and 'window-cursor-type'. 'set-window-cursor-type' sets a per-window cursor type, and 'window-cursor-type' queries this setting for a given window. Windows are always created with a 'window-cursor-type' of t, which means to consult the variable 'cursor-type' as before. ---- *** The user option 'display-comint-buffer-action' is now obsolete. You can use a '(category . comint)' condition in 'display-buffer-alist' to match buffers displayed by comint-related commands. Another @@ -395,60 +347,50 @@ for which you can use '(category . tex-shell)'. ** Tool bars -+++ *** Tool bars can now be placed on the bottom on more systems. The 'tool-bar-position' frame parameter can be set to 'bottom' on all window systems other than macOS and GNUstep (Nextstep). -+++ *** New global minor mode 'modifier-bar-mode'. When this minor mode is enabled, the tool bar displays buttons representing modifier keys. Clicking on these buttons applies the corresponding modifiers to the next input event. -+++ *** New user option 'tool-bar-always-show-default'. When non-nil, the tool bar at the top of a frame does not show buffer local customization of the tool bar. The default value is nil. ** Tab Bars and Tab Lines ---- *** New user option 'tab-bar-select-restore-context'. It uses 'window-point-context-set' to save contexts where window points were located before switching away from the tab, and 'window-point-context-use' to restore positions of window points after switching back to that tab. ---- *** New user option 'tab-bar-select-restore-windows'. It defines what to do with windows whose buffer was killed since the tab was last selected. By default it displays a placeholder buffer with the name " *Old buffer *" that provides information about the name of the killed buffer that was displayed in that window. ---- *** New user option 'tab-bar-tab-name-format-functions'. It can be used to add, remove and reorder functions that change the appearance of every tab on the tab bar. ---- *** New hook 'tab-bar-tab-post-select-functions'. ---- *** New keymap 'tab-bar-mode-map'. By default it contains a keybinding 'C-TAB' to switch tabs, but only when 'C-TAB' is not bound globally. You can unbind it if it conflicts with 'C-TAB' in other modes. ---- *** New keymap 'tab-line-mode-map'. By default it contains keybindings for switching tabs: 'C-x ', 'C-x ', 'C-x C-', 'C-x C-'. You can unbind them if you want to use these keys for the commands 'previous-buffer' and 'next-buffer'. ---- *** Default list of tab-line tabs is changed to support a fixed order. This means that 'tab-line-tabs-fixed-window-buffers', the new default tabs function, is like the previous 'tab-line-tabs-window-buffers' where @@ -458,29 +400,24 @@ original order of buffers on the tab line, even after switching between these buffers. You can drag the tabs and release at a new position to manually reorder the buffers on the tab line. ---- *** New user option 'tab-line-tabs-buffer-group-function'. It provides two choices to group tab buffers by major mode and by project name. ---- *** Buffers on tab-line group tabs are now sorted alphabetically. This will keep the fixed order of tabs, even after switching between them. ** Help -+++ *** New command 'help-find-source'. Switch to a buffer visiting the source of what is being described in "*Help*". It is bound to 'C-h 4 s' globally. ---- *** New user option 'describe-bindings-outline-rules'. This user option controls outline visibility in the output buffer of 'describe-bindings' when 'describe-bindings-outline' is non-nil. ---- *** 'describe-function' shows the function's inferred type when available. For native compiled Lisp functions, 'describe-function' prints (after the signature) the automatically inferred function type as well. If the @@ -489,18 +426,15 @@ function's type was explicitly declared (via the 'declare' form's controlled by the new user option 'help-display-function-type', which is by default t; customize to nil to disable function type display. ---- *** 'describe-function' now shows the type of the function object. The text used to say things like "car is a built-in function" whereas it now says "car is a primitive-function" where "primitive-function" is the name of the symbol returned by 'cl-type-of'. You can click on those words to get information about that type. ---- *** 'C-h m' ('describe-mode') uses outlining by default. Set 'describe-mode-outline' to nil to get back the old behavior. ---- *** 'C-h k' ('describe-key') shows Unicode name. For keybindings which produce single characters via translation or input methods, 'C-h k' now shows the Unicode name of the produced character in @@ -510,7 +444,6 @@ addition to the character itself, e.g. € 'EURO SIGN' (translated from C-x 8 E) ---- *** 'C-h b' ('describe-bindings') shows Unicode names. For keybindings which produce single characters via translation (such as those using the 'C-x 8' or 'A-' prefix, or 'dead-acute', 'dead-grave', @@ -522,54 +455,42 @@ itself, i.e. and so on. -+++ *** Multi-character key echo now ends with a suggestion to use Help. Customize 'echo-keystrokes-help' to nil to prevent that. ** Customize -+++ *** New command 'customize-dirlocals'. This command pops up a buffer to edit the settings in ".dir-locals.el". ---- *** New command 'customize-toggle-option'. This command can toggle boolean options for the duration of a session. -+++ *** New prefix argument for modifying directory-local variables. The commands 'add-dir-local-variable', 'delete-dir-local-variable' and 'copy-file-locals-to-dir-locals' now take an optional prefix argument, to enter the file name where you want to modify directory-local variables. -+++ *** New user option 'safe-local-variable-directories'. This user option names directories in which Emacs will treat all directory-local variables as safe. -+++ ** CL Print -+++ *** There is a new chapter in the CL manual documenting cl-print.el. See the Info node "(cl) Printing". -+++ *** You can expand the "..." truncation everywhere. The code that allowed "..." to be expanded in the "*Backtrace*" buffer should now work anywhere the data is generated by 'cl-print'. -+++ *** The 'backtrace-ellipsis' button is replaced by 'cl-print-ellipsis'. -+++ *** hash-tables' contents can be expanded via the ellipsis. -+++ *** Modes can control the expansion via 'cl-print-expand-ellipsis-function'. -+++ *** New setting 'raw' for 'cl-print-compiled'. This setting causes byte-compiled functions to be printed in full by 'prin1'. A button on this output can be activated to disassemble the @@ -577,28 +498,23 @@ function. ** Miscellaneous -+++ *** New command 'kill-matching-buffers-no-ask'. This works like 'kill-matching-buffers', but without asking for confirmation. -+++ *** 'recover-file' can show diffs between auto save file and current file. When answering the prompt with "diff" or "=", it now shows the diffs between the auto save file and the current file. -+++ *** 'read-passwd' can toggle the visibility of passwords. Use 'TAB' in the minibuffer to show or hide the password. Alternatively, click the new show-password icon on the mode-line with 'mouse-1' to toggle the visibility of the password. -+++ *** 'advice-remove' is now an interactive command. When called interactively, 'advice-remove' now prompts for an advised function to the advice to remove. ---- *** New user option 'uniquify-dirname-transform'. This can be used to customize how buffer names are uniquified, by making arbitrary transforms on the buffer's directory name (whose @@ -607,70 +523,57 @@ can use this to distinguish between buffers visiting files with the same base name that belong to different projects by using the provided transform function 'project-uniquify-dirname-transform'. -+++ *** New user option 'remote-file-name-inhibit-delete-by-moving-to-trash'. When non-nil, this option suppresses moving remote files to the local trash when deleting. Default is nil. ---- *** New user option 'remote-file-name-inhibit-auto-save'. If this user option is non-nil, 'auto-save-mode' will not auto-save remote buffers. The default is nil. -+++ *** New user option 'remote-file-name-access-timeout'. If a positive number, this option limits the call of 'access-file' for remote files to that number of seconds. Default is nil. -+++ *** New user option 'yes-or-no-prompt'. This allows the user to customize the prompt that is appended by 'yes-or-no-p' when asking questions. The default value is "(yes or no) ". ---- *** New user option 'menu-bar-close-window'. When non-nil, selecting "Close" from the "File" menu or clicking "Close" in the tool bar will result in the current window being deleted, if possible. The default is nil, and these gestures kill the buffer shown in the current window, but don't delete the window. ---- *** New face 'display-time-date-and-time'. This is used for displaying the time and date components of 'display-time-mode'. ---- *** New face 'appt-notification' for 'appt-display-mode-line'. It can be used to customize the look of the appointment notification displayed on the mode line when 'appt-display-mode-line' is non-nil. ---- *** New icon images for general use. Several symbolic icons have been added to "etc/images/symbols", including plus, minus, check-mark, star, etc. ---- *** Emacs now recognizes shebang lines that pass '-S'/'--split-string' to 'env'. When visiting a script that invokes 'env -S INTERPRETER ARGS...' in its shebang line, Emacs will now skip over 'env -S' and deduce the major mode based on the interpreter after 'env -S'. -+++ *** 'insert-directory-program' is now a user option. On *BSD and macOS systems, this user option now defaults to the "gls" executable, if it exists. This should remove the need to change its value when installing GNU coreutils using something like ports or Homebrew. -+++ *** 'write-region-inhibit-fsync' now defaults to t in interactive mode. This is the default in batch mode since Emacs 24. ---- *** The default value of 'read-process-output-max' was increased to 65536. -+++ *** 'url-gateway-broken-resolution' is now obsolete. This option was intended for use on SunOS 4.x and Ultrix systems, neither of which have been supported by Emacs since version 23.1. @@ -680,7 +583,6 @@ The user option 'url-gateway-nslookup-program' and the command * Editing Changes in Emacs 30.1 -+++ ** New minor mode 'visual-wrap-prefix-mode'. When enabled, continuation lines displayed for a wrapped long line will receive a 'wrap-prefix' automatically computed from the line's @@ -694,7 +596,6 @@ buffers. (This minor mode is the 'adaptive-wrap' ELPA package renamed and lightly edited for inclusion in Emacs.) -+++ ** New global minor mode 'kill-ring-deindent-mode'. When enabled, text being saved to the kill ring will be de-indented by the column number at its start. For example, saving the entire @@ -716,7 +617,6 @@ long_function_with_several_arguments (argument_1_compute (), This omits the two columns of extra indentation that would otherwise be copied from the second and third lines and saved to the kill ring. ---- ** New command 'replace-regexp-as-diff'. It reads a regexp to search for and a string to replace with, then displays a buffer with replacements as diffs. After reviewing the @@ -726,7 +626,6 @@ a patch to the current file buffer. There are also new commands in a list of specified files, and 'dired-do-replace-regexp-as-diff' that shows as diffs replacements in the marked files in Dired. -+++ ** New mode of prompting for register names and showing preview. The new user option 'register-use-preview' can be customized to the value t or 'insist' to request a different user interface of prompting for @@ -739,7 +638,6 @@ The default value of 'register-use-preview' ('traditional') preserves the behavior of Emacs 29 and before. See the Info node "(emacs) Registers" for more details about the new UI and its variants. -+++ ** New advanced macro counter commands. New commands have been added to implement advanced macro counter functions. @@ -755,7 +653,6 @@ The commands 'C-x C-k C-q =', 'C-x C-k C-q <', and 'C-x C-k C-q >' compare the macro counter with an optional prefix and terminate the macro if the comparison succeeds. -+++ ** New mode 'kmacro-menu-mode' and new command 'list-keyboard-macros'. The new command 'list-keyboard-macros' is the keyboard-macro version of commands like 'list-buffers' and 'list-processes', creating a listing @@ -764,19 +661,16 @@ of the currently existing keyboards macros using the new mode duplicating them, deleting them, and editing their counters, formats, and keys. ---- ** On X, Emacs now supports input methods which perform "string conversion". This means an input method can now ask Emacs to delete text surrounding point and replace it with something else, as well as query Emacs for surrounding text. If your input method allows you to "undo" mistaken compositions, this will now work as well. ---- ** New user option 'duplicate-region-final-position'. It controls the placement of point and the region after duplicating a region with 'duplicate-dwim'. -+++ ** New user option 'mouse-prefer-closest-glyph'. When enabled, clicking or dragging with the mouse will put the point or start the drag in front of the buffer position corresponding to the @@ -787,14 +681,12 @@ whereas if the mouse pointer is in the left half of a glyph, point will be put in front the buffer position corresponding to that glyph. By default this is disabled. ---- ** New pre-defined values for 'electric-quote-chars'. The available customization options for 'electric-quote-chars' have been updated with common pairs of quotation characters, including "‘", "’", "“", "”", "«", "»", "‹", "›", "‚", "„", "「", "」", "『", and "』". The default is unchanged. -+++ ** 'M-TAB' now invokes 'completion-at-point' in Text mode. By default, Text mode no longer binds 'M-TAB' to 'ispell-complete-word'. Instead, this mode arranges for 'completion-at-point', globally bound to @@ -805,7 +697,6 @@ customizing the new user option 'text-mode-ispell-word-completion'. ** Internationalization ---- *** Mode-line mnemonics for some coding-systems have changed. The mode-line mnemonic for 'utf-7' is now the lowercase 'u', to be consistent with the other encodings of this family. @@ -821,7 +712,6 @@ previous behavior of showing 'U' in the mode line for 'koi8-u': (coding-system-put 'koi8-u :mnemonic ?U) ---- *** 'vietnamese-tcvn' is now a coding system alias for 'vietnamese-vscii'. VSCII-1 and TCVN-5712 are different names for the same character encoding. Therefore, the duplicate coding system definition has been @@ -830,7 +720,6 @@ dropped in favor of an alias. The mode-line mnemonic for 'vietnamese-vscii' and its aliases is the lowercase letter "v". ---- *** Users in CJK locales can control width of some non-CJK characters. Some characters are considered by Unicode as "ambiguous" with respect to their display width: either "full-width" (i.e., taking 2 columns on @@ -847,25 +736,20 @@ or narrow (if the variable is customized to the nil value). This setting affects the results of 'string-width' and similar functions in CJK locales. ---- *** New input methods for the Urdu, Pashto, and Sindhi languages. These languages are spoken in Pakistan and Afghanistan. ---- *** New input method "english-colemak". This input method supports the Colemak keyboard layout. ---- *** Additional 'C-x 8' key translations for "æ" and "Æ". These characters can now be input with 'C-x 8 a e' and 'C-x 8 A E', respectively, in addition to the existing translations 'C-x 8 / e' and 'C-x 8 / E'. ---- *** New 'C-x 8' key translations for "low" quotes "„", and "‚". These can now be entered with 'C-x , "' and 'C-x , ''. ---- *** New German language 'C-x 8' key translations for quotation marks. The characters "„", "“", and "”" can now be entered with 'C-x 8 v', 'C-x 8 b' and 'C-x 8 n'. The single versions "‚", "‘", and "’" can now @@ -873,7 +757,6 @@ be entered with 'C-x 8 V', 'C-x 8 B' and 'C-x 8 N'. These characters are used for the official German quoting style. Using them requires activating German language support via 'iso-transl-set-language'. ---- *** "latin-prefix" and "latin-postfix" quotation marks additions. These input methods can now produce single, double and "low" left and right quotation marks: @@ -883,20 +766,17 @@ right quotation marks: by using "[", "]", and "," for "left", "right", and "low" respectively to modify "'" and """. ---- *** "latin-prefix" and "latin-postfix" guillemets support. These input methods can now produce single guillemets "‹" and "›". For "latin-prefix" use "~~<" and "~~>", for "latin-postfix" use "<~" and ">~". Double guillemets ("«" and "»") were already supported. ---- *** New French language 'C-x 8' key translations for "‹" and "›". These characters can now be entered using 'C-x 8 ~ <' and 'C-x 8 ~ >', respectively, after activating French language support via 'iso-transl-set-language'. Double guillemets were already supported via 'C-x 8 <' and 'C-x 8 >' ---- *** Additional 'C-x 8' key translation for Euro "€" currency symbol. This can now be entered using 'C-x 8 E' in addition to the existing 'C-x 8 * E' translation. @@ -906,44 +786,37 @@ This can now be entered using 'C-x 8 E' in addition to the existing ** Outline mode -+++ *** New commands to show/hide outlines by regexp. 'C-c / h' ('outline-hide-by-heading-regexp') asks for a regexp and then hides the body lines of all outlines whose heading lines match the regexp. 'C-c / s' ('outline-show-by-heading-regexp') does the inverse: it shows the bodies of outlines that matched a regexp. -+++ *** 'outline-minor-mode' is supported in tree-sitter major modes. It can be used in all tree-sitter major modes that set either the variable 'treesit-simple-imenu-settings' or 'treesit-outline-predicate'. ** Info ---- *** New user option 'Info-url-alist'. This user option associates manual names with URLs. It affects the 'Info-goto-node-web' command. By default, associations for all Emacs-included manuals are set. Further associations can be added for arbitrary Info manuals. ---- *** Emacs can now display Info manuals compressed with 'lzip'. This requires the 'lzip' program to be installed on your system. ** GUD (Grand Unified Debugger) -+++ *** New user option 'gud-highlight-current-line'. When enabled, GUD will visually emphasize the line being executed upon pauses in the debuggee's execution, such as those occasioned by breakpoints being hit. -+++ *** New command 'lldb'. Run the LLDB debugger, analogous to the 'gud-gdb' command. ---- *** Variable order and truncation can now be configured in 'gdb-many-windows'. The new user option 'gdb-locals-table-row-config' allows users to configure the order and max length of various properties in the local @@ -959,7 +832,6 @@ If you want to get back the old behavior, set the user option to the value (setopt gdb-locals-table-row-config `((type . 0) (name . 0) (value . ,gdb-locals-value-limit))) -+++ *** New user option 'gdb-display-io-buffer'. If this is nil, command 'gdb' will neither create nor display a separate buffer for the I/O of the program being debugged, but will instead @@ -968,7 +840,6 @@ default is t, to preserve previous behavior. ** Grep -+++ *** New user option 'grep-use-headings'. When non-nil, the output of Grep is split into sections, one for each file, instead of having file names prefixed to each line. It is @@ -978,13 +849,11 @@ The default is nil. ** Compilation mode ---- *** The 'omake' matching rule is now disabled by default. This is because it partly acts by modifying other rules which may occasionally be surprising. It can be re-enabled by adding 'omake' to 'compilation-error-regexp-alist'. ---- *** Lua errors and stack traces are now recognized. Compilation mode now recognizes Lua language errors and stack traces. Every Lua error is recognized as a compilation error, and every Lua @@ -992,24 +861,20 @@ stack frame is recognized as a compilation info. ** Project -+++ *** New user option 'project-mode-line'. When non-nil, display the name of the current project on the mode line. Clicking 'mouse-1' on the project name pops up the project menu. The default value is nil. ---- *** New user option 'project-file-history-behavior'. Customizing it to 'relativize' makes commands like 'project-find-file' and 'project-find-dir' display previous history entries relative to the current project. ---- *** New user option 'project-key-prompt-style'. The look of the key prompt in the project switcher has been changed slightly. To get the previous one, set this option to 'brackets'. ---- *** Function 'project-try-vc' tries harder to find the responsible VCS. When 'project-vc-extra-root-markers' is non-nil, and causes a subdirectory project to be detected which is not a VCS root, Project now @@ -1017,7 +882,6 @@ additionally traverses the parent directories until a VCS root is found (if any), so that the ignore rules for that repository are used, and the file listing's performance is still optimized. -+++ *** New commands 'project-any-command' and 'project-prefix-or-any-command'. The former is now bound to 'C-x p o' by default. The latter is designed primarily for use as a value of @@ -1028,7 +892,6 @@ you can add this to your init script: (setopt project-switch-commands #'project-prefix-or-any-command) ---- *** New variable 'project-files-relative-names'. If it is non-nil, 'project-files' can return file names relative to the project root. Project backends can use this to improve the performance @@ -1036,26 +899,21 @@ of their 'project-files' implementation. ** VC ---- *** Log-Edit buffers now display a tool bar. This tool bar contains items for committing log entries and editing or generating log entries, among other editing operations. ---- *** New user option 'vc-git-shortlog-switches'. This is a string or a list of strings that specifies the Git log switches for shortlogs, such as the one produced by 'C-x v L'. 'vc-git-log-switches' is no longer used for shortlogs. ---- *** New value 'no-backend' for user option 'vc-display-status'. With this value only the revision number is displayed on the mode-line. ---- *** Obsolete command 'vc-switch-backend' re-added as 'vc-change-backend'. The command was previously obsoleted and unbound in Emacs 28. ---- *** Support for viewing VC change history across renames. When a fileset's VC change history ends at a rename, 'C-x v l' now prints the old name(s) and shows a button which jumps to the history of @@ -1066,17 +924,14 @@ Unlike when the '--follow' switch is used, commands to see the diff of the old revision ('d'), to check out an old file version ('f') or to annotate it ('a'), also work on revisions which precede renames. ---- *** 'vc-annotate' now abbreviates the Git revision in the buffer name. When using the Git backend, 'vc-annotate' will use an abbreviated revision identifier in its buffer name. To restore the previous behavior, set user option 'vc-annotate-use-short-revision' to nil. ---- *** New user option 'vc-git-file-name-changes-switches'. It allows tweaking the thresholds for rename and copy detection. ---- *** VC Directory buffers now display the upstream branch in Git repositories. The "upstream branch" is the branch from which 'vc-pull' fetches changes by default. In Git terms, the upstream branch of branch B is determined @@ -1088,7 +943,6 @@ the "Tracking" header. ** Diff mode ---- *** New user option 'diff-refine-nonmodified'. When this is non-nil, 'diff-refine-hunk' will highlight lines that were added or removed in their entirety (as opposed to modified lines, where @@ -1096,26 +950,22 @@ some parts of the line were modified), using the same faces as for highlighting the words added and removed within modified lines. The default value is nil. -+++ *** 'diff-ignore-whitespace-hunk' can now be applied to all hunks. When called with a non-nil prefix argument, 'diff-ignore-whitespace-hunk' now iterates over all the hunks in the current diff, regenerating them without whitespace changes. -+++ *** New user option 'diff-ignore-whitespace-switches'. This allows changing which type of whitespace changes are ignored when regenerating hunks with 'diff-ignore-whitespace-hunk'. Defaults to the previously hard-coded "-b". -+++ *** New command 'diff-apply-buffer' bound to 'C-c RET a'. It applies the diff in the entire diff buffer and saves all modified file buffers. ** Dired ---- *** New user option 'dired-movement-style'. When non-nil, make 'dired-next-line', 'dired-previous-line', 'dired-next-dirline', 'dired-prev-dirline' skip empty lines. @@ -1123,7 +973,6 @@ It also controls how to move point when encountering a boundary (e.g., if every line is visible, invoking 'dired-next-line' at the last line will move to the first line). The default is nil. ---- *** New user option 'dired-filename-display-length'. It is an integer representing the maximum display length of file names. The middle part of a file name whose length exceeds the restriction is @@ -1131,7 +980,6 @@ hidden and an ellipsis is displayed instead. A value of 'window' means using the right edge of window as the display restriction. The default is nil. ---- *** New user option 'shell-command-guess-functions'. It defines how to populate a list of commands available for 'M-!', 'M-&', '!', '&' and the context menu "Open With" @@ -1140,32 +988,27 @@ based on marked files in Dired. Possible backends are and a universal command such as "open" or "start" that delegates to the OS. -+++ *** New command 'dired-do-open'. This command is bound to 'E' (mnemonics "External"). Also it can be used by clicking "Open" in the context menu; it "opens" the marked or clicked on files according to the OS conventions. For example, on systems supporting XDG, this runs 'xdg-open' on the files. -+++ *** New variable 'dired-guess-shell-alist-optional'. It contains commands for external viewers and players for various media formats, moved to this list from 'dired-guess-shell-alist-default'. ---- *** The default value of 'dired-omit-size-limit' was increased. After performance improvements to omitting in large directories, the new default value is 300k, up from 100k. This means 'dired-omit-mode' will omit files in directories whose directory listing is up to 300 kilobytes in size. -+++ *** 'dired-listing-switches' handles connection-local values if exist. This allows you to customize different switches for different remote machines. ** Ediff ---- *** New user option 'ediff-floating-control-frame'. If non-nil, try making the control frame be floating rather than tiled. @@ -1175,21 +1018,18 @@ This option is useful to set if you use such a window manager. ** Buffer Selection ---- *** New user option 'bs-default-action-list'. You can now configure how to display the "*buffer-selection*" buffer using this new option. (Or set 'display-buffer-alist' directly.) ** Eshell -+++ *** You can now run Eshell scripts in batch mode. By adding the following interpreter directive to an Eshell script, you can make it executable like other shell scripts: #!/usr/bin/env -S emacs --batch -f eshell-batch-file -+++ *** New builtin Eshell command 'compile'. This command runs another command, sending its output to a compilation buffer when the command would output interactively. This can be useful @@ -1198,14 +1038,12 @@ appropriate, but still allow piping the output elsewhere if desired. For more information, see the "(eshell) Built-ins" node in the Eshell manual. -+++ *** Eshell's 'env' command now supports running commands. Like in many other shells, Eshell's 'env' command now lets you run a command passed as arguments to 'env'. If you pass any initial arguments of the form 'VAR=VALUE', 'env' will first set 'VAR' to 'VALUE' before running the command. ---- *** Eshell's 'umask' command now supports setting the mask symbolically. Now, you can pass an argument like "u+w,o-r" to Eshell's 'umask' command, which will give write permission for owners of newly-created @@ -1213,7 +1051,6 @@ files and deny read permission for users who are not members of the file's group. See the Info node "(coreutils) File permissions" for more information on this notation. ---- *** Performance improvements for interactive output in Eshell. Interactive output in Eshell should now be significantly faster, especially for commands that can print large amounts of output @@ -1222,12 +1059,10 @@ for password prompts in the last 256 characters of each block of output. To restore the previous behavior when checking for password prompts, set 'eshell-password-prompt-max-length' to 'most-positive-fixnum'. ---- *** Eshell built-in commands can now display progress. Eshell built-in commands like "cat" and "ls" now update the display periodically while running to show their progress. -+++ *** New special reference type '#'. This special reference type returns a marker at 'POSITION' in 'BUFFER'. You can insert it by typing or using the new interactive @@ -1236,7 +1071,6 @@ references of any type using the new interactive command 'eshell-insert-special-reference'. See the "(eshell) Arguments" node in the Eshell manual for more details. -+++ *** New splice operator for Eshell dollar expansions. Dollar expansions in Eshell now let you splice the elements of the expansion in-place using '$@expr'. This makes it easier to fill lists @@ -1244,21 +1078,18 @@ of arguments into a command, such as when defining aliases. For more information, see the "(eshell) Dollars Expansion" node in the Eshell manual. -+++ *** You can now splice Eshell globs in-place into argument lists. By setting 'eshell-glob-splice-results' to a non-nil value, Eshell will expand glob results in-place as if you had typed each matching file name individually. For more information, see the "(eshell) Globbing" node in the Eshell manual. -+++ *** Eshell now supports negative numbers and ranges for indices. Now, you can retrieve the last element of a list with '$my-list[-1]' or get a sublist of elements 2 through 4 with '$my-list[2..5]'. For more information, see the "(eshell) Dollars Expansion" node in the Eshell manual. -+++ *** Eshell commands can now be explicitly-remote (or local). By prefixing a command name in Eshell with a remote identifier, like "/ssh:user@remote:whoami", you can now run commands on a particular @@ -1267,12 +1098,10 @@ command on your local system no matter your current directory via "/local:whoami". For more information, see the "(eshell) Remote Access" node in the Eshell manual. -+++ *** Eshell's '$UID' and '$GID' variables are now connection-aware. Now, when expanding '$UID' or '$GID' in a remote directory, the value is the user or group ID associated with the remote connection. ---- *** Eshell now uses 'field' properties in its output. In particular, this means that pressing the '' key moves the point to the beginning of your input, not the beginning of the whole @@ -1284,25 +1113,20 @@ this to your configuration: This also means you no longer need to adjust 'eshell-prompt-regexp' when customizing your Eshell prompt. ---- *** You can now properly unload Eshell. Calling '(unload-feature 'eshell)' no longer signals an error, and now correctly unloads Eshell and all of its modules. -+++ *** 'eshell-read-aliases-list' is now an interactive command. After manually editing 'eshell-aliases-file', you can use this command to load the edited aliases. -+++ *** 'rgrep' is now a builtin Eshell command. Running 'rgrep' in Eshell now uses the Emacs grep facility instead of calling external rgrep. -+++ *** If a command exits abnormally, the Eshell prompt now shows its exit code. -+++ *** New user option 'eshell-history-append'. If non-nil, each Eshell session will save history by appending new entries of that session to the history file rather than overwriting @@ -1310,25 +1134,21 @@ the file with the whole history of the session. The default is nil. ** Pcomplete ---- *** New user option 'pcomplete-remote-file-ignore'. When this option is non-nil, remote file names are not completed by Pcomplete. Packages, like 'shell-mode', could set this in order to suppress remote file name completion at all. ---- *** Completion for the 'doas' command has been added. Command completion for 'doas' in Eshell and Shell mode will now work. ** Shell mode -+++ *** New user option 'shell-get-old-input-include-continuation-lines'. When this user option is non-nil, 'shell-get-old-input' ('C-RET') includes multiple shell "\" continuation lines from command output. Default is nil. -+++ *** New user option 'shell-history-file-name'. When this user option is set to t, 'shell-mode' does not read the shell history file. Setting this user option to a string specifies the name @@ -1337,7 +1157,6 @@ environment variable 'HISTFILE'. In a 'shell' buffer, this user option is connection-local. ---- *** Performance improvements for interactive output. Interactive output in Shell mode now scans more selectively for password prompts by only examining the last 256 characters of each block of @@ -1347,7 +1166,6 @@ To restore the old behavior, set 'comint-password-prompt-max-length' to ** Prog mode -+++ *** New command 'prog-fill-reindent-defun'. This command either fills a single paragraph in a defun, such as a docstring, or a comment, or (re)indents the surrounding defun if point @@ -1356,26 +1174,22 @@ is not in a comment or a string. By default, it is bound to 'M-q' in ** Imenu -+++ *** New user option 'imenu-flatten'. It controls whether to flatten the list of sections in an imenu, and how to display the sections in the flattened list. -+++ *** The sort order of Imenu completions can now be customized. You can customize the user option 'completion-category-overrides' and set 'display-sort-function' for the category 'imenu'. ** Which Function mode -+++ *** Which Function mode can now display function names on the header line. The new user option 'which-func-display' allows choosing where the function name is displayed. The default is 'mode' to display in the mode line. 'header' will display in the header line; 'mode-and-header' displays in both the header line and mode line. -+++ *** New user option 'which-func-update-delay'. This replaces the user option 'idle-update-delay', which was previously used to control the delay before 'which-function-mode' updated its @@ -1384,28 +1198,23 @@ Which Function mode, is now obsolete. ** Tramp -+++ *** Tramp methods can be optional. An optional connection method is not enabled by default. The user must enable it explicitly by the 'tramp-enable-method' command. The existing methods "fcp", "krlogin", " ksu" and "nc" are optional now. -+++ *** New optional connection method "androidsu". This provides access to system files with elevated privileges granted by the idiosyncratic 'su' implementations and system utilities customary on Android. -+++ *** New optional connection method "run0". This connection method is similar to "sudo", but it uses the 'systemd' framework internally. -+++ *** New connection methods "dockercp" and "podmancp". These are the external methods counterparts of "docker" and "podman". -+++ *** New optional connection methods for containers. There are new optional connection methods "toolbox", "distrobox", "flatpak", "apptainer" and "nspawn". They allow accessing system @@ -1413,7 +1222,6 @@ containers provided by Toolbox or Distrobox, sandboxes provided by Flatpak, instances managed by Apptainer, or accessing systemd-based light-weight containers.. -+++ *** Connection method "kubernetes" supports now optional container name. The host name for Kubernetes connections can be of kind [CONTAINER.]POD, in order to specify a dedicated container. If there is just the pod @@ -1421,7 +1229,6 @@ name, the first container in the pod is taken. The new user options 'tramp-kubernetes-context' and 'tramp-kubernetes-namespace' allow accessing pods with different context or namespace but the default one. -+++ *** Rename 'tramp-use-ssh-controlmaster-options' to 'tramp-use-connection-share'. The old name still exists as obsolete variable alias. This user option controls now connection sharing for both ssh-based and @@ -1430,39 +1237,33 @@ The latter suppresses also "ControlMaster" settings in the user's "~/.ssh/config" file, or connection share configuration in PuTTY sessions, respectively. -+++ *** New command 'tramp-cleanup-some-buffers'. It kills only a subset of opened remote buffers, subject to the user option 'tramp-cleanup-some-buffers-hook'. -+++ *** New command 'inhibit-remote-files'. This command disables the handling of file names with the special remote file name syntax. It should be applied only when remote files won't be used in this Emacs instance. It provides a slightly improved performance of file name handling in Emacs. -+++ *** New macro 'without-remote-files'. This macro could wrap code which handles local files only. Due to the temporary deactivation of remote files, it results in a slightly improved performance of file name handling in Emacs. -+++ *** New user option 'tramp-completion-multi-hop-methods'. It contains a list of connection methods for which completion should be attempted at the end of a multi-hop chain. This allows completion candidates to include a list of, for example, containers running on a remote docker host. -+++ *** New command 'tramp-revert-buffer-with-sudo'. It reverts the current buffer to visit with "sudo" permissions. The buffer must either visit a file, or it must run 'dired-mode'. Another method but "sudo" can be configured with user option 'tramp-file-name-with-method'. -+++ *** Direct asynchronous processes are indicated by a connection-local variable. If direct asynchronous processes shall be used, set the connection-local variable 'tramp-direct-async-process' to a non-nil value. In previous @@ -1472,14 +1273,12 @@ properties and 'tramp-connection-properties' in general) is now deprecated. See the Tramp manual "(tramp) Improving performance of asynchronous remote processes". ---- *** Direct asynchronous processes use 'tramp-remote-path'. When a direct asynchronous process is invoked, it uses 'tramp-remote-path' for setting the remote 'PATH' environment variable. ** SHR ---- *** New user option 'shr-fill-text'. When 'shr-fill-text' is non-nil (the default), SHR will fill text according to the width of the window. If you customize it to nil, SHR @@ -1489,7 +1288,6 @@ visually wrapped at word boundaries. ** EWW ---- *** New mouse bindings in EWW buffers. Certain form elements that were displayed as buttons, yet could only be activated by keyboard input, are now operable using 'mouse-2'. With @@ -1497,45 +1295,38 @@ activated by keyboard input, are now operable using 'mouse-2'. With other classes of buttons either toggle their values or prompt for user input, as the case may be. ---- *** EWW text input fields and areas are now fields. In consequence, movement commands and OS input method features now recognize and confine their activities to the text input field around point. See also the Info node "(elisp) Fields". -+++ *** 'eww-open-file' can now display the file in a new buffer. By default, the command reuses the "*eww*" buffer, but if called with the new argument NEW-BUFFER non-nil, it will use a new buffer instead. Interactively, invoke 'eww-open-file' with a prefix argument to activate this behavior. ---- *** 'eww' URL or keyword prompt now has tab completion. The interactive minibuffer prompt when invoking 'eww' now has support for tab completion. -+++ *** 'eww' URL and keyword prompt now completes suggested URIs and bookmarks. The interactive minibuffer prompt when invoking 'eww' now provides completions from 'eww-suggest-uris'. 'eww-suggest-uris' now includes bookmark URIs. -+++ *** New command 'eww-copy-alternate-url'. It copies an alternate link on the page currently visited in EWW into the kill ring. Alternate links are optional metadata that HTML pages use for linking to their alternative representations, such as translated versions or associated RSS feeds. It is bound to 'A' by default. -+++ *** 'eww-open-in-new-buffer' supports the prefix argument. When invoked with the prefix argument ('C-u'), 'eww-open-in-new-buffer' will not make the new buffer the current one. This is useful for continuing reading the URL in the current buffer when the new URL is fetched. ---- *** History navigation in EWW now behaves as in other browsers. Previously, when navigating back and forward through page history, EWW would add a duplicate entry to the end of the history list each time. @@ -1548,27 +1339,23 @@ entries newer than the current page. To change the behavior when browsing from "historical" pages, you can customize 'eww-before-browse-history-function'. -+++ *** 'eww-readable' now toggles display of the readable parts of a web page. When called interactively, 'eww-readable' toggles whether to display only the readable parts of a page or the full page. With a positive prefix argument, it always displays the readable parts, and with a zero or negative prefix, it always displays the full page. -+++ *** New user option 'eww-readable-urls'. This is a list of regular expressions matching the URLs where EWW should display only the readable parts by default. For more details, see "(eww) Basics" in the EWW manual. ---- *** New user option 'eww-readable-adds-to-history'. When non-nil (the default), calling 'eww-readable' adds a new entry to the EWW page history. ** Go-ts mode -+++ *** New command 'go-ts-mode-docstring'. This command adds a docstring comment to the current defun. If a comment already exists, point is only moved to the comment. It is @@ -1576,12 +1363,10 @@ bound to 'C-c C-d' in 'go-ts-mode'. ** Man mode -+++ *** New user option 'Man-prefer-synchronous-call'. When this is non-nil, run the 'man' command synchronously rather than asynchronously (which is the default behavior). -+++ *** New user option 'Man-support-remote-systems'. This option controls whether the man page is formatted on the remote system when the current buffer's default-directory is remote. You can @@ -1590,12 +1375,10 @@ value of this option for the current invocation of 'man'. ** DocView ---- *** New user option 'doc-view-mpdf-use-svg'. If non-nil, DocView uses SVG images to display PDF documents. The default is non-nil if your system supports display of SVG images. ---- *** New face 'doc-view-svg-face'. This replaces 'doc-view-svg-foreground' and 'doc-view-svg-background'. By default, this face has black foreground on white background and @@ -1605,7 +1388,6 @@ current theme. However, this, or any non-standard values, can result in poor contrast for documents which aren't simply black text on white background. ---- *** DocView buffers now display a new tool bar. This tool bar contains options for searching and navigating within the document, replacing the incompatible items for incremental search and @@ -1613,12 +1395,10 @@ editing within the default tool bar displayed in the past. ** Shortdoc -+++ *** New function 'shortdoc-function-examples'. This function returns examples of use of a given Emacs Lisp function from the available shortdoc information. -+++ *** New function 'shortdoc-help-fns-examples-function'. This function inserts into the current buffer examples of use of a given Emacs Lisp function, which it gleans from the shortdoc @@ -1631,24 +1411,20 @@ following to your init file: ** Package ---- *** New user option 'package-vc-register-as-project'. When non-nil, 'package-vc-install' and 'package-vc-checkout' will automatically register every package they install as a project, that you can quickly select using 'project-switch-project' ('C-x p p'). Default is t. ---- *** New user option 'package-vc-allow-build-commands'. Controls for which packages Emacs runs extra build commands when installing directly from the package VCS repository. ---- *** New command 'package-vc-log-incoming'. This commands displays incoming changes for a VC package without modifying the current checkout. ---- *** New command to start an inferior Emacs loading only specific packages. The new command 'package-isolate' will start a new Emacs process, as a sub-process of Emacs where you invoke the command, in a way that @@ -1659,29 +1435,24 @@ in a clean environment. ** Flymake -+++ *** New user option 'flymake-indicator-type'. This controls which error indicator type Flymake should use in the current buffer. Depending on your preference, this can either use fringes or margins for indicating errors, the default is 'margins'. -+++ *** New user option 'flymake-margin-indicators-string'. It controls, for each error type, the string and its face to display as the margin indicator. -+++ *** New user option 'flymake-autoresize-margins'. If non-nil (the default), Flymake will resize the margins when 'flymake-mode' is turned on or off. Only relevant if 'flymake-indicator-type' is set to 'margins'. -+++ *** New user option 'flymake-margin-indicator-position'. It controls whether to use margins for margin indicators, and which margin (left or right) to use. Default is to use the left margin. -+++ *** New user option 'flymake-show-diagnostics-at-end-of-line'. When non-nil, Flymake shows summarized descriptions of diagnostics at the end of the line. Depending on your preference, this can either be @@ -1691,13 +1462,11 @@ mouse to consult an error message. Default is nil. ** Flyspell -+++ *** New user option 'flyspell-check-changes'. When non-nil, Flyspell mode spell-checks only words that you edited; it does not check unedited words just because you move point across them. Default is nil. ---- ** JS mode. The binding 'M-.' has been removed from the major mode keymaps in 'js-mode' and 'js-ts-mode', having it default to the global binding @@ -1705,7 +1474,6 @@ which calls 'xref-find-definitions'. If the previous one worked better for you, use 'define-key' in your init script to bind 'js-find-symbol' to that combination again. ---- ** Json mode. 'js-json-mode' does not derive from 'js-mode' any more so as not to confuse tools like Eglot or YASnippet into thinking that those @@ -1713,7 +1481,6 @@ buffers contain Javascript code. ** Python mode ---- *** New user option 'python-indent-block-paren-deeper'. If non-nil, increase the indentation of the lines inside parens in a header of a block when they are indented to the same level as the body @@ -1731,19 +1498,16 @@ instead of: Default is nil. ---- *** New user option 'python-interpreter-args'. This allows the user to specify command line arguments to the non interactive Python interpreter specified by 'python-interpreter'. ---- *** New function 'python-shell-send-block'. It sends the python block delimited by 'python-nav-beginning-of-block' and 'python-nav-end-of-block' to the inferior Python process. ** Inferior Python mode ---- *** Default value of 'python-shell-compilation-regexp-alist' is changed. Support for Python's ExceptionGroup has been added, so in the Python shell, the line indicating the source of an error in the error messages @@ -1751,13 +1515,11 @@ from ExceptionGroup will be recognized as well. ** Eldoc ---- *** 'eldoc' no longer truncates to a single line by default. Previously, the entire docstring was not available to eldoc, which made 'eldoc-echo-area-use-multiline-p' ineffective. The old behavior may be kept by customizing 'eldoc-echo-area-use-multiline-p'. ---- ** Scheme mode. Scheme mode now handles the regular expression literal '#/regexp/' that is available in some Scheme implementations. @@ -1765,47 +1527,39 @@ Also, it should now handle nested sexp-comments. ** Use package -+++ *** New ':vc' keyword. This keyword enables the user to install packages using package-vc.el. -+++ *** New user option 'use-package-vc-prefer-newest'. If non-nil, always install the newest commit of a package when using the ':vc' keyword rather than its stable release. Default is nil. ** Gnus -+++ *** New backend 'nnfeed'. This allows backend developers to easily create new backends for web feeds, as inheriting backends of 'nnfeed'. -+++ *** New backend 'nnatom'. This allow users to add Atom Syndication Format feeds to Gnus as servers. ---- *** The 'nnweb-type' option 'gmane' has been removed. The gmane.org website is, sadly, down since a number of years with no prospect of it coming back. Therefore, it is no longer valid to set the server variable 'nnweb-type' to 'gmane'. ---- *** New user option 'gnus-mode-line-logo'. This allows the user to either disable the display of any logo or specify which logo will be displayed as part of the buffer-identification in the mode-line of Gnus buffers. ---- *** 'gnus-summary-limit-to-age' now counts days since midnight. "Less than 1 day" now means "since last midnight", rather than "less than 24 hours old". ** Rmail ---- *** New commands for reading mailing lists. The new Rmail commands 'rmail-mailing-list-post', 'rmail-mailing-list-unsubscribe', 'rmail-mailing-list-help', and @@ -1816,7 +1570,6 @@ delivered. ** Dictionary ---- *** New user option 'dictionary-search-interface'. Controls how the 'dictionary-search' command prompts for and displays dictionary definitions. Customize this user option to 'help' to have @@ -1824,13 +1577,11 @@ dictionary definitions. Customize this user option to 'help' to have provide dictionary-based minibuffer completion for word selection. Default is nil, which means to use a "*Dictionary*" buffer. ---- *** New user option 'dictionary-read-word-prompt'. This allows the user to customize the prompt that is used by 'dictionary-search' when asking for a word to search in the dictionaries. ---- *** New user option 'dictionary-display-definition-function'. This allows the user to customize the way in which 'dictionary-search' displays word definitions. If non-nil, this user option should be set @@ -1840,7 +1591,6 @@ dictionary server. The new function the definition in a "*Help*" buffer, instead of the default "*Dictionary*" buffer. ---- *** New user option 'dictionary-read-word-function'. This allows the user to customize the way in which 'dictionary-search' prompts for a word to search in the dictionary. This user option @@ -1849,7 +1599,6 @@ returns it as a string. The new function 'dictionary-completing-read-word' can be used to prompt with completion based on dictionary matches. ---- *** New user option 'dictionary-read-dictionary-function'. This allows the user to customize the way in which 'dictionary-search' prompts for a dictionary to search in. This user option should be set @@ -1858,7 +1607,6 @@ name as a string. The new function 'dictionary-completing-read-dictionary' can be used to prompt with completion based on dictionaries that the server supports. ---- *** The default value of 'dictionary-tooltip-dictionary' has changed. The new default value is t, which means use the same dictionary as the value of 'dictionary-default-dictionary'. The previous default value @@ -1867,52 +1615,43 @@ the mode was turned on. ** Pp -+++ *** New 'pp-default-function' user option replaces 'pp-use-max-width'. Its default value is 'pp-fill', a new default pretty-printing function, which tries to obey 'fill-column'. ---- *** 'pp-to-string' takes an additional PP-FUNCTION argument. This argument specifies the prettifying algorithm to use. ---- *** 'pp' and 'pp-to-string' now always include a terminating newline. In the past they included a terminating newline in most cases but not all. ** Emacs Lisp mode -+++ *** 'elisp-flymake-byte-compile' is disabled for untrusted files. For security reasons, this backend can be used only in those files specified as trusted according to 'trusted-content' and emits an "untrusted content" warning otherwise. This fixes CVE-2024-53920. ---- *** ',@' now has 'prefix' syntax. Previously, the '@' character, which normally has 'symbol' syntax, would combine with a following Lisp symbol and interfere with symbol searching. -+++ *** 'emacs-lisp-docstring-fill-column' now defaults to 72. It was previously 65. The new default formats documentation strings to fit on fewer lines without negatively impacting readability. ** CPerl mode ---- *** Subroutine signatures are now supported. CPerl mode fontifies subroutine signatures like variable declarations which makes them visually distinct from subroutine prototypes. ---- *** Syntax of Perl up to version 5.40 is supported. CPerl mode supports the new keywords for exception handling and the object oriented syntax which were added in Perl 5.36, 5.38 and 5.40. ---- *** New user option 'cperl-fontify-trailer'. This user option takes the values 'perl-code' or 'comment' and treats text after an "__END__" or "__DATA__" token accordingly. The default @@ -1920,32 +1659,27 @@ value of 'perl-code' is useful for trailing POD and for AutoSplit modules, the value 'comment' makes CPerl mode treat trailers as comment, like Perl mode does. ---- *** New command 'cperl-file-style'. This command sets the indentation style for the current buffer. To change the default style, either use the user option with the same name or use the command 'cperl-set-style'. ---- *** New minor mode 'cperl-extra-paired-delimiters-mode'. Perl 5.36 and newer allows using more than 200 non-ASCII paired delimiters for quote-like constructs, e.g. "q«text»". Use this minor mode in buffers where this feature is activated. ---- *** Commands using the Perl Info manual are obsolete. The Perl documentation in Info format is no longer distributed with Perl or on CPAN since more than 10 years. Perl documentation can be read with 'cperl-perldoc' instead. ---- *** Highlighting trailing whitespace has been removed. The user option 'cperl-invalid-face' is now obsolete, and does nothing. See the user option 'show-trailing-whitespace' instead. ** Emacs Sessions (Desktop) -+++ *** Restoring buffers visiting remote files can now time out. When a buffer is restored which visits a remote file, the restoration of the session could hang if the remote host is off-line or slow to @@ -1956,7 +1690,6 @@ desktop restoration to continue. ** Recentf -+++ *** Checking recent remote files can now time out. Similarly to buffer restoration by Desktop, 'recentf-mode' checking of the accessibility of remote files can now time out if @@ -1964,19 +1697,16 @@ of the accessibility of remote files can now time out if ** Image Dired -+++ *** New user option 'image-dired-thumb-naming'. You can now configure how thumbnails are named using this option. ** ERT -+++ *** New macro 'skip-when' to skip 'ert-deftest' tests. This can help to avoid some awkward skip conditions. For example '(skip-unless (not noninteractive))' can be changed to the easier to read '(skip-when noninteractive)'. -+++ *** Syntax highlighting unit testing support. An ERT extension ('ert-font-lock') now provides support for face assignment unit testing. For more information, see the "(ert) Syntax @@ -1984,21 +1714,18 @@ Highlighting Tests" node in the ERT manual. ** Socks -+++ *** Socks supports version 4a. The 'socks-server' user option accepts '4a' as a value for its version field. ** Edmacro -+++ *** New command 'edmacro-set-macro-to-region-lines'. Bound to 'C-c C-r', this command replaces the macro text with the lines of the region. If needed, the region is extended to include whole lines. If the region ends at the beginning of a line, that last line is excluded. -+++ *** New user option 'edmacro-reverse-macro-lines'. When this is non-nil, the lines of key sequences are displayed with the most recent line first. This is can be useful when working with @@ -2006,7 +1733,6 @@ macros with many lines, such as from 'kmacro-edit-lossage'. ** Calc -+++ *** Calc parses fractions written using U+2044 FRACTION SLASH. Fractions of the form "123⁄456" are handled as if written "123:456". Note in particular the difference in behavior from U+2215 DIVISION SLASH @@ -2018,7 +1744,6 @@ was never mentioned in the NEWS, or even the Calc manual.) ** IELM ---- *** IELM now remembers input history between sessions. The new user option 'ielm-history-file-name' is the name of the file where IELM input history will be saved. Customize it to nil to revert @@ -2026,7 +1751,6 @@ to the old behavior of not remembering input history between sessions. ** EasyPG -+++ *** New user option 'epa-keys-select-method'. This allows the user to customize the key selection method, which can be either by using a pop-up buffer or from the minibuffer. The pop-up @@ -2034,61 +1758,52 @@ buffer method is the default, which preserves previous behavior. ** Widget -+++ *** New face 'widget-unselected'. Customize this face to a non-default value to visually distinguish the labels of unselected active radio-button or checkbox widgets from the labels of unselected inactive widgets (the default value inherits from the 'widget-inactive' face). -+++ *** New user option 'widget-skip-inactive'. If non-nil, moving point forward or backward between widgets by typing 'TAB' or 'S-TAB' skips over inactive widgets. The default value is nil. ** Ruby mode ---- *** New user option 'ruby-rubocop-use-bundler'. By default it retains the previous behavior: read the contents of Gemfile and act accordingly. But you can also set it to t or nil to skip checking the Gemfile. ---- *** New user option 'ruby-bracketed-args-indent'. When it is set to nil, multiple consecutive open braces/brackets/parens result in only one additional indentation level. Default is t. ** Thingatpt ---- *** New variables for providing custom thingatpt implementations. The new variables 'bounds-of-thing-at-point-provider-alist' and 'forward-thing-provider-alist' now allow defining custom implementations of 'bounds-of-thing-at-point' and 'forward-thing', respectively. ---- *** New helper functions for text property-based thingatpt providers. The new helper functions 'thing-at-point-for-char-property', 'bounds-of-thing-at-point-for-char-property', and 'forward-thing-for-char-property' can help to implement custom thingatpt providers for "things" that are defined by text properties. ---- *** 'bug-reference-mode' now supports 'thing-at-point'. Now, calling '(thing-at-point 'url)' when point is on a bug reference will return the URL for that bug. ** Buffer-menu ---- *** New user option 'Buffer-menu-group-by'. It controls how buffers are divided into groups that are displayed with headings using Outline minor mode. Using commands that mark buffers on the outline heading line will mark all buffers in the outline. By default, no grouping is performed. -+++ *** New command 'Buffer-menu-toggle-internal'. This command toggles the display of internal buffers in Buffer Menu mode; that is, buffers not visiting a file and whose names start with a space. @@ -2097,22 +1812,18 @@ in Buffer Menu mode. ** Miscellaneous -+++ *** New user option 'rcirc-log-time-format'. This allows for rcirc logs to use a custom timestamp format, which the chat buffers use by default. ---- *** 'ffap-lax-url' now defaults to nil. Previously, it was set to t, but this broke remote file name detection. ---- *** More control on automatic update of Proced buffers. The user option 'proced-auto-update-flag' can now be set to an additional value 'visible', which controls automatic updates of Proced buffers that are displayed in some window. ---- *** nXML Mode now comes with schemas for Mono/.NET development. The following new XML schemas are now supported: - MSBuild project files @@ -2123,48 +1834,39 @@ The following new XML schemas are now supported: - Nuget package specification file - Nuget packages config file ---- *** color.el now supports the Oklab color representation. -+++ *** New user option 'xwidget-webkit-disable-javascript'. This allows disabling JavaScript in xwidget Webkit sessions. ---- *** 'ls-lisp--insert-directory' supports more long options of 'ls'. 'ls-lisp--insert-directory', the ls-lisp implementation of 'insert-directory', now supports the '--time=TIME' and '--sort=time' options of GNU 'ls'. ---- *** 'M-x ping' can now give additional flags to the 'ping' program. Typing 'C-u M-x ping' prompts first for the host, and then for the flags to give to the 'ping' command. ---- *** Webjump now assumes URIs are HTTPS instead of HTTP. For links in 'webjump-sites' without an explicit URI scheme, it was previously assumed that they should be prefixed with "http://". Such URIs are now prefixed with "https://" instead. ---- *** Added prefixes in titdic-cnv library. Most of the variables and functions in the file have been renamed to make sure they all use a 'tit-' namespace prefix. ---- *** 'xref-revert-buffer' is now an alias of 'revert-buffer'. The Xref buffer now sets up 'revert-buffer-function' such that 'revert-buffer' behaves like 'xref-revert-buffer' did in previous Emacs versions, and the latter is now an alias of the former. ---- *** The Makefile browser is now obsolete. The command 'makefile-switch-to-browser' command is now obsolete, together with related commands used in the "*Macros and Targets*" buffer. We recommend using an alternative like 'imenu' instead. ---- *** 'jsonrpc-default-request-timeout' is now a defcustom. @@ -2172,28 +1874,22 @@ buffer. We recommend using an alternative like 'imenu' instead. ** New major modes based on the tree-sitter library -+++ *** New major mode 'elixir-ts-mode'. A major mode based on the tree-sitter library for editing Elixir files. -+++ *** New major mode 'heex-ts-mode'. A major mode based on the tree-sitter library for editing HEEx files. -+++ *** New major mode 'html-ts-mode'. An optional major mode based on the tree-sitter library for editing HTML files. -+++ *** New major mode 'lua-ts-mode'. A major mode based on the tree-sitter library for editing Lua files. -+++ *** New major mode 'php-ts-mode'. A major mode based on the tree-sitter library for editing PHP files. -+++ ** New package EditorConfig. This package provides support for the EditorConfig standard, an editor-neutral way to provide directory local (project-wide) settings. @@ -2202,13 +1898,11 @@ which makes Emacs obey the '.editorconfig' files. There is also a new major mode 'editorconfig-conf-mode' to edit those configuration files. -+++ ** New global minor mode 'etags-regen-mode'. This minor mode generates the tags table automatically based on the current project configuration, and later updates it as you edit the files and save the changes. -+++ ** New package 'which-key'. The 'which-key' package from GNU ELPA is now included in Emacs. It implements the global minor mode 'which-key-mode' that displays a table @@ -2217,7 +1911,6 @@ moment. For example, after enabling the minor mode, if you enter 'C-x' and wait for one second, the minibuffer will expand with all available key bindings that follow 'C-x' (or as many as space allows). -+++ ** New minor mode 'completion-preview-mode'. This minor mode shows you symbol completion suggestions as you type, using an inline preview. New user options in the 'completion-preview' @@ -2225,7 +1918,6 @@ customization group control exactly when Emacs displays this preview. 'completion-preview-mode' is buffer-local, to enable it globally use 'global-completion-preview-mode'. -+++ ** New package Window-Tool-Bar. This provides a new minor mode, 'window-tool-bar-mode'. When this minor mode is enabled, a tool bar is displayed at the top of a window. To @@ -2233,7 +1925,6 @@ conserve space, no tool bar is shown if 'tool-bar-map' is nil. The global minor mode 'global-window-tool-bar-mode' enables this minor mode in all buffers. -+++ ** New library Track-Changes. This library is a layer of abstraction above 'before-change-functions' and 'after-change-functions' which provides a superset of @@ -2245,7 +1936,6 @@ the functionality of 'after-change-functions': reported (calls to 'before/after-change-functions' that are incorrectly paired, missing, etc...) and reports them adequately. -+++ ** New global minor mode 'minibuffer-regexp-mode'. This is a minor mode for editing regular expressions in the minibuffer, for example in 'query-replace-regexp'. It correctly highlights parens @@ -2254,7 +1944,6 @@ avoids reporting alleged paren mismatches and makes sexp navigation more intuitive. It is enabled by default, 'minibuffer-regexp-prompts' can be used to tune when it takes effect. ---- ** The highly accessible Modus themes collection has eight items. The 'modus-operandi' and 'modus-vivendi' are the main themes that have been part of Emacs since version 28. The former is light, the latter @@ -2266,7 +1955,6 @@ the needs of users with red-green or blue-yellow color deficiency. The Info manual "(modus-themes) Top" describes the details and showcases all their user options. -+++ ** New library PEG. Emacs now includes a library for writing Parsing Expression Grammars (PEG), an approach to text parsing that provides more structure @@ -2274,14 +1962,12 @@ than regular expressions, but less complexity than context-free grammars. The Info manual "(elisp) Parsing Expression Grammars" has documentation and examples. ---- ** New major mode 'shell-command-mode'. This mode is used by default for the output of asynchronous 'shell-command'. To revert to the previous behavior, set the (also new) variable 'async-shell-command-mode' to 'shell-mode'. Any hooks or mode-specific variables used should be adapted appropriately. -+++ ** New package Compat. Emacs now comes with a stub implementation of the forwards-compatibility Compat package from GNU ELPA. This allows @@ -2291,7 +1977,6 @@ preventing the installation of Compat if unnecessary. * Incompatible Lisp Changes in Emacs 30.1 -+++ ** Evaluating a 'lambda' returns an object of type 'interpreted-function'. Instead of representing interpreted functions as lists that start with either 'lambda' or 'closure', Emacs now represents them as objects @@ -2308,17 +1993,14 @@ no longer work and will need to use 'aref' instead to extract its various subparts (when 'interactive-form', 'documentation', and 'help-function-arglist' aren't adequate). ---- ** The escape sequence '\x' not followed by hex digits is now an error. Previously, '\x' without at least one hex digit denoted character code zero (NUL) but as this was neither intended nor documented or even known by anyone, it is now treated as an error by the Lisp reader. ---- ** 'subr-native-elisp-p' is renamed to 'native-comp-function-p'. The previous name still exists but is marked as obsolete. -+++ ** 'define-globalized-minor-mode' requires that modes use 'run-mode-hooks'. Minor modes defined with 'define-globalized-minor-mode', such as 'global-font-lock-mode', will not be enabled any more in those buffers @@ -2326,7 +2008,6 @@ whose major modes fail to use 'run-mode-hooks'. Major modes defined with 'define-derived-mode' are not affected. 'run-mode-hooks' has been the recommended way to run major mode hooks since Emacs 22. -+++ ** 'buffer-match-p' and 'match-buffers' take '&rest ARGS'. They used to take a single '&optional ARG' and were documented to use an unreliable hack to try and support condition predicates that @@ -2334,18 +2015,14 @@ don't accept this optional ARG. The new semantics makes no such accommodation, but the code still supports it (with a warning) for backward compatibility. ---- ** 'post-gc-hook' runs after updating 'gcs-done' and 'gc-elapsed'. ---- ** Connection-local variables are applied in buffers visiting remote files. This overrides possible directory-local or file-local variables with the same name. -+++ ** 'copy-tree' now copies records when its optional 2nd argument is non-nil. -+++ ** Regexp zero-width assertions followed by operators are better defined. Previously, regexps such as "xy\\B*" would have ill-defined behavior. Now any operator following a zero-width assertion applies to that @@ -2353,7 +2030,6 @@ assertion only (which is useless). For historical compatibility, an operator character following '^' or '\`' becomes literal, but we advise against relying on this. -+++ ** Infinities and NaNs no longer act as symbols on non-IEEE platforms. On old platforms like the VAX that do not support IEEE floating-point, tokens like '0.0e+NaN' and '1.0e+INF' are no longer read as symbols. @@ -2361,7 +2037,6 @@ Instead, the Lisp reader approximates an infinity with the nearest finite value, and a NaN with some other non-numeric object that provokes an error if used numerically. -+++ ** Conversion of strings to and from byte-arrays works with multibyte strings. The functions 'dbus-string-to-byte-array' and 'dbus-byte-array-to-string' now accept and return multibyte Lisp @@ -2372,60 +2047,48 @@ UTF-8 byte sequence, and the optional parameter MULTIBYTE of 'dbus-string-to-byte-array' should be a regular Lisp string, not a unibyte string. -+++ ** 'minibuffer-allow-text-properties' now can be set buffer-local. 'read-from-minibuffer' and functions that use it can take the buffer-local value from the minibuffer. -+++ ** 'minibuffer-allow-text-properties' now also affects completions. When it has a non-nil value, then completion functions like 'completing-read' don't discard text properties from the returned completion candidate. -+++ ** X color support compatibility aliases are now obsolete. The compatibility aliases 'x-defined-colors', 'x-color-defined-p', 'x-color-values', and 'x-display-color-p' are now obsolete. -+++ ** 'easy-mmode-define-{minor,global}-mode' aliases are now obsolete. Use 'define-minor-mode' and 'define-globalized-minor-mode' instead. -+++ ** The 'millisec' argument of 'sleep-for' is now obsolete. Use a float value for the first argument instead. ---- ** User options 'eshell-NAME-unload-hook' are now obsolete. These hooks were named incorrectly, and so they never actually ran when unloading the corresponding feature. Instead, you should use hooks named after the feature name, like 'esh-mode-unload-hook'. ---- ** User options 'eshell-process-wait-{seconds,milliseconds}' are now obsolete. Instead, use 'eshell-process-wait-time', which supports floating-point values. ---- ** User option 'tramp-completion-reread-directory-timeout' has been removed. This user option was obsoleted in Emacs 27, use 'remote-file-name-inhibit-cache' instead. -+++ ** The obsolete calling convention of 'sit-for' has been removed. That convention was: '(sit-for SECONDS MILLISEC &optional NODISP)'. ---- ** 'defadvice' is marked as obsolete. See the "(elisp) Porting Old Advice" Info node for help converting them to use 'advice-add' or 'define-advice' instead. ---- ** 'cl-old-struct-compat-mode' is marked as obsolete. You may need to recompile your code if it was compiled with Emacs < 24.3. ---- ** Old derived.el functions removed. The following functions have been deleted because they were only used by code compiled with Emacs < 21: @@ -2438,40 +2101,33 @@ by code compiled with Emacs < 21: * Lisp Changes in Emacs 30.1 -+++ ** The 'wheel-up/down/left/right' events are now bound unconditionally. The 'mouse-wheel-up/down/left/right-event' variables are thus used only to specify the 'mouse-4/5/6/7' events that might still happen to be generated by some old packages (or if 'mouse-wheel-buttons' has been set to nil). ---- ** Xterm Mouse mode now emits 'wheel-up/down/right/left' events. This is instead of 'mouse-4/5/6/7' events for the mouse wheel. It uses the new variable 'mouse-wheel-buttons' to decide which button maps to which wheel event (if any). ---- ** In batch mode, tracing now sends the trace to stdout. -+++ ** New hook 'hack-dir-local-get-variables-functions'. This can be used to provide support for other directory-local settings beside ".dir-locals.el". -+++ ** 'auto-coding-functions' can know the name of the file. The functions on this hook can now find the name of the file to which the text belongs by consulting the variable 'auto-coding-file-name'. -+++ ** New user option 'compilation-safety' to control safety of native code. It is now possible to control how safe is the code generated by native compilation, by customizing this user option. It is also possible to control this at function granularity by using the new 'safety' parameter in the function's 'declare' form. -+++ ** New types 'closure' and 'interpreted-function'. 'interpreted-function' is the new type used for interpreted functions, and 'closure' is the common parent type of 'interpreted-function' @@ -2481,91 +2137,75 @@ Those new types come with the associated new predicates 'closurep' and 'interpreted-function-p' as well as a new constructor 'make-interpreted-closure'. ---- ** New function 'help-fns-function-name'. For named functions, it just returns the name and otherwise it returns a short "unique" string that identifies the function. In either case, the string is propertized so clicking on it gives further details. -+++ ** New function 'char-to-name'. This is a convenience function to return the Unicode name of a char (if it has one). -+++ ** New function 'cl-type-of'. This function is like 'type-of' except that it sometimes returns a more precise type. For example, for nil and t it returns 'null' and 'boolean' respectively, instead of just 'symbol'. -+++ ** New functions 'primitive-function-p' and 'cl-functionp'. 'primitive-function-p' is like 'subr-primitive-p' except that it returns t only if the argument is a function rather than a special-form, and 'cl-functionp' is like 'functionp' except it returns nil for lists and symbols. ---- ** Built-in types now have corresponding classes. At the Lisp level, this means that things like '(cl-find-class 'integer)' will now return a class object, and at the UI level it means that things like 'C-h o integer RET' will show some information about that type. ---- ** New variable 'major-mode-remap-defaults' and function 'major-mode-remap'. The first is like Emacs-29's 'major-mode-remap-alist' but to be set by packages (instead of users). The second looks up those two variables. -+++ ** Pcase's functions (in 'pred' and 'app') can specify the argument position. For example, instead of '(pred (< 5))' you can write '(pred (> _ 5))'. -+++ ** 'define-advice' now sets the new advice's 'name' property to NAME. Named advices defined with 'define-advice' can now be removed with '(advice-remove SYMBOL NAME)' in addition to '(advice-remove SYMBOL SYMBOL@NAME)'. -+++ ** New function 'require-with-check' to detect new versions shadowing. This is like 'require', but it checks whether the argument 'feature' is already loaded, in which case it either signals an error or forcibly reloads the file that defines the feature. -+++ ** New variable 'lisp-eval-depth-reserve'. It puts a limit to the amount by which Emacs can temporarily increase 'max-lisp-eval-depth' when handling signals. -+++ ** New special form 'handler-bind'. It provides a functionality similar to 'condition-case' except it runs the handler code without unwinding the stack, such that we can record the backtrace and other dynamic state at the point of the error. See the Info node "(elisp) Handling Errors". -+++ ** New text properties add tooltips on fringes. It is now possible to provide tooltips on fringes by adding special text properties 'left-fringe-help' and 'right-fringe-help'. See the "(elisp) Special Properties" Info node in the Emacs Lisp Reference Manual for more details. -+++ ** New 'display-buffer' action alist entry 'pop-up-frames'. This has the same effect as the variable of the same name and takes precedence over the variable when present. ---- ** New function 'merge-ordered-lists'. Mostly used internally to do a kind of topological sort of inheritance hierarchies. -+++ ** 'drop' is now an alias for the function 'nthcdr'. -+++ ** New polymorphic comparison function 'value<'. This function returns non-nil if the first argument is less than the second. It works for any two values of the same type with reasonable @@ -2575,7 +2215,6 @@ lexicographically. It is intended as a convenient ordering predicate for sorting, and is likely to be faster than hand-written Lisp functions. -+++ ** New 'sort' arguments and features. The 'sort' function can now be called using the signature @@ -2602,13 +2241,11 @@ its input in-place as before. ** New API for 'derived-mode-p' and control of the graph of major modes -+++ *** 'derived-mode-p' now takes the list of modes as a single argument. The same holds for 'provided-mode-derived-p'. The old calling convention where multiple modes are passed as separate arguments is deprecated. -+++ *** New functions to access the graph of major modes. While 'define-derived-mode' still only supports single inheritance, modes can declare additional parents (for tests like 'derived-mode-p') @@ -2617,7 +2254,6 @@ Accessing the 'derived-mode-parent' property directly is now deprecated in favor of the new functions 'derived-mode-set-parent' and 'derived-mode-all-parents'. -+++ ** Drag-and-drop functions can now be called once for compound drops. It is now possible for drag-and-drop handler functions to respond to drops incorporating more than one URL. Functions capable of this must @@ -2627,7 +2263,6 @@ See the Info node "(elisp) Drag and Drop". The function 'dnd-handle-one-url' has been made obsolete, since it cannot take these new handlers into account. -+++ ** 'notifications-notify' can use Icon Naming Specification for ':app-icon'. You can use a symbol as the value for ':app-icon' to provide icon name without specifying a file, like this: @@ -2635,54 +2270,45 @@ without specifying a file, like this: (notifications-notify :title "I am playing music" :app-icon 'multimedia-player) ---- ** New function 're-disassemble' to see the innards of a regexp. If you built Emacs with '--enable-checking', you can use this to help debug either your regexp performance problems or the regexp engine. -+++ ** XLFDs are no longer restricted to 255 characters. 'font-xlfd-name' now returns an XLFD even if it is greater than 255 characters in length, provided that the LONG_XLFDs argument is true. Other features in Emacs which employ XLFDs have been modified to produce and understand XLFDs larger than 255 characters. -+++ ** New macro 'static-if' for conditional evaluation of code. This macro hides a form from the evaluator or byte-compiler based on a compile-time condition. This is handy for avoiding byte-compilation warnings about code that will never actually run under some conditions. -+++ ** Desktop notifications are now supported on the Haiku operating system. The new function 'haiku-notifications-notify' provides a subset of the capabilities of the 'notifications-notify' function in a manner analogous to 'w32-notification-notify'. ---- ** New Haiku specific variable 'haiku-pass-control-tab-to-system'. This sets whether Emacs should pass 'C-TAB' on to the system instead of handling it, fixing a problem where window switching would not activate if an Emacs frame had focus on the Haiku operating system. Default value is t. -+++ ** New value 'if-regular' for the REPLACE argument to 'insert-file-contents'. It results in 'insert-file-contents' erasing the buffer instead of preserving markers if the file being inserted is not a regular file, rather than signaling an error. -+++ ** New variable 'current-key-remap-sequence'. It is bound to the key sequence that caused a call to a function bound within 'function-key-map' or 'input-decode-map' around those calls. -+++ ** The function 'key-translate' can now remove translations. If the second argument TO is nil, the existing key translation is removed. -+++ ** New variables describing the names of built in programs. The new variables 'ctags-program-name', 'ebrowse-program-name', 'etags-program-name', 'hexl-program-name', 'emacsclient-program-name' @@ -2690,7 +2316,6 @@ The new variables 'ctags-program-name', 'ebrowse-program-name', instead of "ctags", "ebrowse", "etags", "hexl", "emacsclient", and "rcs2log", when starting one of these built in programs in a subprocess. -+++ ** New variable 'case-symbols-as-words' affects case operations for symbols. If non-nil, then case operations such as 'upcase-initials' or 'replace-match' (with nil FIXEDCASE) will treat the entire symbol name @@ -2698,7 +2323,6 @@ as a single word. This is useful for programming languages and styles where only the first letter of a symbol's name is ever capitalized. The default value of this variable is nil. ---- ** Bytecode is now always loaded eagerly. Bytecode compiled with older Emacs versions for lazy loading using 'byte-compile-dynamic' is now loaded all at once. @@ -2706,7 +2330,6 @@ As a consequence, 'fetch-bytecode' has no use, does nothing, and is now obsolete. The variable 'byte-compile-dynamic' has no effect any more; compilation will always yield bytecode for eager loading. -+++ ** Returned strings from functions and macros are never docstrings. Functions and macros whose bodies consist of a single string literal now only return that string, and will not use it as a docstring. Example: @@ -2724,7 +2347,6 @@ forms; other defining forms such as 'cl-defun' already worked this way. ** New or changed byte-compilation warnings ---- *** Warn about missing 'lexical-binding' directive. The compiler now warns if an Elisp file lacks the standard '-*- lexical-binding: ... -*-' cookie on the first line. @@ -2748,7 +2370,6 @@ the line first in the file to declare that it uses the old dialect. ---- *** Warn about empty bodies for more special forms and macros. The compiler now warns about an empty body argument to 'when', 'unless', 'ignore-error' and 'with-suppressed-warnings' in addition to @@ -2759,7 +2380,6 @@ the existing warnings for 'let' and 'let*'. Example: This warning can be suppressed using 'with-suppressed-warnings' with the warning name 'empty-body'. ---- *** Warn about quoted error names in 'condition-case' and 'ignore-error'. The compiler now warns about quoted condition (error) names in 'condition-case' and 'ignore-error'. Example: @@ -2771,7 +2391,6 @@ in 'condition-case' and 'ignore-error'. Example: Quoting them adds the error name 'quote' to those handled or ignored respectively, which was probably not intended. ---- *** Warn about comparison with literal constants without defined identity. The compiler now warns about comparisons by identity with a literal string, cons, vector, record, function, large integer or float as this @@ -2792,7 +2411,6 @@ compared reliably at all. This warning can be suppressed using 'with-suppressed-warnings' with the warning name 'suspicious'. ---- *** Warn about 'condition-case' without handlers. The compiler now warns when the 'condition-case' form is used without any actual handlers, as in @@ -2807,7 +2425,6 @@ was to catch all errors, add an explicit handler for 'error', or use This warning can be suppressed using 'with-suppressed-warnings' with the warning name 'suspicious'. ---- *** Warn about 'unwind-protect' without unwind forms. The compiler now warns when the 'unwind-protect' form is used without any unwind forms, as in @@ -2822,7 +2439,6 @@ simplified away. This warning can be suppressed using 'with-suppressed-warnings' with the warning name 'suspicious'. ---- *** Warn about useless trailing 'cond' clauses. The compiler now warns when a 'cond' form contains clauses following a default (unconditional) clause. Example: @@ -2837,7 +2453,6 @@ perhaps due to misplaced parens. This warning can be suppressed using 'with-suppressed-warnings' with the warning name 'suspicious'. ---- *** Warn about mutation of constant values. The compiler now warns about code that modifies program constants in some obvious cases. Examples: @@ -2857,7 +2472,6 @@ instead. This warning can be suppressed using 'with-suppressed-warnings' with the warning name 'mutate-constant'. ---- *** Warn about more ignored function return values. The compiler now warns when the return value from certain functions is implicitly ignored. Example: @@ -2875,7 +2489,6 @@ name 'ignored-return-value'. The warning will only be issued for calls to functions declared 'important-return-value' or 'side-effect-free' (but not 'error-free'). ---- *** Warn about docstrings that contain control characters. The compiler now warns about docstrings with control characters other than newline and tab. This is often a result of improper escaping. @@ -2890,11 +2503,9 @@ where the docstring contains the four control characters 'CR', 'DEL', The warning name is 'docstrings-control-chars'. ---- *** The warning about wide docstrings can now be disabled separately. Its warning name is 'docstrings-wide'. -+++ ** 'fset', 'defalias' and 'defvaralias' now signal an error for cyclic aliases. Previously, 'fset', 'defalias' and 'defvaralias' could be made to build circular function and variable indirection chains as in @@ -2911,25 +2522,20 @@ Their 'noerror' arguments have no effect and are therefore obsolete. ** Touch Screen support -+++ *** 'x-popup-menu' now understands touch screen events. When a 'touchscreen-begin' or 'touchscreen-end' event is passed as the POSITION argument, it will behave as if that event was a mouse event. -+++ *** New functions for handling touch screen events. The new functions 'touch-screen-track-tap' and 'touch-screen-track-drag' handle tracking common touch screen gestures from within a command. -+++ *** New parameter to 'touchscreen-end' events. CANCEL non-nil establishes that the touch sequence has been intercepted by programs such as window managers and should be ignored with Emacs. ---- ** New variable 'inhibit-auto-fill' to temporarily prevent auto-fill. -+++ ** New variable 'secondary-tool-bar-map'. If non-nil, this variable contains a keymap of menu items that are displayed along tool bar items defined by 'tool-bar-map'. These items @@ -2937,7 +2543,6 @@ are displayed below the tool bar if the value of 'tool-bar-position' is 'top', and above it if the value is 'bottom'. This is used by 'modifier-bar-mode'. ---- ** New variable 'completion-lazy-hilit'. Lisp programs that present completion candidates may bind this variable non-nil around calls to functions such as @@ -2946,12 +2551,10 @@ styles to skip eager fontification of completion candidates, which improves performance. Such a Lisp program can then use the 'completion-lazy-hilit' function to fontify candidates just in time. -+++ ** New primitive 'buffer-last-name'. It returns the name of a buffer before the last time it was renamed or killed. -+++ ** New primitive 'marker-last-position'. It returns the last position of a marker in its buffer even if that buffer has been killed. ('marker-position' would return nil in that @@ -2959,34 +2562,28 @@ case.) ** Functions and variables to transpose sexps ---- *** New helper variable 'transpose-sexps-function'. Lisp programs can now set this variable to customize the behavior of the 'transpose-sexps' command. ---- *** New function 'transpose-sexps-default-function'. The previous implementation of 'transpose-sexps' was moved into its own function, to be used in 'transpose-sexps-function'. ---- *** New function 'treesit-transpose-sexps'. Tree-sitter now unconditionally sets 'transpose-sexps-function' for all tree-sitter enabled modes to this function. ** Functions and variables to move by program statements -+++ *** New variable 'forward-sentence-function'. Major modes can now set this variable to customize the behavior of the 'forward-sentence' command. ---- *** New function 'forward-sentence-default-function'. The previous implementation of 'forward-sentence' is moved into its own function, to be bound by 'forward-sentence-function'. -+++ *** New function 'treesit-forward-sentence'. All tree-sitter enabled modes that define 'sentence' in 'treesit-thing-settings' now set 'forward-sentence-function' to call @@ -2994,13 +2591,11 @@ All tree-sitter enabled modes that define 'sentence' in ** Functions and variables to move by program sexps -+++ *** New function 'treesit-forward-sexp'. Tree-sitter conditionally sets 'forward-sexp-function' for major modes that have defined 'sexp' in 'treesit-thing-settings' to enable sexp-related motion commands. ---- ** New user option 'native-comp-async-warnings-errors-kind'. It allows control of what kinds of warnings and errors from asynchronous native compilation are reported to the parent Emacs process. The @@ -3011,7 +2606,6 @@ and see if you get only warnings that matter. ** Function 'declare' forms -+++ *** New 'ftype' function declaration. The declaration '(ftype TYPE)' specifies the type of a function. Example: @@ -3027,24 +2621,20 @@ native compiler to produce better code, but specifying an incorrect type may lead to Emacs crashing. See the Info node "(elisp) Declare Form" for further information. -+++ *** New 'important-return-value' function declaration and property. The declaration '(important-return-value t)' sets the 'important-return-value' property which indicates that the function return value should probably not be thrown away implicitly. -+++ ** New functions 'file-user-uid' and 'file-group-gid'. These functions are like 'user-uid' and 'group-gid', respectively, but are aware of file name handlers, so they will return the remote UID or GID for remote files (or -1 if the connection has no associated user). -+++ ** 'treesit-font-lock-rules' now accepts additional global keywords. When supplied with ':default-language LANGUAGE', rules after it will default to use 'LANGUAGE'. ---- ** New optional argument to 'modify-dir-local-variable'. An optional 5th argument FILE has been added to 'modify-dir-local-variable'. It can be used to specify which file to @@ -3052,7 +2642,6 @@ modify instead of the default ".dir-locals.el". ** Connection local variables -+++ *** New macros 'connection-local-p' and 'connection-local-value'. The former macro returns non-nil if a variable has a connection-local binding. The latter macro returns the connection-local value of a @@ -3060,14 +2649,12 @@ variable if any, or its current value. ** Hash tables -+++ *** ':rehash-size' and ':rehash-threshold' args no longer have any effect. These keyword arguments are now ignored by 'make-hash-table'. Emacs manages the memory for all hash table objects in the same way. The functions 'hash-table-rehash-size' and 'hash-table-rehash-threshold' remain for compatibility but now always return the old default values. -+++ *** The printed representation has been shrunk and simplified. The 'test' parameter is omitted if it is 'eql' (the default), as is 'data' if empty. 'rehash-size', 'rehash-threshold' and 'size' are @@ -3075,7 +2662,6 @@ always omitted, and ignored if present when the object is read back in. ** Obarrays -+++ *** New obarray type. Obarrays are now represented by an opaque type instead of using vectors. They are created by 'obarray-make' and manage their internal storage @@ -3091,14 +2677,11 @@ with something other than 0, as in '(make-vector N nil)', will no longer work, and should be rewritten to use 'obarray-make'. Alternatively, you can fill the vector with 0. -+++ *** New function 'obarray-clear' removes all symbols from an obarray. ---- *** 'obarray-size' and 'obarray-default-size' are now obsolete. They pertained to the internal storage size which is now irrelevant. -+++ ** 'treesit-install-language-grammar' can handle local directory instead of URL. It is now possible to pass a directory of a local repository as URL inside 'treesit-language-source-alist', so that calling @@ -3106,22 +2689,18 @@ inside 'treesit-language-source-alist', so that calling It may be useful, for example, for the purposes of bisecting a treesitter grammar. -+++ ** New buffer-local variable 'tabulated-list-groups'. It controls display and separate sorting of groups of entries. By default no grouping or sorting is done. -+++ ** New variable 'revert-buffer-restore-functions'. It helps to preserve various states after reverting the buffer. ---- ** New text property 'context-menu-functions'. Like the variable with the same name, it adds menus from the list that is the value of the property to context menus shown when clicking on the text which as this property. ---- ** Detecting the end of an iteration of a keyboard macro. 'read-event', 'read-char', and 'read-char-exclusive' no longer return -1 when called at the end of an iteration of the execution of a keyboard @@ -3133,7 +2712,6 @@ aforementioned functions: (and (arrayp executing-kbd-macro) (>= executing-kbd-macro-index (length executing-kbd-macro))) -+++ ** 'vtable-update-object' updates an existing object with just two arguments. It is now possible to update the representation of an object in a vtable by calling 'vtable-update-object' with just the vtable and the object as @@ -3142,7 +2720,6 @@ this case, would mean repeating the object in the argument list.) When replacing an object with a different one, passing both the new and old objects is still necessary. -+++ ** 'vtable-insert-object' can insert "before" or at an index. The signature of 'vtable-insert-object' has changed and is now: @@ -3155,7 +2732,6 @@ this was not possible.) In addition, LOCATION can be an integer, a (zero-based) index into the table at which the new object is inserted (BEFORE is ignored in this case). -+++ ** New function 'sqlite-execute-batch'. This function lets the user execute multiple SQL statements in one go. It is useful, for example, when a Lisp program needs to evaluate an @@ -3163,45 +2739,37 @@ entire SQL file. ** JSON -+++ *** 'json-serialize' now always returns a unibyte string. This is appropriate since it is an encoding operation. In the unlikely event that a multibyte string is needed, the result can be decoded using (decode-coding-string RESULT 'utf-8) ---- *** The parser keeps duplicated object keys in alist and plist output. A JSON object such as '{"a":1,"a":2}' will now be translated into the Lisp values '((a . 1) (a . 2))' or '(:a 1 :a 2)' if alist or plist object types are requested. ---- *** The parser sometimes signals different types of errors. It will now signal 'json-utf8-decode-error' for inputs that are not correctly UTF-8 encoded. ---- *** The parser and encoder now accept arbitrarily large integers. Previously, they were limited to the range of signed 64-bit integers. ** New tree-sitter functions and variables for defining and using "things" -+++ *** New variable 'treesit-thing-settings'. It allows modes to define "things" like 'defun', 'text', 'sexp', and 'sentence' for navigation commands and tree-traversal functions. -+++ *** New functions for navigating "things". There are new navigation functions 'treesit-thing-prev', 'treesit-thing-next', 'treesit-navigate-thing', 'treesit-beginning-of-thing', and 'treesit-end-of-thing'. -+++ *** New functions 'treesit-thing-at', 'treesit-thing-at-point'. -+++ *** Tree-traversing functions. The functions 'treesit-search-subtree', 'treesit-search-forward', 'treesit-search-forward-goto', and 'treesit-induce-sparse-tree' now @@ -3211,14 +2779,12 @@ for the predicate argument. ** Other tree-sitter function and variable changes -+++ *** 'treesit-parser-list' now takes additional optional arguments. The additional arguments are LANGUAGE and TAG. If LANGUAGE is given, only return parsers for that language. If TAG is given, only return parsers with that tag. Note that passing nil as tag doesn't mean return all parsers, but rather "all parsers with no tags". -+++ *** New variable 'treesit-primary-parser'. This variable should be set by multi-langauge major modes before calling 'treesit-major-mode-setup', in order for tree-sitter integration @@ -3229,7 +2795,6 @@ functionalities to operate correctly. ** MS-Windows -+++ *** You can now opt out of following MS-Windows' Dark mode. By default, Emacs on MS-Windows follows the system's Dark mode for its title bars' and scroll bars' appearance. If the new user option @@ -3237,7 +2802,6 @@ title bars' and scroll bars' appearance. If the new user option will disregard the system's Dark mode and will always use the default Light mode. ---- *** You can now use Image-Dired even if the 'convert' program is not installed. If you don't have GraphicsMagick or ImageMagick installed, and thus the 'gm convert'/'convert' program is not available, Emacs on MS-Windows @@ -3246,7 +2810,6 @@ thumbnail images and show them in the thumbnail buffer. Unlike with using 'convert', this fallback method is synchronous, so Emacs will wait until all the thumbnails are created and displayed, before showing them. ---- *** Emacs on MS-Windows now supports the ':stipple' face attribute. commit a87c382cabaec41f8901c858d4abd52305622b9e Author: Stefan Kangas Date: Sun Jan 26 21:36:43 2025 +0100 ; * etc/NEWS: Add missing temporary documentation tags. diff --git a/etc/NEWS b/etc/NEWS index ef3962db2eb..69ee6da62e9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -593,6 +593,7 @@ Use 'TAB' in the minibuffer to show or hide the password. Alternatively, click the new show-password icon on the mode-line with 'mouse-1' to toggle the visibility of the password. ++++ *** 'advice-remove' is now an interactive command. When called interactively, 'advice-remove' now prompts for an advised function to the advice to remove. @@ -1785,6 +1786,7 @@ feeds, as inheriting backends of 'nnfeed'. This allow users to add Atom Syndication Format feeds to Gnus as servers. +--- *** The 'nnweb-type' option 'gmane' has been removed. The gmane.org website is, sadly, down since a number of years with no prospect of it coming back. Therefore, it is no longer valid to set commit 3c820cd2650a3126ac13fc4825147271285da519 Author: Stefan Kangas Date: Sun Jan 26 21:36:32 2025 +0100 Document insert-directory-program as a user option * doc/lispref/files.texi (Contents of Directories): Document 'insert-directory-program' as a user option. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 1064f347a12..97ad7c6b7fa 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -3227,11 +3227,11 @@ for the sake of dired. However, the normally equivalent short as any other option. @end defun -@defvar insert-directory-program -This variable's value is the program to run to generate a directory listing -for the function @code{insert-directory}. It is ignored on systems -which generate the listing with Lisp code. -@end defvar +@defopt insert-directory-program +This user option specifies the program to run to generate a directory +listing for the function @code{insert-directory}. It is ignored on +systems that generate the listing with Lisp code. +@end defopt @node Create/Delete Dirs @section Creating, Copying and Deleting Directories diff --git a/etc/NEWS b/etc/NEWS index ce5290171a1..ef3962db2eb 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -655,6 +655,7 @@ When visiting a script that invokes 'env -S INTERPRETER ARGS...' in its shebang line, Emacs will now skip over 'env -S' and deduce the major mode based on the interpreter after 'env -S'. ++++ *** 'insert-directory-program' is now a user option. On *BSD and macOS systems, this user option now defaults to the "gls" executable, if it exists. This should remove the need to change its commit 2c1edf5f62adbe1b698e21517a455a2bac09a025 Author: Stefan Monnier Date: Sat Jan 25 10:48:38 2025 -0500 doc/lispref/modes.texi (Syntactic Font Lock): Update for commit 644c6b414f3 Remove outdated `nil` element, as discussed in https://lists.gnu.org/archive/html/help-gnu-emacs/2025-01/msg00244.html diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index aa13f1316c6..31d420eedb6 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -4121,7 +4121,7 @@ This variable is normally set through the ``other'' elements in @lisp (setq-local font-lock-defaults `(,python-font-lock-keywords - nil nil nil nil + nil nil nil (font-lock-syntactic-face-function . python-font-lock-syntactic-face-function))) @end lisp commit aa07e94439c663f768c32a689d14506d25a7a5bc Author: Stefan Kangas Date: Thu Jan 9 03:30:58 2025 +0100 ; Remove some references to deleted files * admin/MAINTAINERS: * admin/authors.el (authors-public-domain-files): * admin/find-gc.el (find-gc-source-files): * src/conf_post.h: Remove some references to deleted files. diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS index 413a587d398..30ed8f632f7 100644 --- a/admin/MAINTAINERS +++ b/admin/MAINTAINERS @@ -31,7 +31,6 @@ Eli Zaretskii src/msdos.[ch] src/dosfns.[ch] src/w16select.c - src/unexcoff.c lisp/term/internal.el lisp/term/pc-win.el lisp/dos-fns.el @@ -272,7 +271,6 @@ Eli Zaretskii src/frame.c src/dired.c src/fileio.c - src/unexw32.c src/w32*.[ch] src/window.c src/indent.c diff --git a/admin/authors.el b/admin/authors.el index 50f3d1ae68d..68b342738a6 100644 --- a/admin/authors.el +++ b/admin/authors.el @@ -376,7 +376,6 @@ If REALNAME is nil, ignore that author.") "nnmaildir\\.el" "nnil\\.el" "b2m\\.c" - "unexhp9k800\\.c" "emacsclient\\.1" "check-doc-strings") "List of regexps matching files for which the FSF doesn't need papers.") diff --git a/admin/find-gc.el b/admin/find-gc.el index 7c5672f4a46..5770b564700 100644 --- a/admin/find-gc.el +++ b/admin/find-gc.el @@ -60,7 +60,7 @@ Each entry has the form (FUNCTION . FUNCTIONS-IT-CALLS).") "indent.c" "search.c" "regex-emacs.c" "undo.c" "alloc.c" "data.c" "doc.c" "editfns.c" "callint.c" "eval.c" "fns.c" "print.c" "lread.c" - "syntax.c" "unexcoff.c" + "syntax.c" "bytecode.c" "process.c" "callproc.c" "doprnt.c" "xterm.c" "xfns.c")) diff --git a/src/conf_post.h b/src/conf_post.h index 3963fb9b878..390d502c927 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -155,7 +155,7 @@ You lose; /* Emacs for DOS must be compiled with DJGPP */ #define emacs_raise(sig) msdos_fatal_signal (sig) -/* DATA_START is needed by vm-limit.c and unexcoff.c. */ +/* DATA_START is needed by vm-limit.c. */ #define DATA_START (&etext + 1) #endif /* MSDOS */ commit f5345a149148f3804fcd58bcd26689c569cbd293 Author: Stefan Kangas Date: Wed Jan 8 06:52:53 2025 +0100 Fix define_error docstring for pure space removal * src/lisp.h (define_error): Adjust docstring for pure space removal. diff --git a/src/lisp.h b/src/lisp.h index 33a9269b305..b17d2954b48 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -5861,8 +5861,7 @@ maybe_gc (void) maybe_garbage_collect (); } -/* Simplified version of 'define-error' that works with pure - objects. */ +/* Simplified version of 'define-error'. */ void define_error (Lisp_Object name, const char *message, Lisp_Object parent); commit f51e643a2fb3258abc921913a4d338eb9842d38f Author: Stefan Kangas Date: Sun Dec 29 19:39:41 2024 +0100 ; * configure.ac: Minor simplification. diff --git a/configure.ac b/configure.ac index 422ca92dca9..0108686edb3 100644 --- a/configure.ac +++ b/configure.ac @@ -7203,8 +7203,6 @@ AC_SUBST([RALLOC_OBJ]) if test "$opsys" = "cygwin"; then CYGWIN_OBJ="cygw32.o" -elif test "$opsys" = "mingw32"; then - CYGWIN_OBJ= else CYGWIN_OBJ= fi commit c70d595708cd0dc19e85e58148a75df21d80f9b2 Author: Stefan Kangas Date: Sat Dec 28 21:35:07 2024 +0100 Delete firstfile.c and lastfile.c With the removal of unexec and purespace, the definitions in these files are no longer used. Remove them. * src/firstfile.c: * src/lastfile.c: Delete unused files. * configure.ac (PRE_ALLOC_OBJ, POST_ALLOC_OBJ, FIRSTFILE_OBJ): Remove variables and dependent code. * msdos/autogen/Makefile.in: * msdos/sed1v2.inp: * src/Makefile.in: Don't use above deleted variables. * src/deps.mk: Remove lastfile.c dependencies. diff --git a/configure.ac b/configure.ac index 86e2e0a9f78..422ca92dca9 100644 --- a/configure.ac +++ b/configure.ac @@ -2998,7 +2998,6 @@ if test "${opsys}" = "mingw32"; then HAVE_W32=${emacs_cv_w32api} fi -FIRSTFILE_OBJ= NTDIR= LIBS_ECLIENT= LIB_WSOCK32= @@ -3046,7 +3045,6 @@ if test "${HAVE_W32}" = "yes"; then W32_RES_LINK="\$(EMACSRES)" CLIENTRES="emacsclient.res" CLIENTW="emacsclientw\$(EXEEXT)" - FIRSTFILE_OBJ=firstfile.o NTDIR=nt CM_OBJ= LIBS_ECLIENT="-lcomctl32" @@ -3068,7 +3066,6 @@ AC_SUBST([EMACS_MANIFEST]) AC_SUBST([CLIENTRES]) AC_SUBST([CLIENTW]) AC_SUBST([W32_RES_LINK]) -AC_SUBST([FIRSTFILE_OBJ]) AC_SUBST([NTDIR]) AC_SUBST([CM_OBJ]) AC_SUBST([LIBS_ECLIENT]) @@ -7206,20 +7203,12 @@ AC_SUBST([RALLOC_OBJ]) if test "$opsys" = "cygwin"; then CYGWIN_OBJ="cygw32.o" - PRE_ALLOC_OBJ= - POST_ALLOC_OBJ=lastfile.o elif test "$opsys" = "mingw32"; then CYGWIN_OBJ= - PRE_ALLOC_OBJ= - POST_ALLOC_OBJ=lastfile.o else CYGWIN_OBJ= - PRE_ALLOC_OBJ=lastfile.o - POST_ALLOC_OBJ= fi AC_SUBST([CYGWIN_OBJ]) -AC_SUBST([PRE_ALLOC_OBJ]) -AC_SUBST([POST_ALLOC_OBJ]) dnl Call this 'FORTIFY_SOUR' so that it sorts before the 'FORTIFY_SOURCE' dnl verbatim defined above. The tricky name is apropos, as this hack diff --git a/msdos/autogen/Makefile.in b/msdos/autogen/Makefile.in index 4225cc72bcc..f67dfc1ba03 100644 --- a/msdos/autogen/Makefile.in +++ b/msdos/autogen/Makefile.in @@ -456,7 +456,6 @@ EOVERFLOW_VALUE = @EOVERFLOW_VALUE@ ERRNO_H = @ERRNO_H@ EXECINFO_H = @EXECINFO_H@ EXEEXT = @EXEEXT@ -FIRSTFILE_OBJ = @FIRSTFILE_OBJ@ FONTCONFIG_CFLAGS = @FONTCONFIG_CFLAGS@ FONTCONFIG_LIBS = @FONTCONFIG_LIBS@ FONT_OBJ = @FONT_OBJ@ @@ -990,10 +989,8 @@ PACKAGE_VERSION = @PACKAGE_VERSION@ PATH_SEPARATOR = @PATH_SEPARATOR@ PAXCTL = @PAXCTL@ PKG_CONFIG = @PKG_CONFIG@ -POST_ALLOC_OBJ = @POST_ALLOC_OBJ@ PRAGMA_COLUMNS = @PRAGMA_COLUMNS@ PRAGMA_SYSTEM_HEADER = @PRAGMA_SYSTEM_HEADER@ -PRE_ALLOC_OBJ = @PRE_ALLOC_OBJ@ PRIPTR_PREFIX = @PRIPTR_PREFIX@ PRI_MACROS_BROKEN = @PRI_MACROS_BROKEN@ PROFILING_CFLAGS = @PROFILING_CFLAGS@ diff --git a/msdos/sed1v2.inp b/msdos/sed1v2.inp index a84cee32927..e344058ea08 100644 --- a/msdos/sed1v2.inp +++ b/msdos/sed1v2.inp @@ -165,10 +165,7 @@ s/ *@WEBP_LIBS@// /^XINERAMA_CFLAGS *=/s/@XINERAMA_CFLAGS@// /^GMALLOC_OBJ *=/s/@GMALLOC_OBJ@/gmalloc.o/ /^VMLIMIT_OBJ *=/s/@VMLIMIT_OBJ@/vm-limit.o/ -/^FIRSTFILE_OBJ *=/s/@FIRSTFILE_OBJ@// /^RALLOC_OBJ *=/s/@RALLOC_OBJ@/ralloc.o/ -/^PRE_ALLOC_OBJ *=/s/@PRE_ALLOC_OBJ@/lastfile.o/ -/^POST_ALLOC_OBJ *=/s/@POST_ALLOC_OBJ@/$(vmlimitobj)/ /^UNEXEC_OBJ *=/s/@UNEXEC_OBJ@/unexcoff.o/ /^BUILD_DETAILS *=/s/@BUILD_DETAILS@// /^CANNOT_DUMP *=/s/@CANNOT_DUMP@/no/ diff --git a/src/Makefile.in b/src/Makefile.in index 51352dd6d74..ce7d7bb36f3 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -446,8 +446,6 @@ ALL_CXX_CFLAGS = $(EMACS_CFLAGS) \ .cc.o: $(AM_V_CXX)$(CXX) -c $(CPPFLAGS) $(ALL_CXX_CFLAGS) $(PROFILING_CFLAGS) $< -## lastfile must follow all files whose initialized data areas should -## be dumped as pure by dump-emacs. base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \ charset.o coding.o category.o ccl.o character.o chartab.o bidi.o \ $(CM_OBJ) term.o terminal.o xfaces.o $(XOBJ) $(GTK_OBJ) $(DBUS_OBJ) \ @@ -496,19 +494,11 @@ VMLIMIT_OBJ=@VMLIMIT_OBJ@ ## ralloc.o if !SYSTEM_MALLOC && REL_ALLOC, else empty. RALLOC_OBJ=@RALLOC_OBJ@ -## Empty on Cygwin and MinGW, lastfile.o elsewhere. -PRE_ALLOC_OBJ=@PRE_ALLOC_OBJ@ -## lastfile.o on Cygwin and MinGW, empty elsewhere. -POST_ALLOC_OBJ=@POST_ALLOC_OBJ@ - ## List of object files that make-docfile should not be told about. -otherobj= $(TERMCAP_OBJ) $(PRE_ALLOC_OBJ) $(GMALLOC_OBJ) $(RALLOC_OBJ) \ - $(POST_ALLOC_OBJ) $(WIDGET_OBJ) $(LIBOBJS) +otherobj= $(TERMCAP_OBJ) $(GMALLOC_OBJ) $(RALLOC_OBJ) $(WIDGET_OBJ) $(LIBOBJS) ## All object files linked into temacs. $(VMLIMIT_OBJ) should be first. -## (On MinGW, firstfile.o should be before vm-limit.o.) -FIRSTFILE_OBJ=@FIRSTFILE_OBJ@ -ALLOBJS = $(FIRSTFILE_OBJ) $(VMLIMIT_OBJ) $(obj) $(otherobj) +ALLOBJS = $(VMLIMIT_OBJ) $(obj) $(otherobj) # Must be first, before dep inclusion! ifneq ($(HAVE_BE_APP),yes) diff --git a/src/deps.mk b/src/deps.mk index 0ba43a014f8..80937e26b10 100644 --- a/src/deps.mk +++ b/src/deps.mk @@ -137,7 +137,6 @@ keyboard.o: keyboard.c termchar.h termhooks.h termopts.h buffer.h character.h \ keymap.o: keymap.c buffer.h commands.h keyboard.h termhooks.h blockinput.h \ atimer.h systime.h character.h charset.h $(INTERVALS_H) \ keymap.h window.h coding.h frame.h lisp.h globals.h $(config_h) -lastfile.o: lastfile.c $(config_h) macros.o: macros.c window.h buffer.h commands.h macros.h keyboard.h msdos.h \ dispextern.h lisp.h globals.h $(config_h) systime.h coding.h composite.h gmalloc.o: gmalloc.c $(config_h) diff --git a/src/firstfile.c b/src/firstfile.c deleted file mode 100644 index 737757a2779..00000000000 --- a/src/firstfile.c +++ /dev/null @@ -1,32 +0,0 @@ -/* Mark beginning of data space to dump as pure, for GNU Emacs. - Copyright (C) 1997, 2001-2024 Free Software Foundation, Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or (at -your option) any later version. - -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see . */ - - -#include - -#ifdef WINDOWSNT -/* See comments in lastfile.c. */ -char my_begdata[] = "Beginning of Emacs initialized data"; -char my_begbss[1]; /* Do not initialize this variable. */ -static char _my_begbss[1]; -char * my_begbss_static = _my_begbss; - -/* Add a dummy reference to ensure emacs.o is linked in. */ -extern int main (int, char **); -int (*dummy_main_reference) (int, char **) = main; -#endif diff --git a/src/lastfile.c b/src/lastfile.c deleted file mode 100644 index 9f2b2a04958..00000000000 --- a/src/lastfile.c +++ /dev/null @@ -1,44 +0,0 @@ -/* Mark end of data space to dump as pure, for GNU Emacs. - Copyright (C) 1985, 2001-2024 Free Software Foundation, Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or (at -your option) any later version. - -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see . */ - - -/* How this works: - - Fdump_emacs dumps everything up to my_edata as text space (pure). - - The files of Emacs are written so as to have no initialized - data that can ever need to be altered except at the first startup. - This is so that those words can be dumped as shareable text. - - It is not possible to exercise such control over library files. - So it is necessary to refrain from making their data areas shared. - Therefore, this file is loaded following all the files of Emacs - but before library files. - As a result, the symbol my_edata indicates the point - in data space between data coming from Emacs and data - coming from libraries. -*/ - -#include - -#include "lisp.h" - -#if (!defined SYSTEM_MALLOC \ - || defined WINDOWSNT || defined CYGWIN || defined DARWIN_OS) -char my_edata[] = "End of Emacs initialized data"; -#endif commit 305bd550cf28045505e76c2b23f51860da914310 Author: Stefan Kangas Date: Sat Dec 28 13:08:14 2024 +0100 ; * nt/INSTALL: Delete reference to unexec build. diff --git a/nt/INSTALL b/nt/INSTALL index b959ce362f7..8c85fc27e87 100644 --- a/nt/INSTALL +++ b/nt/INSTALL @@ -515,7 +515,6 @@ build should run on Windows 9X and newer systems). Does Emacs support Xwidgets? no Does Emacs have threading support in lisp? yes Does Emacs support the portable dumper? yes - Does Emacs support the legacy unexec dumping? no Which dumping strategy does Emacs use? pdumper You are almost there, hang on. commit b86e4747e66febd400055cb6279238fb95f8a59d Author: Andrea Corallo Date: Wed Dec 18 21:58:15 2024 +0100 * Make again `comp--finalize-container' compilable * lisp/emacs-lisp/comp.el (comp--finalize-container): Don't emit '--lambda-fixup' immediate in data relocations. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index dbd14b2740d..ab6fd77f11a 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -3254,7 +3254,10 @@ Set it into the `type' slot." ;; from the corresponding m-var. collect (if (gethash obj (comp-ctxt-byte-func-to-func-h comp-ctxt)) - 'lambda-fixup + ;; Hack not to have `--lambda-fixup' in + ;; data relocations as it would trigger the + ;; check in 'check_comp_unit_relocs'. + (intern (concat (make-string 1 ?-) "-lambda-fixup")) obj)))) (defun comp--finalize-relocs () commit 9e99c43d2f5dc5dc2632ad616d224f3bd9cf63c4 Author: Andrea Corallo Date: Wed Dec 18 21:55:41 2024 +0100 Use '--lambda-fixup' as native compiler fixup symbol for lambdas * src/comp.c (check_comp_unit_relocs, syms_of_comp): Rename 'Qlambda_fixup' to 'Q__lambda_fixup'. * src/pdumper.c (dump_do_dump_relocation): Likewise. diff --git a/src/comp.c b/src/comp.c index ac26ead08d9..8b38adec252 100644 --- a/src/comp.c +++ b/src/comp.c @@ -5173,7 +5173,7 @@ check_comp_unit_relocs (struct Lisp_Native_Comp_Unit *comp_u) for (ptrdiff_t i = 0; i < d_vec_len; i++) { Lisp_Object x = data_relocs[i]; - if (EQ (x, Qlambda_fixup)) + if (EQ (x, Q__lambda_fixup)) return false; else if (NATIVE_COMP_FUNCTIONP (x)) { @@ -5622,7 +5622,7 @@ natively-compiled one. */); DEFSYM (Qfixnum, "fixnum"); DEFSYM (Qscratch, "scratch"); DEFSYM (Qlate, "late"); - DEFSYM (Qlambda_fixup, "lambda-fixup"); + DEFSYM (Q__lambda_fixup, "--lambda-fixup"); DEFSYM (Qgccjit, "gccjit"); DEFSYM (Qcomp_subr_trampoline_install, "comp-subr-trampoline-install"); DEFSYM (Qnative_comp_warning_on_missing_source, diff --git a/src/pdumper.c b/src/pdumper.c index f9d74f87fb4..d45bbc84bba 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -5504,7 +5504,7 @@ dump_do_dump_relocation (const uintptr_t dump_base, XSETSUBR (tem, subr); Lisp_Object *fixup = &(comp_u->data_relocs[XFIXNUM (lambda_data_idx)]); - eassert (EQ (*fixup, Qlambda_fixup)); + eassert (EQ (*fixup, Q__lambda_fixup)); *fixup = tem; Fputhash (tem, Qt, comp_u->lambda_gc_guard_h); } commit 4e11f9c96df98dd3f10c1153bc49209f2383a0ee Author: Andrea Corallo Date: Wed Dec 18 21:27:14 2024 +0100 * Revert "Remove check_comp_unit_relocs" This reverts commit 81fc23b5d6a60ca4f3d269ab2c88eb9a850bac4c as the check is still useful but needs to be updated for the new reloc layout. * src/comp.c (check_comp_unit_relocs): Re-add. (load_comp_unit): Make use of. diff --git a/src/comp.c b/src/comp.c index aa24f61ac87..ac26ead08d9 100644 --- a/src/comp.c +++ b/src/comp.c @@ -5160,6 +5160,32 @@ load_static_obj (struct Lisp_Native_Comp_Unit *comp_u, const char *name) } +/* Return false when something is wrong or true otherwise. */ + +static bool +check_comp_unit_relocs (struct Lisp_Native_Comp_Unit *comp_u) +{ + dynlib_handle_ptr handle = comp_u->handle; + Lisp_Object *data_relocs = dynlib_sym (handle, DATA_RELOC_SYM); + + EMACS_INT d_vec_len = XFIXNUM (Flength (comp_u->data_vec)); + + for (ptrdiff_t i = 0; i < d_vec_len; i++) + { + Lisp_Object x = data_relocs[i]; + if (EQ (x, Qlambda_fixup)) + return false; + else if (NATIVE_COMP_FUNCTIONP (x)) + { + if (NILP (Fgethash (x, comp_u->lambda_gc_guard_h, Qnil))) + return false; + } + else if (!EQ (x, AREF (comp_u->data_vec, i))) + return false; + } + return true; +} + static void unset_cu_load_ongoing (Lisp_Object comp_u) { @@ -5289,6 +5315,7 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, /* Make sure data_ephemeral_vec still exists after top_level_run has run. Guard against sibling call optimization (or any other). */ data_ephemeral_vec = data_ephemeral_vec; + eassert (check_comp_unit_relocs (comp_u)); } if (!recursive_load) commit 81fc23b5d6a60ca4f3d269ab2c88eb9a850bac4c Author: Gerd Möllmann Date: Tue Dec 17 15:28:14 2024 +0100 Remove check_comp_unit_relocs * src/comp.c (check_comp_unit_relocs): Removed. (load_comp_unit): Remove use. diff --git a/src/comp.c b/src/comp.c index ac26ead08d9..aa24f61ac87 100644 --- a/src/comp.c +++ b/src/comp.c @@ -5160,32 +5160,6 @@ load_static_obj (struct Lisp_Native_Comp_Unit *comp_u, const char *name) } -/* Return false when something is wrong or true otherwise. */ - -static bool -check_comp_unit_relocs (struct Lisp_Native_Comp_Unit *comp_u) -{ - dynlib_handle_ptr handle = comp_u->handle; - Lisp_Object *data_relocs = dynlib_sym (handle, DATA_RELOC_SYM); - - EMACS_INT d_vec_len = XFIXNUM (Flength (comp_u->data_vec)); - - for (ptrdiff_t i = 0; i < d_vec_len; i++) - { - Lisp_Object x = data_relocs[i]; - if (EQ (x, Qlambda_fixup)) - return false; - else if (NATIVE_COMP_FUNCTIONP (x)) - { - if (NILP (Fgethash (x, comp_u->lambda_gc_guard_h, Qnil))) - return false; - } - else if (!EQ (x, AREF (comp_u->data_vec, i))) - return false; - } - return true; -} - static void unset_cu_load_ongoing (Lisp_Object comp_u) { @@ -5315,7 +5289,6 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, /* Make sure data_ephemeral_vec still exists after top_level_run has run. Guard against sibling call optimization (or any other). */ data_ephemeral_vec = data_ephemeral_vec; - eassert (check_comp_unit_relocs (comp_u)); } if (!recursive_load) commit d140b5cabbbcc5368cfe8c38021d9f6e41a640d8 Author: Pip Cet Date: Mon Dec 16 12:28:59 2024 +0000 ; * src/fns.c (maybe_resize_hash_table): Remove debugging code. diff --git a/src/fns.c b/src/fns.c index 7c2ddb8707c..6d6029ed33a 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5011,11 +5011,6 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket)); set_hash_index_slot (h, start_of_bucket, i); } - -#ifdef ENABLE_CHECKING - if (HASH_TABLE_P (Vpurify_flag) && XHASH_TABLE (Vpurify_flag) == h) - message ("Growing hash table to: %"pD"d", new_size); -#endif } } commit 925431f030b6d6e095ed8f946243e144adcff54c Author: Stefan Kangas Date: Sun Dec 15 19:35:48 2024 +0100 Don't define SYSTEM_PURESIZE_EXTRA * nt/inc/ms-w32.h: Don't define SYSTEM_PURESIZE_EXTRA. diff --git a/nt/inc/ms-w32.h b/nt/inc/ms-w32.h index d2217ced9a7..0c6962a256f 100644 --- a/nt/inc/ms-w32.h +++ b/nt/inc/ms-w32.h @@ -595,9 +595,6 @@ typedef unsigned int EMACS_UINT; # endif #endif -/* We need a little extra space, see ../../lisp/loadup.el. */ -#define SYSTEM_PURESIZE_EXTRA 50000 - #define DATA_START get_data_start () /* For unexec to work on Alpha systems, we need to put Emacs' commit c729d224ca7bd55d9f49af9d730af45663a3f3d5 Author: Stefan Kangas Date: Sun Dec 15 19:15:29 2024 +0100 Remove some more references to pure space * lisp/auth-source.el (read-passwd-map): * lisp/emacs-lisp/eldoc.el (eldoc-message-commands) (eldoc-last-data): Remove some references to pure space. diff --git a/lisp/auth-source.el b/lisp/auth-source.el index 1e0cde75583..d445c339571 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -2515,8 +2515,6 @@ Adapt also mode line." (read-passwd--hide-password))))) (defvar read-passwd-map - ;; BEWARE: `defconst' would purecopy it, breaking the sharing with - ;; minibuffer-local-map along the way! (let ((map (make-sparse-keymap))) (set-keymap-parent map minibuffer-local-map) (define-key map "\C-u" #'delete-minibuffer-contents) ;bug#12570 diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index aa1871ac482..f412a38d6f5 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -154,7 +154,6 @@ this file since the obarray is initialized at load time. Remember to keep it a prime number to improve hash performance.") (defvar eldoc-message-commands - ;; Don't define as `defconst' since it would then go to (read-only) purespace. (obarray-make eldoc-message-commands-table-size) "Commands after which it is appropriate to print in the echo area. ElDoc does not try to print function arglists, etc., after just any command, @@ -166,7 +165,6 @@ directly. Instead, use `eldoc-add-command' and `eldoc-remove-command'.") ;; Not a constant. (defvar eldoc-last-data (make-vector 3 nil) - ;; Don't define as `defconst' since it would then go to (read-only) purespace. "Bookkeeping; elements are as follows: 0 - contains the last symbol read from the buffer. 1 - contains the string last displayed in the echo area for variables, commit f818744cd4b1dddece0a221b06e6e83740e06e2d Author: Stefan Kangas Date: Sun Dec 15 19:14:04 2024 +0100 Improve purify-flag docstring * src/alloc.c (syms_of_alloc): Improve purify-flag docstring. diff --git a/src/alloc.c b/src/alloc.c index 82d1a3a9891..8718121141b 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -7637,13 +7637,11 @@ If this portion is smaller than `gc-cons-threshold', this is ignored. */); DEFVAR_LISP ("purify-flag", Vpurify_flag, doc: /* Non-nil means loading Lisp code in order to dump an executable. -This used to mean that certain objects should be allocated in shared (pure) -space. It can also be set to a hash-table, in which case this table is used -to do hash-consing of the objects allocated to pure space. -The hash-consing still applies, but objects are not allocated in pure -storage any more. -This flag is still used in a few places not to decide where objects are -allocated but to know if we're in the preload phase of Emacs's build. */); +This used to mean that certain objects should be allocated in shared +(pure) space, but objects are not allocated in pure storage any more. +This flag is still used in a few places, not to decide where objects are +allocated, but to know if we're in the preload phase of Emacs's +build. */); DEFVAR_BOOL ("garbage-collection-messages", garbage_collection_messages, doc: /* Non-nil means display messages at start and end of garbage collection. */); commit d05ee2ba80b0961015eb543536266208afb57dff Author: Stefan Kangas Date: Sun Dec 15 19:13:35 2024 +0100 Don't document removed SITELOAD_PURESIZE_EXTRA * doc/lispref/internals.texi (Building Emacs): Don't document removed constant SITELOAD_PURESIZE_EXTRA. diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index fb7fe9aad76..5b7f36caae3 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -102,19 +102,9 @@ Emacs. @cindex @file{site-load.el} You can specify additional files to preload by writing a library named -@file{site-load.el} that loads them. You may need to rebuild Emacs -with an added definition - -@example -#define SITELOAD_PURESIZE_EXTRA @var{n} -@end example - -@noindent -to make @var{n} added bytes of pure space to hold the additional files; -see @file{src/puresize.h}. -(Try adding increments of 20000 until it is big enough.) However, the -advantage of preloading additional files decreases as machines get -faster. On modern machines, it is usually not advisable. +@file{site-load.el} that loads them. However, the advantage of +preloading additional files decreases as machines get faster. On modern +machines, it is usually not advisable. After @file{loadup.el} reads @file{site-load.el}, it finds the documentation strings for primitive and preloaded functions (and commit 526ef8950a98f2d040b9e4f143aa62538904a39f Author: Stefan Kangas Date: Sun Dec 15 19:08:20 2024 +0100 Remove another purecopy call in files.el * lisp/files.el (save-some-buffers-action-alist): Don't call purecopy. diff --git a/lisp/files.el b/lisp/files.el index cce0396ef3d..c9b550a721e 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6175,7 +6175,7 @@ Before and after saving the buffer, this function runs (set-buffer-modified-p nil)) ;; Return t so we don't ask about BUF again. t) - ,(purecopy "skip this buffer and mark it unmodified")) + "skip this buffer and mark it unmodified") (?\C-r ,(lambda (buf) (if (not enable-recursive-minibuffers) commit 7024c66123e56501fd409a9b59522fceb5ce8cfd Author: Pip Cet Date: Sat Dec 14 15:45:25 2024 +0000 Fix a typo which caused test failures * lisp/progmodes/python.el (interpreter-mode-alist): * lisp/progmodes/vera-mode.el (interpreter-mode-alist): Fix typo. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index cdc1f267ea3..253568119f2 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -291,7 +291,7 @@ ;;;###autoload (add-to-list 'auto-mode-alist (cons python--auto-mode-alist-regexp 'python-mode)) ;;;###autoload -(add-to-list 'interpreter-mode-alist '("python[0-9.]*" python-mode)) +(add-to-list 'interpreter-mode-alist '("python[0-9.]*" . python-mode)) (defgroup python nil "Python Language's flying circus support for Emacs." diff --git a/lisp/progmodes/vera-mode.el b/lisp/progmodes/vera-mode.el index b3002127ff1..6897ae34805 100644 --- a/lisp/progmodes/vera-mode.el +++ b/lisp/progmodes/vera-mode.el @@ -208,7 +208,7 @@ If nil, TAB always indents current line." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Mode definition -;;;###autoload (add-to-list 'auto-mode-alist '("\\.vr[hi]?\\'" vera-mode)) +;;;###autoload (add-to-list 'auto-mode-alist '("\\.vr[hi]?\\'" . vera-mode)) ;;;###autoload (define-derived-mode vera-mode prog-mode "Vera" commit 28dadb6f10aa7a0c785d79bb10d77babb7502dee Author: Stefan Kangas Date: Tue Dec 10 23:57:22 2024 +0100 Mark pure-bytes-used as obsolete * lisp/subr.el (pure-bytes-used): Mark variable as obsolete. diff --git a/lisp/subr.el b/lisp/subr.el index 0c54393494c..27c3f15c0d5 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2044,6 +2044,8 @@ instead; it will indirectly limit the specpdl stack size as well.") (define-obsolete-function-alias 'purecopy #'identity "31.1") +(make-obsolete-variable 'pure-bytes-used "no longer used." "31.1") + ;;;; Alternate names for functions - these are not being phased out. commit e7926ab48604d4bdf7088014717b02dddfe9f190 Author: Stefan Kangas Date: Tue Dec 10 23:35:31 2024 +0100 Delete variable pure-space-overflow * lisp/startup.el (pure-space-overflow): Make variable obsolete. * lisp/loadup.el (pure-space-overflow): Do not set. Remove call to `garbage-collect', as that is done by `dump-emacs-portable'. diff --git a/lisp/loadup.el b/lisp/loadup.el index 74fbc2372ab..dc37014cb9d 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -565,9 +565,6 @@ directory got moved. This is set to be a pair in the form of: ;; Avoid error if user loads some more libraries now. (setq purify-flag nil) -(if (null (garbage-collect)) - (setq pure-space-overflow t)) - ;; Make sure we will attempt bidi reordering henceforth. (setq redisplay--inhibit-bidi nil) diff --git a/lisp/startup.el b/lisp/startup.el index 5926d816cc4..7b2c3db56c3 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -427,9 +427,6 @@ from being initialized." (defvar no-blinking-cursor nil) -(defvar pure-space-overflow nil - "Non-nil if building Emacs overflowed pure space.") - (defcustom tutorial-directory (file-name-as-directory (expand-file-name "tutorials" data-directory)) "Directory containing the Emacs TUTORIAL files." commit d6b05b128280cc23dc77a1a06194c4e69d1ac519 Author: Stefan Kangas Date: Tue Dec 10 19:39:03 2024 +0100 Make 'purecopy' an obsolete function alias for 'identity' * lisp/subr.el (purecopy): New obsolete function alias for 'identity'. * src/alloc.c (purecopy): Remove function. (Fpurecopy): Remove DEFUN. (syms_of_alloc): Remove defsubr for above DEFUN. * lisp/loadup.el (purify-flag): Don't set to hash table. * doc/lispref/spellfile: * doc/lispref/keymaps.texi (Tool Bar): * lisp/emacs-lisp/byte-opt.el (side-effect-free-fns): Delete references to 'purecopy' diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index 87723720b1e..878f51555c1 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -3056,7 +3056,7 @@ By default, the global map binds @code{[tool-bar]} as follows: @example (keymap-global-set "" - `(menu-item ,(purecopy "tool bar") ignore + '(menu-item "tool bar" ignore :filter tool-bar-make-keymap)) @end example diff --git a/doc/lispref/spellfile b/doc/lispref/spellfile index 11a6ce813af..d1875b464c6 100644 --- a/doc/lispref/spellfile +++ b/doc/lispref/spellfile @@ -418,7 +418,6 @@ ps psf psychotherapy pty -purecopy qu quux rassq diff --git a/etc/NEWS b/etc/NEWS index f00b2cd7bee..945882e00c8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -883,6 +883,9 @@ restore the old behavior, you can set 'eshell-pwd-convert-function' to * Lisp Changes in Emacs 31.1 ++++ +** The function 'purecopy' is now an obsolete alias for 'identity'. + --- ** New function 'native-compile-directory'. This function natively-compiles all Lisp files in a directory and in its diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 0a89a33cbc3..217445e9d15 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1859,7 +1859,7 @@ See Info node `(elisp) Integer Basics'." (side-effect-and-error-free-fns '( ;; alloc.c - bool-vector cons list make-marker purecopy record vector + bool-vector cons list make-marker record vector ;; buffer.c buffer-list buffer-live-p current-buffer overlay-lists overlayp ;; casetab.c diff --git a/lisp/loadup.el b/lisp/loadup.el index 1ba25d967b5..74fbc2372ab 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -105,10 +105,6 @@ ;; than usual. (setq max-lisp-eval-depth (max max-lisp-eval-depth 3400)))) -(if (eq t purify-flag) - ;; Hash consing saved around 11% of pure space in my tests. - (setq purify-flag (make-hash-table :test #'equal :size 80000))) - (message "Using load-path %s" load-path) (if dump-mode @@ -565,25 +561,8 @@ directory got moved. This is set to be a pair in the form of: ;; file-local variables. (defvar comp--no-native-compile (make-hash-table :test #'equal))) -(when (hash-table-p purify-flag) - (let ((strings 0) - (vectors 0) - (bytecodes 0) - (conses 0) - (others 0)) - (maphash (lambda (k v) - (cond - ((stringp k) (setq strings (1+ strings))) - ((vectorp k) (setq vectors (1+ vectors))) - ((consp k) (setq conses (1+ conses))) - ((byte-code-function-p v) (setq bytecodes (1+ bytecodes))) - (t (setq others (1+ others))))) - purify-flag) - (message "Pure-hashed: %d strings, %d vectors, %d conses, %d bytecodes, %d others" - strings vectors conses bytecodes others))) - -;; Avoid error if user loads some more libraries now and make sure the -;; hash-consing hash table is GC'd. + +;; Avoid error if user loads some more libraries now. (setq purify-flag nil) (if (null (garbage-collect)) diff --git a/lisp/subr.el b/lisp/subr.el index c72e6eb0b0e..0c54393494c 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2042,6 +2042,8 @@ instead; it will indirectly limit the specpdl stack size as well.") (define-obsolete-function-alias 'fetch-bytecode #'ignore "30.1") +(define-obsolete-function-alias 'purecopy #'identity "31.1") + ;;;; Alternate names for functions - these are not being phased out. diff --git a/src/alloc.c b/src/alloc.c index 5e2747af1f0..82d1a3a9891 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -5585,42 +5585,6 @@ hash_table_free_bytes (void *p, ptrdiff_t nbytes) xfree (p); } - -static Lisp_Object purecopy (Lisp_Object obj); - -DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0, - doc: /* Make a copy of object OBJ in pure storage. -Recursively copies contents of vectors and cons cells. -Does not copy symbols. Copies strings without text properties. */) - (register Lisp_Object obj) -{ - if (NILP (Vpurify_flag)) - return obj; - else if (MARKERP (obj) || OVERLAYP (obj) || SYMBOLP (obj)) - /* Can't purify those. */ - return obj; - else - return purecopy (obj); -} - -static Lisp_Object -purecopy (Lisp_Object obj) -{ - if (FIXNUMP (obj) || SUBRP (obj)) - return obj; /* No need to hash. */ - - if (HASH_TABLE_P (Vpurify_flag)) /* Hash consing. */ - { - Lisp_Object tmp = Fgethash (obj, Vpurify_flag, Qnil); - if (!NILP (tmp)) - return tmp; - Fputhash (obj, obj, Vpurify_flag); - } - - return obj; -} - - /*********************************************************************** Protection from GC @@ -7748,7 +7712,6 @@ N should be nonnegative. */); defsubr (&Smake_symbol); defsubr (&Smake_marker); defsubr (&Smake_finalizer); - defsubr (&Spurecopy); defsubr (&Sgarbage_collect); defsubr (&Sgarbage_collect_maybe); defsubr (&Smemory_info); commit b299a5d184542cdc66632b1a47947151a11c035e Author: Stefan Kangas Date: Tue Dec 10 19:23:00 2024 +0100 Delete obsolete comment about using purespace * src/alloc.c (Fmake_byte_code): Delete obsolete comment. diff --git a/src/alloc.c b/src/alloc.c index e1b0259fa8d..5e2747af1f0 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3764,13 +3764,6 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT /* Bytecode must be immovable. */ pin_string (args[CLOSURE_CODE]); - /* We used to purecopy everything here, if purify-flag was set. This worked - OK for Emacs-23, but with Emacs-24's lexical binding code, it can be - dangerous, since make-byte-code is used during execution to build - closures, so any closure built during the preload phase would end up - copied into pure space, including its free variables, which is sometimes - just wasteful and other times plainly wrong (e.g. those free vars may want - to be setcar'd). */ Lisp_Object val = Fvector (nargs, args); XSETPVECTYPE (XVECTOR (val), PVEC_CLOSURE); return val; commit 52dcc032067381f50d658dc43bf7088f1782c7af Author: Stefan Kangas Date: Tue Dec 10 12:34:34 2024 +0100 Delete workaround for purespace in cl-generic * lisp/emacs-lisp/cl-generic.el (cl-generic-define-method): Delete purespace workaround. diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 11685d09d12..96f585df0c5 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -654,11 +654,7 @@ The set of acceptable TYPEs (also called \"specializers\") is defined (symbol-function sym))) ;; Prevent `defalias' from recording this as the definition site of ;; the generic function. - current-load-list - ;; BEWARE! Don't purify this function definition, since that leads - ;; to memory corruption if the hash-tables it holds are modified - ;; (the GC doesn't trace those pointers). - (purify-flag nil)) + current-load-list) (when (listp old-adv-cc) (set-advertised-calling-convention gfun old-adv-cc nil)) ;; But do use `defalias', so that it interacts properly with nadvice, commit ad9adab04284213aefc3872a610779dc633ff541 Author: Stefan Kangas Date: Tue Dec 10 11:43:54 2024 +0100 Remove unused function my_heap_start * src/alloc.c (my_heap_start) [DOUG_LEA_MALLOC && GNU_LINUX]: Remove unused function. Update callers. diff --git a/src/alloc.c b/src/alloc.c index 1e0e5f58e84..e1b0259fa8d 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -219,9 +219,6 @@ malloc_initialize_hook (void) if (! initialized) { -# ifdef GNU_LINUX - my_heap_start (); -# endif malloc_using_checking = getenv ("MALLOC_CHECK_") != NULL; } else @@ -257,22 +254,6 @@ voidfuncptr __MALLOC_HOOK_VOLATILE __malloc_initialize_hook EXTERNALLY_VISIBLE #endif -#if defined DOUG_LEA_MALLOC -# ifdef GNU_LINUX - -/* The address where the heap starts. */ -void * -my_heap_start (void) -{ - static void *start; - if (! start) - start = sbrk (0); - return start; -} -# endif - -#endif - /* Mark, unmark, query mark bit of a Lisp string. S must be a pointer to a struct Lisp_String. */ diff --git a/src/lisp.h b/src/lisp.h index 695d5f200ea..33a9269b305 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4428,7 +4428,6 @@ extern void parse_str_as_multibyte (const unsigned char *, ptrdiff_t, /* Defined in alloc.c. */ extern intptr_t garbage_collection_inhibited; -extern void *my_heap_start (void); unsigned char *resize_string_data (Lisp_Object, ptrdiff_t, int, int); extern void malloc_warning (const char *); extern AVOID memory_full (size_t); commit 892be3b3d7a459808ee47709d0f4e7f65566a6e5 Author: Stefan Kangas Date: Tue Dec 10 11:07:01 2024 +0100 Remove check for working malloc_set_state This check was added to 'malloc_initialize_hook' in order to "insulate Emacs better from configuration screwups" (commit b4788b9394f3). With unexec gone, we no longer use 'malloc_set_state', and thus don't need this check. Note that this patch removes the last uses of the deprecated glibc functions 'malloc_set_state' and 'malloc_get_state' from our code. * src/alloc.c (malloc_initialize_hook) [DOUG_LEA_MALLOC]: Remove check for working 'malloc_set_state'. (alloc_unexec_pre) [DOUG_LEA_MALLOC]: Delete unused function. (alloc_unexec_post) [DOUG_LEA_MALLOC]: Delete function. (malloc_state_ptr) [DOUG_LEA_MALLOC]: Delete variable. * configure.ac (emacs_cv_var_doug_lea_malloc): Don't check for malloc_set_state and malloc_get_state. diff --git a/configure.ac b/configure.ac index b320c4978d6..86e2e0a9f78 100644 --- a/configure.ac +++ b/configure.ac @@ -3206,8 +3206,7 @@ AC_CACHE_CHECK( [AC_LANG_PROGRAM( [[#include static void hook (void) {}]], - [[malloc_set_state (malloc_get_state ()); - __after_morecore_hook = hook; + [[__after_morecore_hook = hook; __malloc_initialize_hook = hook;]])], [emacs_cv_var_doug_lea_malloc=yes]) fi]) @@ -3255,7 +3254,7 @@ if test "$doug_lea_malloc" = "yes"; then fi AC_DEFINE([DOUG_LEA_MALLOC], [1], [Define to 1 if the system memory allocator is Doug Lea style, - with malloc hooks and malloc_set_state.]) + with malloc hooks.]) ## Use mmap directly for allocating larger buffers. ## FIXME this comes from src/s/{gnu,gnu-linux}.h: diff --git a/src/alloc.c b/src/alloc.c index e557e82883c..1e0e5f58e84 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -209,10 +209,6 @@ enum { MALLOC_ALIGNMENT = max (2 * sizeof (size_t), alignof (long double)) }; # define MMAP_MAX_AREAS 100000000 -/* A pointer to the memory allocated that copies that static data - inside glibc's malloc. */ -static void *malloc_state_ptr; - /* Restore the dumped malloc state. Because malloc can be invoked even before main (e.g. by the dynamic linker), the dumped malloc state must be restored as early as possible using this special hook. */ @@ -247,10 +243,6 @@ malloc_initialize_hook (void) break; } } - - if (malloc_set_state (malloc_state_ptr) != 0) - emacs_abort (); - alloc_unexec_post (); } } @@ -266,27 +258,6 @@ voidfuncptr __MALLOC_HOOK_VOLATILE __malloc_initialize_hook EXTERNALLY_VISIBLE #endif #if defined DOUG_LEA_MALLOC - -/* Allocator-related actions to do just before and after unexec. */ - -void -alloc_unexec_pre (void) -{ -# ifdef DOUG_LEA_MALLOC - malloc_state_ptr = malloc_get_state (); - if (!malloc_state_ptr) - fatal ("malloc_get_state: %s", strerror (errno)); -# endif -} - -void -alloc_unexec_post (void) -{ -# ifdef DOUG_LEA_MALLOC - free (malloc_state_ptr); -# endif -} - # ifdef GNU_LINUX /* The address where the heap starts. */ commit bb64e9464c584bace441f60678b80f41ddc6e2a3 Author: Stefan Kangas Date: Mon Dec 9 21:34:57 2024 +0100 Remove purespace fix from cl-preloaded.el * lisp/emacs-lisp/cl-preloaded.el (cl-struct-define): Remove fix for purespace. This effectively reverts Stefan Monnier's commit e785c74d3a88. diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 7432cd6e4ce..f693b277a60 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -183,20 +183,7 @@ (add-to-list 'current-load-list `(define-type . ,name)) (cl--struct-register-child parent-class tag) (unless (or (eq named t) (eq tag name)) - ;; We used to use `defconst' instead of `set' but that - ;; has a side-effect of purecopying during the dump, so that the - ;; class object stored in the tag ends up being a *copy* of the - ;; one stored in the `cl--class' property! We could have fixed - ;; this needless duplication by using the purecopied object, but - ;; that then breaks down a bit later when we modify the - ;; cl-structure-class class object to close the recursion - ;; between cl-structure-object and cl-structure-class (because - ;; modifying purecopied objects is not allowed. Since this is - ;; done during dumping, we could relax this rule and allow the - ;; modification, but it's cumbersome). - ;; So in the end, it's easier to just avoid the duplication by - ;; avoiding the use of the purespace here. - (set tag class) + (eval `(defconst ,tag ',class) t) ;; In the cl-generic support, we need to be able to check ;; if a vector is a cl-struct object, without knowing its particular type. ;; So we use the (otherwise) unused function slots of the tag symbol commit d6aeb1a2606e1dece860f2b35623245d9eb865c3 Author: Stefan Kangas Date: Mon Dec 9 21:26:25 2024 +0100 Delete remaining calls to purecopy * lisp/button.el (default-button): * lisp/calendar/holidays.el (holiday-solar-holidays) (holiday-bahai-holidays, holiday-islamic-holidays) (holiday-christian-holidays, holiday-hebrew-holidays) (holiday-oriental-holidays, holiday-general-holidays): * lisp/comint.el (comint-file-name-prefix): * lisp/composite.el (unicode-category-table): * lisp/cus-face.el (custom-declare-face): * lisp/custom.el (custom-add-load, custom-add-package-version) (custom-add-version, custom-add-link, custom-declare-group) (custom-declare-variable): * lisp/dired.el (dired-listing-switches): * lisp/epa-hook.el (epa-file-name-regexp): * lisp/faces.el (x-font-regexp, x-font-regexp-head) (x-font-regexp-slant, x-font-regexp-weight, ) (set-face-attribute, set-face-documentation, face-x-resources) (face-font-registry-alternatives, face-font-family-alternatives) (term-file-prefix): * lisp/find-file.el (ff-special-constructs): * lisp/format.el (format-alist): * lisp/help.el (help-for-help): * lisp/image-file.el (image-file-name-extensions): * lisp/info.el: * lisp/isearch.el (isearch-help-for-help-internal) (search-whitespace-regexp): * lisp/jka-cmpr-hook.el (jka-compr-load-suffixes) (jka-compr-mode-alist-additions) (jka-compr-compression-info-list, jka-compr-build-file-regexp): * lisp/language/ethiopic.el (font-ccl-encoder-alist): * lisp/language/korea-util.el (default-korean-keyboard): * lisp/language/tibetan.el (tibetan-precomposition-rule-regexp) (tibetan-precomposed-regexp): * lisp/locate.el (locate-ls-subdir-switches): * lisp/lpr.el (lpr-command): * lisp/mail/rmail.el (rmail-secondary-file-regexp) (rmail-secondary-file-directory, rmail-highlighted-headers) (rmail-ignored-headers, rmail-spool-directory, rmail-file-name): * lisp/mail/sendmail.el (mail-default-directory) (mail-signature-file, mail-citation-prefix-regexp) (mail-personal-alias-file, mail-header-separator): * lisp/menu-bar.el (yank-menu): * lisp/net/eudc.el (eudc-tools-menu): * lisp/newcomment.el (comment-padding, comment-end): * lisp/obsolete/autoload.el (autoload-generate-file-autoloads): * lisp/progmodes/hideshow.el (hs-special-modes-alist): * lisp/ps-print.el (ps-page-dimensions-database): * lisp/rfn-eshadow.el (file-name-shadow-tty-properties): * lisp/shell.el (shell-dumb-shell-regexp): * lisp/simple.el (overwrite-mode-binary, overwrite-mode-textual) (mark-inactive, shell-command-switch) (next-error-overlay-arrow-position): * lisp/subr.el (package--builtin-versions, eval-after-load): * lisp/tab-bar.el ([tab-bar]): * lisp/term/pgtk-win.el (x-gtk-stock-map): * lisp/term/x-win.el (x-gtk-stock-map): * lisp/tool-bar.el ([tool-bar]): * lisp/widget.el (define-widget): Remove calls to purecopy. diff --git a/lisp/button.el b/lisp/button.el index 1a732bee98b..9f0d2ca2cef 100644 --- a/lisp/button.el +++ b/lisp/button.el @@ -97,7 +97,7 @@ Disabling the mode will remove all buttons in the current buffer." (put 'default-button 'type 'button) ;; `action' may be either a function to call, or a marker to go to. (put 'default-button 'action #'ignore) -(put 'default-button 'help-echo (purecopy "mouse-2, RET: Push this button")) +(put 'default-button 'help-echo "mouse-2, RET: Push this button") ;; Make overlay buttons go away if their underlying text is deleted. (put 'default-button 'evaporate t) ;; Prevent insertions adjacent to text-property buttons from diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el index c7499938c6a..81c82e01a5f 100644 --- a/lisp/calendar/holidays.el +++ b/lisp/calendar/holidays.el @@ -44,7 +44,6 @@ ;;;###autoload (defcustom holiday-general-holidays - (mapcar 'purecopy '((holiday-fixed 1 1 "New Year's Day") (holiday-float 1 1 3 "Martin Luther King Day") (holiday-fixed 2 2 "Groundhog Day") @@ -61,7 +60,7 @@ (holiday-float 10 1 2 "Columbus Day") (holiday-fixed 10 31 "Halloween") (holiday-fixed 11 11 "Veteran's Day") - (holiday-float 11 4 4 "Thanksgiving"))) + (holiday-float 11 4 4 "Thanksgiving")) "General holidays. Default value is for the United States. See the documentation for `calendar-holidays' for details." :type 'sexp) @@ -70,7 +69,6 @@ See the documentation for `calendar-holidays' for details." ;;;###autoload (defcustom holiday-oriental-holidays - (mapcar 'purecopy '((holiday-chinese-new-year) (if calendar-chinese-all-holidays-flag (append @@ -81,7 +79,7 @@ See the documentation for `calendar-holidays' for details." (holiday-chinese 8 15 "Mid-Autumn Festival") (holiday-chinese 9 9 "Double Ninth Festival") (holiday-chinese-winter-solstice) - )))) + ))) "Oriental holidays. See the documentation for `calendar-holidays' for details." :version "23.1" ; added more holidays @@ -107,14 +105,13 @@ See the documentation for `calendar-holidays' for details." ;;;###autoload (defcustom holiday-hebrew-holidays - (mapcar 'purecopy '((holiday-hebrew-passover) (holiday-hebrew-rosh-hashanah) (holiday-hebrew-hanukkah) (if calendar-hebrew-all-holidays-flag (append (holiday-hebrew-tisha-b-av) - (holiday-hebrew-misc))))) + (holiday-hebrew-misc)))) "Jewish holidays. See the documentation for `calendar-holidays' for details." :type 'sexp @@ -125,7 +122,6 @@ See the documentation for `calendar-holidays' for details." ;;;###autoload (defcustom holiday-christian-holidays - (mapcar 'purecopy '((holiday-easter-etc) ; respects calendar-christian-all-holidays-flag (holiday-fixed 12 25 "Christmas") (if calendar-christian-all-holidays-flag @@ -134,7 +130,7 @@ See the documentation for `calendar-holidays' for details." (holiday-julian 12 25 "Christmas (Julian calendar)") (holiday-greek-orthodox-easter) (holiday-fixed 8 15 "Assumption") - (holiday-advent 0 "Advent"))))) + (holiday-advent 0 "Advent")))) "Christian holidays. See the documentation for `calendar-holidays' for details." :type 'sexp) @@ -143,7 +139,6 @@ See the documentation for `calendar-holidays' for details." ;;;###autoload (defcustom holiday-islamic-holidays - (mapcar 'purecopy '((holiday-islamic-new-year) (holiday-islamic 9 1 "Ramadan Begins") (if calendar-islamic-all-holidays-flag @@ -154,7 +149,7 @@ See the documentation for `calendar-holidays' for details." (holiday-islamic 8 15 "Shab-e-Bara't") (holiday-islamic 9 27 "Shab-e Qadr") (holiday-islamic 10 1 "Id-al-Fitr") - (holiday-islamic 12 10 "Id-al-Adha"))))) + (holiday-islamic 12 10 "Id-al-Adha")))) "Islamic holidays. See the documentation for `calendar-holidays' for details." :type 'sexp) @@ -163,7 +158,6 @@ See the documentation for `calendar-holidays' for details." ;;;###autoload (defcustom holiday-bahai-holidays - (mapcar 'purecopy '((holiday-bahai-new-year) (holiday-bahai-ridvan) ; respects calendar-bahai-all-holidays-flag (holiday-fixed 5 23 "Declaration of the Báb") @@ -174,7 +168,7 @@ See the documentation for `calendar-holidays' for details." (if calendar-bahai-all-holidays-flag (append (holiday-fixed 11 26 "Day of the Covenant") - (holiday-fixed 11 28 "Ascension of `Abdu’l-Bahá"))))) + (holiday-fixed 11 28 "Ascension of `Abdu’l-Bahá")))) "Bahá’í holidays. See the documentation for `calendar-holidays' for details." :type 'sexp) @@ -183,7 +177,6 @@ See the documentation for `calendar-holidays' for details." ;;;###autoload (defcustom holiday-solar-holidays - (mapcar 'purecopy '((solar-equinoxes-solstices) (holiday-sexp calendar-daylight-savings-starts (format "Daylight Saving Time Begins %s" @@ -194,7 +187,7 @@ See the documentation for `calendar-holidays' for details." (format "Daylight Saving Time Ends %s" (solar-time-string (/ calendar-daylight-savings-ends-time (float 60)) - calendar-daylight-time-zone-name))))) + calendar-daylight-time-zone-name)))) "Sun-related holidays. See the documentation for `calendar-holidays' for details." :type 'sexp) diff --git a/lisp/comint.el b/lisp/comint.el index d966625550c..c21f0d77f2c 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -3234,7 +3234,7 @@ Note that this applies to `comint-dynamic-complete-filename' only." :group 'comint-completion) ;;;###autoload -(defvar comint-file-name-prefix (purecopy "") +(defvar comint-file-name-prefix "" "Prefix prepended to absolute file names taken from process input. This is used by Comint's and shell's completion functions, and by shell's directory tracking functions.") diff --git a/lisp/composite.el b/lisp/composite.el index 326e8f10aee..73ec8b1813c 100644 --- a/lisp/composite.el +++ b/lisp/composite.el @@ -755,7 +755,7 @@ All non-spacing characters have this function in ;; Allow for bootstrapping without uni-*.el. (when unicode-category-table - (let ((elt `([,(purecopy "\\c.\\c^+") 1 compose-gstring-for-graphic] + (let ((elt `(["\\c.\\c^+" 1 compose-gstring-for-graphic] [nil 0 compose-gstring-for-graphic]))) (map-char-table #'(lambda (key val) @@ -764,7 +764,7 @@ All non-spacing characters have this function in unicode-category-table)) ;; for dotted-circle (aset composition-function-table #x25CC - `([,(purecopy ".\\c^") 0 compose-gstring-for-dotted-circle])) + `([".\\c^" 0 compose-gstring-for-dotted-circle])) ;; For prettier display of fractions (set-char-table-range composition-function-table @@ -772,10 +772,10 @@ All non-spacing characters have this function in ;; We use font-shape-gstring so that if the font doesn't support ;; fractional display, the characters are shown separately, not as ;; a composed cluster. - (list (vector (purecopy "[1-9][0-9][0-9]\u2044[0-9]+") + (list (vector "[1-9][0-9][0-9]\u2044[0-9]+" 3 'font-shape-gstring) - (vector (purecopy "[1-9][0-9]\u2044[0-9]+") 2 'font-shape-gstring) - (vector (purecopy "[1-9]\u2044[0-9]+") 1 'font-shape-gstring)))) + (vector "[1-9][0-9]\u2044[0-9]+" 2 'font-shape-gstring) + (vector "[1-9]\u2044[0-9]+" 1 'font-shape-gstring)))) (defun compose-gstring-for-terminal (gstring _direction) "Compose glyph-string GSTRING for terminal display. diff --git a/lisp/cus-face.el b/lisp/cus-face.el index 478092c30cb..e700b0d0b90 100644 --- a/lisp/cus-face.el +++ b/lisp/cus-face.el @@ -35,10 +35,10 @@ (not (documentation-stringp doc))) (error "Invalid (or missing) doc string %S" doc)) (unless (get face 'face-defface-spec) - (face-spec-set face (purecopy spec) 'face-defface-spec) + (face-spec-set face spec 'face-defface-spec) (push (cons 'defface face) current-load-list) (when doc - (set-face-documentation face (purecopy doc))) + (set-face-documentation face doc)) (custom-handle-all-keywords face args 'custom-face) (run-hooks 'custom-define-hook)) face) diff --git a/lisp/custom.el b/lisp/custom.el index 63d2eea4d94..bb3c0740cc0 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -166,7 +166,7 @@ not the default value itself. DEFAULT is stored as SYMBOL's standard value, in SYMBOL's property `standard-value'. At the same time, SYMBOL's property `force-value' is set to nil, as the value is no longer rogue." - (put symbol 'standard-value (purecopy (list default))) + (put symbol 'standard-value (list default)) ;; Maybe this option was rogue in an earlier version. It no longer is. (when (get symbol 'force-value) (put symbol 'force-value nil)) @@ -207,7 +207,7 @@ set to nil, as the value is no longer rogue." (when (memq value '(permanent permanent-only)) (put symbol 'permanent-local t))) ((eq keyword :type) - (put symbol 'custom-type (purecopy value))) + (put symbol 'custom-type value)) ((eq keyword :options) (if (get symbol 'custom-options) ;; Slow safe code to avoid duplicates. @@ -488,7 +488,7 @@ information." (setq members (cdr members))) (when doc ;; This text doesn't get into DOC. - (put symbol 'group-documentation (purecopy doc))) + (put symbol 'group-documentation doc)) (while args (let ((arg (car args))) (setq args (cdr args)) @@ -500,7 +500,7 @@ information." (error "Keyword %s is missing an argument" keyword)) (setq args (cdr args)) (cond ((eq keyword :prefix) - (put symbol 'custom-prefix (purecopy value))) + (put symbol 'custom-prefix value)) (t (custom-handle-keyword symbol keyword value 'custom-group)))))) @@ -587,8 +587,6 @@ Third argument TYPE is the custom option type." (defun custom-handle-keyword (symbol keyword value type) "For customization option SYMBOL, handle KEYWORD with VALUE. Fourth argument TYPE is the custom option type." - (if purify-flag - (setq value (purecopy value))) (cond ((eq keyword :group) (custom-add-to-group value symbol type)) ((eq keyword :version) @@ -641,22 +639,22 @@ For other custom types, this has no effect." "To the custom option SYMBOL add the link WIDGET." (let ((links (get symbol 'custom-links))) (unless (member widget links) - (put symbol 'custom-links (cons (purecopy widget) links))))) + (put symbol 'custom-links (cons widget links))))) (defun custom-add-version (symbol version) "To the custom option SYMBOL add the version VERSION." - (put symbol 'custom-version (purecopy version))) + (put symbol 'custom-version version)) (defun custom-add-package-version (symbol version) "To the custom option SYMBOL add the package version VERSION." - (put symbol 'custom-package-version (purecopy version))) + (put symbol 'custom-package-version version)) (defun custom-add-load (symbol load) "To the custom option SYMBOL add the dependency LOAD. LOAD should be either a library file name, or a feature name." (let ((loads (get symbol 'custom-loads))) (unless (member load loads) - (put symbol 'custom-loads (cons (purecopy load) loads))))) + (put symbol 'custom-loads (cons load loads))))) (defun custom-autoload (symbol load &optional noset) "Mark SYMBOL as autoloaded custom variable and add dependency LOAD. diff --git a/lisp/dired.el b/lisp/dired.el index 9895229694a..6dd88c330ee 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -60,7 +60,7 @@ :group 'dired) ;;;###autoload -(defcustom dired-listing-switches (purecopy "-al") +(defcustom dired-listing-switches "-al" "Switches passed to `ls' for Dired. MUST contain the `l' option. May contain all other options that don't contradict `-l'; may contain even `F', `b', `i' and `s'. See also the variable diff --git a/lisp/epa-hook.el b/lisp/epa-hook.el index 458db3e0323..ab65dab132e 100644 --- a/lisp/epa-hook.el +++ b/lisp/epa-hook.el @@ -35,7 +35,7 @@ (if (fboundp 'epa-file-name-regexp-update) (epa-file-name-regexp-update))) -(defcustom epa-file-name-regexp (purecopy "\\.gpg\\(~\\|\\.~[0-9]+~\\)?\\'") +(defcustom epa-file-name-regexp "\\.gpg\\(~\\|\\.~[0-9]+~\\)?\\'" "Regexp which matches filenames to be encrypted with GnuPG. If you set this outside Custom while epa-file is already enabled, diff --git a/lisp/faces.el b/lisp/faces.el index f8ec0f1a187..5abccde45c9 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -25,7 +25,7 @@ ;;; Code: -(defcustom term-file-prefix (purecopy "term/") +(defcustom term-file-prefix "term/" "If non-nil, Emacs startup performs terminal-specific initialization. It does this by: (load (concat term-file-prefix (getenv \"TERM\"))) @@ -99,7 +99,6 @@ a font height that isn't optimal." ;; unavailable, and we fall back on the courier and helv families, ;; which are generally available. (defcustom face-font-family-alternatives - (mapcar (lambda (arg) (mapcar 'purecopy arg)) '(("Monospace" "Cascadia Code" "Lucida Console" "courier" "fixed") ;; Monospace Serif is an Emacs invention, intended to work around @@ -137,7 +136,7 @@ a font height that isn't optimal." ;; https://en.wikipedia.org/wiki/List_of_typefaces_included_with_Microsoft_Windows "Calibri" "Tahoma" "Lucida Sans Unicode" "helv" "helvetica" "arial" "fixed") - ("helv" "helvetica" "arial" "fixed"))) + ("helv" "helvetica" "arial" "fixed")) "Alist of alternative font family names. Each element has the form (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...). If fonts of family FAMILY can't be loaded, try ALTERNATIVE1, then @@ -152,7 +151,6 @@ ALTERNATIVE2 etc." ;; This is defined originally in xfaces.c. (defcustom face-font-registry-alternatives - (mapcar (lambda (arg) (mapcar 'purecopy arg)) (if (featurep 'w32) '(("iso8859-1" "ms-oemlatin") ("gb2312.1980" "gb2312" "gbk" "gb18030") @@ -162,7 +160,7 @@ ALTERNATIVE2 etc." '(("gb2312.1980" "gb2312.80&gb8565.88" "gbk" "gb18030") ("jisx0208.1990" "jisx0208.1983" "jisx0208.1978") ("ksc5601.1989" "ksx1001.1992" "ksc5601.1987") - ("muletibetan-2" "muletibetan-0")))) + ("muletibetan-2" "muletibetan-0"))) "Alist of alternative font registry names. Each element has the form (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...). If fonts of registry REGISTRY can be loaded, font selection @@ -354,11 +352,6 @@ is either `foreground-color', `background-color', or a keyword." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defcustom face-x-resources - (mapcar - (lambda (arg) - ;; FIXME; can we purecopy some of the conses too? - (cons (car arg) - (cons (purecopy (car (cdr arg))) (purecopy (cdr (cdr arg)))))) '((:family (".attributeFamily" . "Face.AttributeFamily")) (:foundry (".attributeFoundry" . "Face.AttributeFoundry")) (:width (".attributeWidth" . "Face.AttributeWidth")) @@ -381,7 +374,7 @@ is either `foreground-color', `background-color', or a keyword." (:bold (".attributeBold" . "Face.AttributeBold")) (:italic (".attributeItalic" . "Face.AttributeItalic")) (:font (".attributeFont" . "Face.AttributeFont")) - (:inherit (".attributeInherit" . "Face.AttributeInherit")))) + (:inherit (".attributeInherit" . "Face.AttributeInherit"))) "List of X resources and classes for face attributes. Each element has the form (ATTRIBUTE ENTRY1 ENTRY2...) where ATTRIBUTE is the name of a face attribute, and each ENTRY is a cons of the form @@ -664,7 +657,7 @@ If FACE is a face-alias, get the documentation for the target face." (defun set-face-documentation (face string) "Set the documentation string for FACE to STRING." ;; Perhaps the text should go in DOC. - (put face 'face-documentation (purecopy string))) + (put face 'face-documentation string)) (define-obsolete-function-alias 'face-doc-string #'face-documentation "29.1") @@ -863,7 +856,6 @@ setting `:weight' to `bold', and a value of t for `:italic' is equivalent to setting `:slant' to `italic'. But if `:weight' is specified in the face spec, `:bold' is ignored, and if `:slant' is specified, `:italic' is ignored." - (setq args (purecopy args)) (let ((where (if (null frame) 0 frame)) (spec args) family foundry orig-family orig-foundry) @@ -893,15 +885,13 @@ is specified, `:italic' is ignored." (setq family orig-family) (setq foundry orig-foundry))) (when (or (stringp family) (eq family 'unspecified)) - (internal-set-lisp-face-attribute face :family (purecopy family) - where)) + (internal-set-lisp-face-attribute face :family family where)) (when (or (stringp foundry) (eq foundry 'unspecified)) - (internal-set-lisp-face-attribute face :foundry (purecopy foundry) - where))) + (internal-set-lisp-face-attribute face :foundry foundry where))) (while args (unless (memq (car args) '(:family :foundry)) (internal-set-lisp-face-attribute face (car args) - (purecopy (cadr args)) + (cadr args) where)) (setq args (cddr args))))) @@ -3192,16 +3182,15 @@ This face is used by `show-paren-mode'." (encoding "[^-]+") ) (setq x-font-regexp - (purecopy (concat "\\`\\*?[-?*]" + (concat "\\`\\*?[-?*]" foundry - family - weight\? - slant\? - swidth - adstyle - pixelsize - pointsize - resx - resy - spacing - avgwidth - - registry - encoding "\\*?\\'" - ))) + registry - encoding "\\*?\\'")) (setq x-font-regexp-head - (purecopy (concat "\\`[-?*]" foundry - family - weight\? - slant\? - "\\([-*?]\\|\\'\\)"))) - (setq x-font-regexp-slant (purecopy (concat - slant -))) - (setq x-font-regexp-weight (purecopy (concat - weight -))) + (concat "\\`[-?*]" foundry - family - weight\? - slant\? + "\\([-*?]\\|\\'\\)")) + (setq x-font-regexp-slant (concat - slant -)) + (setq x-font-regexp-weight (concat - weight -)) nil) diff --git a/lisp/find-file.el b/lisp/find-file.el index 65e980d38fc..ad1a450c25e 100644 --- a/lisp/find-file.el +++ b/lisp/find-file.el @@ -182,7 +182,7 @@ To override this, give an argument to `ff-find-other-file'." ;;;###autoload (defcustom ff-special-constructs ;; C/C++ include, for NeXTstep too - `((,(purecopy "^#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]") . + `(("^#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]" . ,(lambda () (match-string 2)))) ;; We include `ff-treat-as-special' documentation here so that autoload ;; can make it available to be read prior to loading this file. diff --git a/lisp/format.el b/lisp/format.el index fc44436874b..350d6725c69 100644 --- a/lisp/format.el +++ b/lisp/format.el @@ -65,27 +65,26 @@ (put 'buffer-auto-save-file-format 'permanent-local t) (defvar format-alist - ;; FIXME: maybe each item can be purecopied instead of just the strings. - `((text/enriched ,(purecopy "Extended MIME text/enriched format.") - ,(purecopy "Content-[Tt]ype:[ \t]*text/enriched") + `((text/enriched "Extended MIME text/enriched format." + "Content-[Tt]ype:[ \t]*text/enriched" enriched-decode enriched-encode t enriched-mode) - (plain ,(purecopy "ISO 8859-1 standard format, no text properties.") + (plain "ISO 8859-1 standard format, no text properties." ;; Plain only exists so that there is an obvious neutral choice in ;; the completion list. nil nil nil nil nil) - (TeX ,(purecopy "TeX (encoding)") + (TeX "TeX (encoding)" nil iso-tex2iso iso-iso2tex t nil) - (gtex ,(purecopy "German TeX (encoding)") + (gtex "German TeX (encoding)" nil iso-gtex2iso iso-iso2gtex t nil) - (html ,(purecopy "HTML/SGML \"ISO 8879:1986//ENTITIES Added Latin 1//EN\" (encoding)") + (html "HTML/SGML \"ISO 8879:1986//ENTITIES Added Latin 1//EN\" (encoding)" nil iso-sgml2iso iso-iso2sgml t nil) - (rot13 ,(purecopy "rot13") + (rot13 "rot13" nil rot13-region rot13-region t nil) - (duden ,(purecopy "Duden Ersatzdarstellung") + (duden "Duden Ersatzdarstellung" nil ;; FROM-FN used to call the "diac" command which is not widely ;; available and apparently not under a free software license: @@ -93,14 +92,14 @@ ;; Reliable round-trip conversion is not possible anyway and ;; would be by heuristic method, so make it write-only for now. iso-cvt-write-only iso-iso2duden t nil) - (de646 ,(purecopy "German ASCII (ISO 646)") + (de646 "German ASCII (ISO 646)" nil - ,(purecopy "iconv -f iso646-de -t utf-8") - ,(purecopy "iconv -f utf-8 -t iso646-de") t nil) - (denet ,(purecopy "net German") + "iconv -f iso646-de -t utf-8" + "iconv -f utf-8 -t iso646-de" t nil) + (denet "net German" nil iso-german iso-cvt-read-only t nil) - (esnet ,(purecopy "net Spanish") + (esnet "net Spanish" nil iso-spanish iso-cvt-read-only t nil)) "List of information about understood file formats. diff --git a/lisp/help.el b/lisp/help.el index ef0b7ffc01d..9ec3466d823 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -395,7 +395,7 @@ Do not call this in the scope of `with-help-window'." (defalias 'help #'help-for-help) (make-help-screen help-for-help - (purecopy "Type a help option: [abcCdefFgiIkKlLmnprstvw.] C-[cdefmnoptw] or ?") + "Type a help option: [abcCdefFgiIkKlLmnprstvw.] C-[cdefmnoptw] or ?" (concat "(Type " (help--key-description-fontified (kbd "")) diff --git a/lisp/image-file.el b/lisp/image-file.el index 57e9799dc34..efc4ec97528 100644 --- a/lisp/image-file.el +++ b/lisp/image-file.el @@ -37,7 +37,7 @@ ;;;###autoload (defcustom image-file-name-extensions - (purecopy '("png" "jpeg" "jpg" "gif" "tiff" "tif" "xbm" "xpm" "pbm" "pgm" "ppm" "pnm" "svg" "webp")) + '("png" "jpeg" "jpg" "gif" "tiff" "tif" "xbm" "xpm" "pbm" "pgm" "ppm" "pnm" "svg" "webp") "A list of image-file filename extensions. Filenames having one of these extensions are considered image files, in addition to those matching `image-file-name-regexps'. diff --git a/lisp/info.el b/lisp/info.el index 9025fd13363..0a471795326 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -830,7 +830,7 @@ Select the window used, if it has been made." (select-window window)))) -;;;###autoload (put 'info 'info-file (purecopy "emacs")) +;;;###autoload (put 'info 'info-file "emacs") ;;;###autoload (defun info (&optional file-or-node buffer) "Enter Info, the documentation browser. @@ -4757,7 +4757,7 @@ in the first element of the returned list (which is treated specially in (cdr where)) where))) -;;;###autoload (put 'Info-goto-emacs-command-node 'info-file (purecopy "emacs")) +;;;###autoload (put 'Info-goto-emacs-command-node 'info-file "emacs") ;;;###autoload (defun Info-goto-emacs-command-node (command) "Go to the Info node in the Emacs manual for command COMMAND. @@ -4799,7 +4799,7 @@ COMMAND must be a symbol or string." (if (> num-matches 2) "them" "it"))))) (error "Couldn't find documentation for %s" command)))) -;;;###autoload (put 'Info-goto-emacs-key-command-node 'info-file (purecopy "emacs")) +;;;###autoload (put 'Info-goto-emacs-key-command-node 'info-file "emacs") ;;;###autoload (defun Info-goto-emacs-key-command-node (key) "Go to the node in the Emacs manual which describes the command bound to KEY. diff --git a/lisp/isearch.el b/lisp/isearch.el index 315fd36cfea..1343c71f610 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -115,7 +115,7 @@ is called to let you enter the search string, and RET terminates editing and does a nonincremental search.)" :type 'boolean) -(defcustom search-whitespace-regexp (purecopy "[ \t]+") +(defcustom search-whitespace-regexp "[ \t]+" "If non-nil, regular expression to match a sequence of whitespace chars. When you enter a space or spaces in the incremental search, it will match any sequence matched by this regexp. As an exception, @@ -497,7 +497,7 @@ this variable is nil.") (eval-when-compile (require 'help-macro)) (make-help-screen isearch-help-for-help-internal - (purecopy "Type a help option: [bkm] or ?") + "Type a help option: [bkm] or ?" "You have typed %THIS-KEY%, the help character. Type a Help option: \(Type \\\\[help-quit] to exit the Help command.) diff --git a/lisp/jka-cmpr-hook.el b/lisp/jka-cmpr-hook.el index 7e502f02b3c..048ec2e091e 100644 --- a/lisp/jka-cmpr-hook.el +++ b/lisp/jka-cmpr-hook.el @@ -78,19 +78,18 @@ Otherwise, it is nil.") (defun jka-compr-build-file-regexp () - (purecopy - (let ((re-anchored '()) - (re-free '())) - (dolist (e jka-compr-compression-info-list) - (let ((re (jka-compr-info-regexp e))) - (if (string-match "\\\\'\\'" re) - (push (substring re 0 (match-beginning 0)) re-anchored) - (push re re-free)))) - (concat - (if re-free (concat (mapconcat 'identity re-free "\\|") "\\|")) - "\\(?:" - (mapconcat 'identity re-anchored "\\|") - "\\)" file-name-version-regexp "?\\'")))) + (let ((re-anchored '()) + (re-free '())) + (dolist (e jka-compr-compression-info-list) + (let ((re (jka-compr-info-regexp e))) + (if (string-match "\\\\'\\'" re) + (push (substring re 0 (match-beginning 0)) re-anchored) + (push re re-free)))) + (concat + (if re-free (concat (mapconcat 'identity re-free "\\|") "\\|")) + "\\(?:" + (mapconcat 'identity re-anchored "\\|") + "\\)" file-name-version-regexp "?\\'"))) ;; Functions for accessing the return value of jka-compr-get-compression-info ;; FIXME: Use cl-defstruct! @@ -202,7 +201,6 @@ options through Custom does this automatically." ;; uncomp-message uncomp-prog uncomp-args ;; can-append strip-extension-flag file-magic-bytes ;; uncompress-function] - (mapcar 'purecopy `(["\\.Z\\'" "compressing" "compress" ("-c") ;; gzip is more common than uncompress. It can only read, not write. @@ -261,7 +259,7 @@ options through Custom does this automatically." ["\\.tzst\\'" "zstd compressing" "zstd" ("-c" "-q") "zstd uncompressing" "zstd" ("-c" "-q" "-d") - t nil "\050\265\057\375"])) + t nil "\050\265\057\375"]) "List of vectors that describe available compression techniques. Each element, which describes a compression technique, is a vector of @@ -329,10 +327,10 @@ variables. Setting this through Custom does that automatically." :group 'jka-compr) (defcustom jka-compr-mode-alist-additions - (purecopy '(("\\.tgz\\'" . tar-mode) - ("\\.tbz2?\\'" . tar-mode) - ("\\.txz\\'" . tar-mode) - ("\\.tzst\\'" . tar-mode))) + '(("\\.tgz\\'" . tar-mode) + ("\\.tbz2?\\'" . tar-mode) + ("\\.txz\\'" . tar-mode) + ("\\.tzst\\'" . tar-mode)) "List of pairs added to `auto-mode-alist' when installing jka-compr. Uninstalling jka-compr removes all pairs from `auto-mode-alist' that installing added. @@ -346,7 +344,7 @@ variables. Setting this through Custom does that automatically." :set 'jka-compr-set :group 'jka-compr) -(defcustom jka-compr-load-suffixes (purecopy '(".gz")) +(defcustom jka-compr-load-suffixes '(".gz") "List of compression related suffixes to try when loading files. Enabling Auto Compression mode appends this list to `load-file-rep-suffixes', which see. Disabling Auto Compression mode removes all suffixes diff --git a/lisp/language/ethiopic.el b/lisp/language/ethiopic.el index 7490f5351c8..0617e505008 100644 --- a/lisp/language/ethiopic.el +++ b/lisp/language/ethiopic.el @@ -56,7 +56,7 @@ "CCL program to encode an Ethiopic code to code point of Ethiopic font.") (setq font-ccl-encoder-alist - (cons (cons (purecopy "ethiopic") ccl-encode-ethio-font) font-ccl-encoder-alist)) + (cons (cons "ethiopic" ccl-encode-ethio-font) font-ccl-encoder-alist)) (set-language-info-alist "Ethiopic" '((setup-function . setup-ethiopic-environment-internal) diff --git a/lisp/language/korea-util.el b/lisp/language/korea-util.el index 665745c1eb0..66a4b6ce550 100644 --- a/lisp/language/korea-util.el +++ b/lisp/language/korea-util.el @@ -29,10 +29,10 @@ ;;;###autoload (defvar default-korean-keyboard - (purecopy (if (string-search "3" (or (getenv "HANGUL_KEYBOARD_TYPE") "")) + (if (string-search "3" (or (getenv "HANGUL_KEYBOARD_TYPE") "")) "3" - "")) - "The kind of Korean keyboard for Korean (Hangul) input method. + "") + "The kind of Korean keyboard for Korean (Hangul) input method. \"\" for 2, \"3\" for 3, and \"3f\" for 3f.") ;; functions useful for Korean text input diff --git a/lisp/language/tibetan.el b/lisp/language/tibetan.el index 28f8c229d3d..98478105041 100644 --- a/lisp/language/tibetan.el +++ b/lisp/language/tibetan.el @@ -574,19 +574,17 @@ The result of matching is to be used for indexing alists at conversion from a roman transcription to the corresponding Tibetan character.") (defvar tibetan-precomposed-regexp - (purecopy - (eval-when-compile - (concat "^" - (regexp-opt (mapcar #'car tibetan-precomposed-transcription-alist) - t)))) + (eval-when-compile + (concat "^" + (regexp-opt (mapcar #'car tibetan-precomposed-transcription-alist) + t))) "Regexp string to match a romanized Tibetan complex consonant. The result of matching is to be used for indexing alists when the input key from an input method is converted to the corresponding precomposed glyph.") (defvar tibetan-precomposition-rule-regexp - (purecopy - (eval-when-compile - (regexp-opt (mapcar #'car tibetan-precomposition-rule-alist) t))) + (eval-when-compile + (regexp-opt (mapcar #'car tibetan-precomposition-rule-alist) t)) "Regexp string to match a sequence of Tibetan consonantic components. That is, one base consonant and one or more subjoined consonants. The result of matching is to be used for indexing alist when the component diff --git a/lisp/locate.el b/lisp/locate.el index c6a1e9b6e46..ce601bc2a50 100644 --- a/lisp/locate.el +++ b/lisp/locate.el @@ -182,7 +182,7 @@ or `locate-make-command-line', determines the database." :type '(choice (const :tag "None" nil) face)) ;;;###autoload -(defcustom locate-ls-subdir-switches (purecopy "-al") +(defcustom locate-ls-subdir-switches "-al" "`ls' switches for inserting subdirectories in `*Locate*' buffers. This should contain the \"-l\" switch, but not the \"-F\" or \"-b\" switches." :type 'string diff --git a/lisp/lpr.el b/lisp/lpr.el index c860c633b73..10864c29a73 100644 --- a/lisp/lpr.el +++ b/lisp/lpr.el @@ -94,14 +94,13 @@ This switch is used in conjunction with `printer-name'." ;;;###autoload (defcustom lpr-command - (purecopy (cond (lpr-windows-system "") (lpr-lp-system "lp") (t - "lpr"))) + "lpr")) "Name of program for printing a file. On MS-DOS and MS-Windows systems, if the value is an empty string then diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index e38ab12fae6..0e7597b89bd 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -152,7 +152,7 @@ its character representation and its display representation.") :group 'rmail) ;;;###autoload -(defcustom rmail-file-name (purecopy "~/RMAIL") +(defcustom rmail-file-name "~/RMAIL" "Name of user's primary mail file." :type 'string :group 'rmail @@ -160,7 +160,6 @@ its character representation and its display representation.") ;;;###autoload (defcustom rmail-spool-directory - (purecopy (cond ((file-exists-p "/var/mail") ;; SVR4 and recent BSD are said to use this. ;; Rather than trying to know precisely which systems use it, @@ -169,7 +168,7 @@ its character representation and its display representation.") ;; Many GNU/Linux systems use this name. ((file-exists-p "/var/spool/mail") "/var/spool/mail/") ((memq system-type '(hpux usg-unix-v)) "/usr/mail/") - (t "/usr/spool/mail/"))) + (t "/usr/spool/mail/")) "Name of directory used by system mailer for delivering new mail. Its name should end with a slash." :initialize #'custom-initialize-delay @@ -316,7 +315,6 @@ Setting this variable has an effect only before reading a mail." ;;;###autoload (defcustom rmail-ignored-headers - (purecopy (concat "^via:\\|^mail-from:\\|^origin:\\|^references:\\|^sender:" "\\|^status:\\|^received:\\|^x400-originator:\\|^x400-recipients:" "\\|^x400-received:\\|^x400-mts-identifier:\\|^x400-content-type:" @@ -336,7 +334,7 @@ Setting this variable has an effect only before reading a mail." "\\|^Received-SPF:" "\\|^Authentication-Results:" "\\|^resent-face:\\|^resent-x.*:\\|^resent-organization:\\|^resent-openpgp:" - "\\|^x-.*:")) + "\\|^x-.*:") "Regexp to match header fields that Rmail should normally hide. \(See also `rmail-nonignored-headers', which overrides this regexp.) This variable is used for reformatting the message header, @@ -385,7 +383,7 @@ If nil, display all header fields except those matched by :version "29.1") ;;;###autoload -(defcustom rmail-highlighted-headers (purecopy "^From:\\|^Subject:") +(defcustom rmail-highlighted-headers "^From:\\|^Subject:" "Regexp to match Header fields that Rmail should normally highlight. A value of nil means don't highlight. Uses the face `rmail-highlight'." :type '(choice regexp (const :tag "None" nil)) @@ -436,12 +434,12 @@ the frame where you have the RMAIL buffer displayed." :group 'rmail-reply) ;;;###autoload -(defcustom rmail-secondary-file-directory (purecopy "~/") +(defcustom rmail-secondary-file-directory "~/" "Directory for additional secondary Rmail files." :type 'directory :group 'rmail-files) ;;;###autoload -(defcustom rmail-secondary-file-regexp (purecopy "\\.xmail\\'") +(defcustom rmail-secondary-file-regexp "\\.xmail\\'" "Regexp for which files are secondary Rmail files." :type 'regexp :group 'rmail-files) diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index a720df51d14..875d0f80d3a 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -160,7 +160,7 @@ This is used by the default mail-sending commands. See also :version "24.1") ;;;###autoload -(defcustom mail-header-separator (purecopy "--text follows this line--") +(defcustom mail-header-separator "--text follows this line--" "Line used to separate headers from text in messages being composed." :type 'string) @@ -201,7 +201,7 @@ The default file is defined in sendmail's configuration file, e.g. :type '(choice (const :tag "Sendmail default" nil) file)) ;;;###autoload -(defcustom mail-personal-alias-file (purecopy "~/.mailrc") +(defcustom mail-personal-alias-file "~/.mailrc" "If non-nil, the name of the user's personal mail alias file. This file typically should be in same format as the `.mailrc' file used by the `Mail' or `mailx' program. @@ -258,7 +258,7 @@ regardless of what part of it (if any) is included in the cited text.") ;;;###autoload (defcustom mail-citation-prefix-regexp - (purecopy "\\([ \t]*\\(\\w\\|[_.]\\)+>+\\|[ \t]*[>|]\\)+") + "\\([ \t]*\\(\\w\\|[_.]\\)+>+\\|[ \t]*[>|]\\)+" "Regular expression to match a citation prefix plus whitespace. It should match whatever sort of citation prefixes you want to handle, with whitespace before and after; it should also match just whitespace. @@ -377,12 +377,12 @@ and should insert whatever you want to insert." :risky t) ;;;###autoload -(defcustom mail-signature-file (purecopy "~/.signature") +(defcustom mail-signature-file "~/.signature" "File containing the text inserted at end of mail buffer." :type 'file) ;;;###autoload -(defcustom mail-default-directory (purecopy "~/") +(defcustom mail-default-directory "~/" "Value of `default-directory' for Mail mode buffers. This directory is used for auto-save files of Mail mode buffers. diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index b625a317c56..0454ed292fe 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -488,7 +488,7 @@ in the tool bar will close the current window where possible." (or (not (boundp 'xref-backend-functions)) (eq (car xref-backend-functions) 'etags--xref-backend))) -(defvar yank-menu (cons (purecopy "Select Yank") nil)) +(defvar yank-menu '("Select Yank" nil)) (fset 'yank-menu (cons 'keymap yank-menu)) (defvar menu-bar-edit-menu @@ -2211,7 +2211,7 @@ key, a click, or a menu-item")) (define-key global-map [menu-bar file] (cons "File" menu-bar-file-menu)) (define-key global-map [menu-bar help-menu] - (cons (purecopy "Help") menu-bar-help-menu)) + (cons "Help" menu-bar-help-menu)) (define-key global-map [menu-bar mouse-1] 'menu-bar-open-mouse) diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el index 9e640768285..c6e93d470de 100644 --- a/lisp/net/eudc.el +++ b/lisp/net/eudc.el @@ -1319,25 +1319,25 @@ This does nothing except loading eudc by autoload side-effect." (defvar eudc-tools-menu (let ((map (make-sparse-keymap "Directory Servers"))) (define-key map [phone] - `(menu-item ,(purecopy "Get Phone") eudc-get-phone - :help ,(purecopy "Get the phone field of name from the directory server"))) + '(menu-item "Get Phone" eudc-get-phone + :help "Get the phone field of name from the directory server")) (define-key map [email] - `(menu-item ,(purecopy "Get Email") eudc-get-email - :help ,(purecopy "Get the email field of NAME from the directory server"))) + '(menu-item "Get Email" eudc-get-email + :help "Get the email field of NAME from the directory server")) (define-key map [separator-eudc-email] menu-bar-separator) (define-key map [expand-inline] - `(menu-item ,(purecopy "Expand Inline Query") eudc-expand-inline - :help ,(purecopy "Query the directory server, and expand the query string before point"))) + '(menu-item "Expand Inline Query" eudc-expand-inline + :help "Query the directory server, and expand the query string before point")) (define-key map [query] - `(menu-item ,(purecopy "Query with Form") eudc-query-form - :help ,(purecopy "Display a form to query the directory server"))) + '(menu-item "Query with Form" eudc-query-form + :help "Display a form to query the directory server")) (define-key map [separator-eudc-query] menu-bar-separator) (define-key map [new] - `(menu-item ,(purecopy "New Server") eudc-set-server - :help ,(purecopy "Set the directory server to SERVER using PROTOCOL"))) + '(menu-item "New Server" eudc-set-server + :help "Set the directory server to SERVER using PROTOCOL")) (define-key map [load] - `(menu-item ,(purecopy "Load Hotlist of Servers") eudc-load-eudc - :help ,(purecopy "Load the Emacs Unified Directory Client"))) + '(menu-item "Load Hotlist of Servers" eudc-load-eudc + :help "Load the Emacs Unified Directory Client")) map)) (fset 'eudc-tools-menu (symbol-value 'eudc-tools-menu))) diff --git a/lisp/newcomment.el b/lisp/newcomment.el index 04b5746eeae..f63d0abd663 100644 --- a/lisp/newcomment.el +++ b/lisp/newcomment.el @@ -136,7 +136,7 @@ by the close of the first pair.") (put 'comment-end-skip 'safe-local-variable 'stringp) ;;;###autoload -(defvar comment-end (purecopy "") +(defvar comment-end "" "String to insert to end a new comment. Should be an empty string if comments are terminated by end-of-line.") ;;;###autoload @@ -288,7 +288,7 @@ See `comment-styles' for a list of available styles." :group 'comment) ;;;###autoload -(defcustom comment-padding (purecopy " ") +(defcustom comment-padding " " "Padding string that `comment-region' puts between comment chars and text. Can also be an integer which will be automatically turned into a string of the corresponding number of spaces. diff --git a/lisp/obsolete/autoload.el b/lisp/obsolete/autoload.el index 850ec83e645..ad3854c12ed 100644 --- a/lisp/obsolete/autoload.el +++ b/lisp/obsolete/autoload.el @@ -415,8 +415,7 @@ FILE's modification time." load-name outfile)) (let ((standard-output (marker-buffer output-start)) (print-quoted t)) - (princ `(push (purecopy - ',(cons (intern package) version)) + (princ `(push ',(cons (intern package) version) package--builtin-versions)) (princ "\n"))))) diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index 07616960565..92d07229584 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -257,7 +257,6 @@ This has effect only if `search-invisible' is set to `open'." ;; FIXME: Currently the check is made via ;; (assoc major-mode hs-special-modes-alist) so it doesn't pay attention ;; to the mode hierarchy. - (mapcar #'purecopy '((c-mode "{" "}" "/[*/]" nil nil) (c-ts-mode "{" "}" "/[*/]" nil nil) (c++-mode "{" "}" "/[*/]" nil nil) @@ -270,7 +269,7 @@ This has effect only if `search-invisible' is set to `open'." (lua-ts-mode "{\\|\\[\\[" "}\\|\\]\\]" "--" nil) (mhtml-mode "{\\|<[^/>]*?" "}\\|]*[^/]>" " Show/Hide). -(bindings--define-key mode-line-mode-menu [overwrite-mode] +(define-key mode-line-mode-menu [overwrite-mode] '(menu-item "Overwrite (Ovwrt)" overwrite-mode :help "Overwrite mode: typed characters replace existing text" :button (:toggle . overwrite-mode))) -(bindings--define-key mode-line-mode-menu [outline-minor-mode] +(define-key mode-line-mode-menu [outline-minor-mode] '(menu-item "Outline (Outl)" outline-minor-mode ;; XXX: This needs a good, brief description. :help "" :button (:toggle . (bound-and-true-p outline-minor-mode)))) -(bindings--define-key mode-line-mode-menu [highlight-changes-mode] +(define-key mode-line-mode-menu [highlight-changes-mode] '(menu-item "Highlight changes (Chg)" highlight-changes-mode :help "Show changes in the buffer in a distinctive color" :button (:toggle . (bound-and-true-p highlight-changes-mode)))) -(bindings--define-key mode-line-mode-menu [hide-ifdef-mode] +(define-key mode-line-mode-menu [hide-ifdef-mode] '(menu-item "Hide ifdef (Ifdef)" hide-ifdef-mode :help "Show/Hide code within #ifdef constructs" :button (:toggle . (bound-and-true-p hide-ifdef-mode)))) -(bindings--define-key mode-line-mode-menu [glasses-mode] +(define-key mode-line-mode-menu [glasses-mode] '(menu-item "Glasses (o^o)" glasses-mode :help "Insert virtual separators to make long identifiers easy to read" :button (:toggle . (bound-and-true-p glasses-mode)))) -(bindings--define-key mode-line-mode-menu [font-lock-mode] +(define-key mode-line-mode-menu [font-lock-mode] '(menu-item "Font Lock" font-lock-mode :help "Syntax coloring" :button (:toggle . font-lock-mode))) -(bindings--define-key mode-line-mode-menu [flyspell-mode] +(define-key mode-line-mode-menu [flyspell-mode] '(menu-item "Flyspell (Fly)" flyspell-mode :help "Spell checking on the fly" :button (:toggle . (bound-and-true-p flyspell-mode)))) -(bindings--define-key mode-line-mode-menu [completion-preview-mode] +(define-key mode-line-mode-menu [completion-preview-mode] '(menu-item "Completion Preview (CP)" completion-preview-mode :help "Show preview of completion suggestions as you type" :enable completion-at-point-functions :button (:toggle . (bound-and-true-p completion-preview-mode)))) -(bindings--define-key mode-line-mode-menu [auto-revert-tail-mode] +(define-key mode-line-mode-menu [auto-revert-tail-mode] '(menu-item "Auto revert tail (Tail)" auto-revert-tail-mode :help "Revert the tail of the buffer when the file on disk grows" :enable (buffer-file-name) :button (:toggle . (bound-and-true-p auto-revert-tail-mode)))) -(bindings--define-key mode-line-mode-menu [auto-revert-mode] +(define-key mode-line-mode-menu [auto-revert-mode] '(menu-item "Auto revert (ARev)" auto-revert-mode :help "Revert the buffer when the file on disk changes" :button (:toggle . (bound-and-true-p auto-revert-mode)))) -(bindings--define-key mode-line-mode-menu [auto-fill-mode] +(define-key mode-line-mode-menu [auto-fill-mode] '(menu-item "Auto fill (Fill)" auto-fill-mode :help "Automatically insert new lines" :button (:toggle . auto-fill-function))) -(bindings--define-key mode-line-mode-menu [abbrev-mode] +(define-key mode-line-mode-menu [abbrev-mode] '(menu-item "Abbrev (Abbrev)" abbrev-mode :help "Automatically expand abbreviations" :button (:toggle . abbrev-mode))) @@ -1648,6 +1625,8 @@ if `inhibit-field-text-motion' is non-nil." ;; Text conversion (define-key global-map [text-conversion] 'analyze-text-conversion) +(define-obsolete-function-alias 'bindings--define-key #'define-key "31.1") + ;; Don't look for autoload cookies in this file. ;; Local Variables: ;; no-update-autoloads: t diff --git a/lisp/bookmark.el b/lisp/bookmark.el index d43f9f740ca..d4a0eb138b0 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -2561,37 +2561,37 @@ strings returned are not." ;;;###autoload (defvar menu-bar-bookmark-map (let ((map (make-sparse-keymap "Bookmark functions"))) - (bindings--define-key map [load] + (define-key map [load] '(menu-item "Load a Bookmark File..." bookmark-load :help "Load bookmarks from a bookmark file)")) - (bindings--define-key map [write] + (define-key map [write] '(menu-item "Save Bookmarks As..." bookmark-write :help "Write bookmarks to a file (reading the file name with the minibuffer)")) - (bindings--define-key map [save] + (define-key map [save] '(menu-item "Save Bookmarks" bookmark-save :help "Save currently defined bookmarks")) - (bindings--define-key map [edit] + (define-key map [edit] '(menu-item "Edit Bookmark List" bookmark-bmenu-list :help "Display a list of existing bookmarks")) - (bindings--define-key map [delete] + (define-key map [delete] '(menu-item "Delete Bookmark..." bookmark-delete :help "Delete a bookmark from the bookmark list")) - (bindings--define-key map [delete-all] + (define-key map [delete-all] '(menu-item "Delete all Bookmarks..." bookmark-delete-all :help "Delete all bookmarks from the bookmark list")) - (bindings--define-key map [rename] + (define-key map [rename] '(menu-item "Rename Bookmark..." bookmark-rename :help "Change the name of a bookmark")) - (bindings--define-key map [locate] + (define-key map [locate] '(menu-item "Insert Location..." bookmark-locate :help "Insert the name of the file associated with a bookmark")) - (bindings--define-key map [insert] + (define-key map [insert] '(menu-item "Insert Contents..." bookmark-insert :help "Insert the text of the file pointed to by a bookmark")) - (bindings--define-key map [set] + (define-key map [set] '(menu-item "Set Bookmark..." bookmark-set :help "Set a bookmark named inside a file.")) - (bindings--define-key map [jump] + (define-key map [jump] '(menu-item "Jump to Bookmark..." bookmark-jump :help "Jump to a bookmark (a point in some file)")) map)) diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index cefb6ddf9da..ef3622ec3ca 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -59,97 +59,97 @@ (defvar describe-language-environment-map (let ((map (make-sparse-keymap "Describe Language Environment"))) - (bindings--define-key map + (define-key map [Default] '(menu-item "Default" describe-specified-language-support)) map)) (defvar setup-language-environment-map (let ((map (make-sparse-keymap "Set Language Environment"))) - (bindings--define-key map + (define-key map [Default] '(menu-item "Default" setup-specified-language-environment)) map)) (defvar set-coding-system-map (let ((map (make-sparse-keymap "Set Coding System"))) - (bindings--define-key map [set-buffer-process-coding-system] + (define-key map [set-buffer-process-coding-system] '(menu-item "For I/O with Subprocess" set-buffer-process-coding-system :visible (fboundp 'make-process) :enable (get-buffer-process (current-buffer)) :help "How to en/decode I/O from/to subprocess connected to this buffer")) - (bindings--define-key map [set-next-selection-coding-system] + (define-key map [set-next-selection-coding-system] '(menu-item "For Next X Selection" set-next-selection-coding-system :visible (display-selections-p) :help "How to en/decode next selection/clipboard operation")) - (bindings--define-key map [set-selection-coding-system] + (define-key map [set-selection-coding-system] '(menu-item "For X Selections/Clipboard" set-selection-coding-system :visible (display-selections-p) :help "How to en/decode data to/from selection/clipboard")) - (bindings--define-key map [separator-3] menu-bar-separator) - (bindings--define-key map [set-terminal-coding-system] + (define-key map [separator-3] menu-bar-separator) + (define-key map [set-terminal-coding-system] '(menu-item "For Terminal" set-terminal-coding-system :enable (null (memq initial-window-system '(x w32 ns haiku pgtk android))) :help "How to encode terminal output")) - (bindings--define-key map [set-keyboard-coding-system] + (define-key map [set-keyboard-coding-system] '(menu-item "For Keyboard" set-keyboard-coding-system :help "How to decode keyboard input")) - (bindings--define-key map [separator-2] menu-bar-separator) - (bindings--define-key map [set-file-name-coding-system] + (define-key map [separator-2] menu-bar-separator) + (define-key map [set-file-name-coding-system] '(menu-item "For File Name" set-file-name-coding-system :help "How to decode/encode file names")) - (bindings--define-key map [revert-buffer-with-coding-system] + (define-key map [revert-buffer-with-coding-system] '(menu-item "For Reverting This File Now" revert-buffer-with-coding-system :enable buffer-file-name :help "Revisit this file immediately using specified coding system")) - (bindings--define-key map [set-buffer-file-coding-system] + (define-key map [set-buffer-file-coding-system] '(menu-item "For Saving This Buffer" set-buffer-file-coding-system :help "How to encode this buffer when saved")) - (bindings--define-key map [separator-1] menu-bar-separator) - (bindings--define-key map [universal-coding-system-argument] + (define-key map [separator-1] menu-bar-separator) + (define-key map [universal-coding-system-argument] '(menu-item "For Next Command" universal-coding-system-argument :help "Coding system to be used by next command")) map)) (defvar mule-menu-keymap (let ((map (make-sparse-keymap "Mule (Multilingual Environment)"))) - (bindings--define-key map [mule-diag] + (define-key map [mule-diag] '(menu-item "Show All Multilingual Settings" mule-diag :help "Display multilingual environment settings")) - (bindings--define-key map [list-character-sets] + (define-key map [list-character-sets] '(menu-item "List Character Sets" list-character-sets :help "Show table of available character sets")) - (bindings--define-key map [describe-coding-system] + (define-key map [describe-coding-system] '(menu-item "Describe Coding System..." describe-coding-system)) - (bindings--define-key map [describe-input-method] + (define-key map [describe-input-method] '(menu-item "Describe Input Method..." describe-input-method :help "Keyboard layout for a specific input method")) - (bindings--define-key map [describe-language-environment] + (define-key map [describe-language-environment] `(menu-item "Describe Language Environment" ,describe-language-environment-map :help "Show multilingual settings for a specific language")) - (bindings--define-key map [separator-coding-system] menu-bar-separator) - (bindings--define-key map [view-hello-file] + (define-key map [separator-coding-system] menu-bar-separator) + (define-key map [view-hello-file] '(menu-item "Show Multilingual Sample Text" view-hello-file :enable (file-readable-p (expand-file-name "HELLO" data-directory)) :help "Demonstrate various character sets")) - (bindings--define-key map [set-various-coding-system] + (define-key map [set-various-coding-system] `(menu-item "Set Coding Systems" ,set-coding-system-map)) - (bindings--define-key map [separator-input-method] menu-bar-separator) - (bindings--define-key map [activate-transient-input-method] + (define-key map [separator-input-method] menu-bar-separator) + (define-key map [activate-transient-input-method] '(menu-item "Transient Input Method" activate-transient-input-method)) - (bindings--define-key map [set-input-method] + (define-key map [set-input-method] '(menu-item "Select Input Method..." set-input-method)) - (bindings--define-key map [toggle-input-method] + (define-key map [toggle-input-method] '(menu-item "Toggle Input Method" toggle-input-method)) - (bindings--define-key map [separator-mule] menu-bar-separator) - (bindings--define-key map [set-language-environment] + (define-key map [separator-mule] menu-bar-separator) + (define-key map [set-language-environment] `(menu-item "Set Language Environment" ,setup-language-environment-map)) map) "Keymap for Mule (Multilingual environment) menu specific commands.") diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index b85cc834588..b625a317c56 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -51,29 +51,29 @@ (defvar menu-bar-print-menu (let ((menu (make-sparse-keymap "Print"))) - (bindings--define-key menu [ps-print-region] + (define-key menu [ps-print-region] '(menu-item "PostScript Print Region (B+W)" ps-print-region :enable mark-active :help "Pretty-print marked region in black and white to PostScript printer")) - (bindings--define-key menu [ps-print-buffer] + (define-key menu [ps-print-buffer] '(menu-item "PostScript Print Buffer (B+W)" ps-print-buffer :enable (menu-bar-menu-frame-live-and-visible-p) :help "Pretty-print current buffer in black and white to PostScript printer")) - (bindings--define-key menu [ps-print-region-faces] + (define-key menu [ps-print-region-faces] '(menu-item "PostScript Print Region" ps-print-region-with-faces :enable mark-active :help "Pretty-print marked region to PostScript printer")) - (bindings--define-key menu [ps-print-buffer-faces] + (define-key menu [ps-print-buffer-faces] '(menu-item "PostScript Print Buffer" ps-print-buffer-with-faces :enable (menu-bar-menu-frame-live-and-visible-p) :help "Pretty-print current buffer to PostScript printer")) - (bindings--define-key menu [print-region] + (define-key menu [print-region] '(menu-item "Print Region" print-region :enable mark-active :help "Print region between mark and current position")) - (bindings--define-key menu [print-buffer] + (define-key menu [print-buffer] '(menu-item "Print Buffer" print-buffer :enable (menu-bar-menu-frame-live-and-visible-p) :help "Print current buffer with page headings")) @@ -91,37 +91,37 @@ in the tool bar will close the current window where possible." (let ((menu (make-sparse-keymap "File"))) ;; The "File" menu items - (bindings--define-key menu [exit-emacs] + (define-key menu [exit-emacs] '(menu-item "Quit" save-buffers-kill-terminal :help "Save unsaved buffers, then exit")) - (bindings--define-key menu [separator-exit] + (define-key menu [separator-exit] menu-bar-separator) - (bindings--define-key menu [print] + (define-key menu [print] `(menu-item "Print" ,menu-bar-print-menu)) - (bindings--define-key menu [separator-print] + (define-key menu [separator-print] menu-bar-separator) - (bindings--define-key menu [close-tab] + (define-key menu [close-tab] '(menu-item "Close Tab" tab-close :visible (fboundp 'tab-close) :help "Close currently selected tab")) - (bindings--define-key menu [make-tab] + (define-key menu [make-tab] '(menu-item "New Tab" tab-new :visible (fboundp 'tab-new) :help "Open a new tab")) - (bindings--define-key menu [separator-tab] + (define-key menu [separator-tab] menu-bar-separator) - (bindings--define-key menu [undelete-frame-mode] + (define-key menu [undelete-frame-mode] '(menu-item "Allow Undeleting Frames" undelete-frame-mode :help "Allow frames to be restored after deletion" :button (:toggle . undelete-frame-mode))) - (bindings--define-key menu [undelete-last-deleted-frame] + (define-key menu [undelete-last-deleted-frame] '(menu-item "Undelete Frame" undelete-frame :enable (and undelete-frame-mode (car undelete-frame--deleted-frames)) @@ -129,48 +129,48 @@ in the tool bar will close the current window where possible." ;; Don't use delete-frame as event name because that is a special ;; event. - (bindings--define-key menu [delete-this-frame] + (define-key menu [delete-this-frame] '(menu-item "Delete Frame" delete-frame :visible (fboundp 'delete-frame) :enable (delete-frame-enabled-p) :help "Delete currently selected frame")) - (bindings--define-key menu [make-frame-on-monitor] + (define-key menu [make-frame-on-monitor] '(menu-item "New Frame on Monitor..." make-frame-on-monitor :visible (fboundp 'make-frame-on-monitor) :help "Open a new frame on another monitor")) - (bindings--define-key menu [make-frame-on-display] + (define-key menu [make-frame-on-display] '(menu-item "New Frame on Display Server..." make-frame-on-display :visible (fboundp 'make-frame-on-display) :help "Open a new frame on a display server")) - (bindings--define-key menu [make-frame] + (define-key menu [make-frame] '(menu-item "New Frame" make-frame-command :visible (fboundp 'make-frame-command) :help "Open a new frame")) - (bindings--define-key menu [separator-frame] + (define-key menu [separator-frame] menu-bar-separator) - (bindings--define-key menu [one-window] + (define-key menu [one-window] '(menu-item "Remove Other Windows" delete-other-windows :enable (not (one-window-p t nil)) :help "Make selected window fill whole frame")) - (bindings--define-key menu [new-window-on-right] + (define-key menu [new-window-on-right] '(menu-item "New Window on Right" split-window-right :enable (and (menu-bar-menu-frame-live-and-visible-p) (menu-bar-non-minibuffer-window-p)) :help "Make new window on right of selected one")) - (bindings--define-key menu [new-window-below] + (define-key menu [new-window-below] '(menu-item "New Window Below" split-window-below :enable (and (menu-bar-menu-frame-live-and-visible-p) (menu-bar-non-minibuffer-window-p)) :help "Make new window below selected one")) - (bindings--define-key menu [separator-window] + (define-key menu [separator-window] menu-bar-separator) - (bindings--define-key menu [recover-session] + (define-key menu [recover-session] '(menu-item "Recover Crashed Session" recover-session :enable (and auto-save-list-file-prefix @@ -185,7 +185,7 @@ in the tool bar will close the current window where possible." auto-save-list-file-prefix))) t)) :help "Recover edits from a crashed session")) - (bindings--define-key menu [revert-buffer] + (define-key menu [revert-buffer] '(menu-item "Revert Buffer" revert-buffer :enable @@ -203,47 +203,47 @@ in the tool bar will close the current window where possible." (not (eq (not buffer-read-only) (file-writable-p buffer-file-name)))))) :help "Re-read current buffer from its file")) - (bindings--define-key menu [write-file] + (define-key menu [write-file] '(menu-item "Save As..." write-file :enable (and (menu-bar-menu-frame-live-and-visible-p) (menu-bar-non-minibuffer-window-p)) :help "Write current buffer to another file")) - (bindings--define-key menu [save-buffer] + (define-key menu [save-buffer] '(menu-item "Save" save-buffer :enable (and (buffer-modified-p) (buffer-file-name) (menu-bar-non-minibuffer-window-p)) :help "Save current buffer to its file")) - (bindings--define-key menu [separator-save] + (define-key menu [separator-save] menu-bar-separator) - (bindings--define-key menu [kill-buffer] + (define-key menu [kill-buffer] '(menu-item "Close" kill-this-buffer :enable (kill-this-buffer-enabled-p) :help "Discard (kill) current buffer")) - (bindings--define-key menu [insert-file] + (define-key menu [insert-file] '(menu-item "Insert File..." insert-file :enable (menu-bar-non-minibuffer-window-p) :help "Insert another file into current buffer")) - (bindings--define-key menu [project-dired] + (define-key menu [project-dired] '(menu-item "Open Project Directory" project-dired :enable (menu-bar-non-minibuffer-window-p) :help "Read the root directory of the current project, to operate on its files")) - (bindings--define-key menu [dired] + (define-key menu [dired] '(menu-item "Open Directory..." dired :enable (menu-bar-non-minibuffer-window-p) :help "Read a directory, to operate on its files")) - (bindings--define-key menu [project-open-file] + (define-key menu [project-open-file] '(menu-item "Open File In Project..." project-find-file :enable (menu-bar-non-minibuffer-window-p) :help "Read existing file that belongs to current project into an Emacs buffer")) - (bindings--define-key menu [open-file] + (define-key menu [open-file] '(menu-item "Open File..." menu-find-file-existing :enable (menu-bar-non-minibuffer-window-p) :help "Read an existing file into an Emacs buffer")) - (bindings--define-key menu [new-file] + (define-key menu [new-file] '(menu-item "Visit New File..." find-file :enable (menu-bar-non-minibuffer-window-p) :help "Specify a new file's name, to edit the file")) @@ -330,45 +330,45 @@ in the tool bar will close the current window where possible." ;; The Edit->Incremental Search menu (defvar menu-bar-i-search-menu (let ((menu (make-sparse-keymap "Incremental Search"))) - (bindings--define-key menu [isearch-forward-symbol-at-point] + (define-key menu [isearch-forward-symbol-at-point] '(menu-item "Forward Symbol at Point..." isearch-forward-symbol-at-point :help "Search forward for a symbol found at point")) - (bindings--define-key menu [isearch-forward-symbol] + (define-key menu [isearch-forward-symbol] '(menu-item "Forward Symbol..." isearch-forward-symbol :help "Search forward for a symbol as you type it")) - (bindings--define-key menu [isearch-forward-word] + (define-key menu [isearch-forward-word] '(menu-item "Forward Word..." isearch-forward-word :help "Search forward for a word as you type it")) - (bindings--define-key menu [isearch-backward-regexp] + (define-key menu [isearch-backward-regexp] '(menu-item "Backward Regexp..." isearch-backward-regexp :help "Search backwards for a regular expression as you type it")) - (bindings--define-key menu [isearch-forward-regexp] + (define-key menu [isearch-forward-regexp] '(menu-item "Forward Regexp..." isearch-forward-regexp :help "Search forward for a regular expression as you type it")) - (bindings--define-key menu [isearch-backward] + (define-key menu [isearch-backward] '(menu-item "Backward String..." isearch-backward :help "Search backwards for a string as you type it")) - (bindings--define-key menu [isearch-forward] + (define-key menu [isearch-forward] '(menu-item "Forward String..." isearch-forward :help "Search forward for a string as you type it")) menu)) (defvar menu-bar-search-menu (let ((menu (make-sparse-keymap "Search"))) - (bindings--define-key menu [tags-continue] + (define-key menu [tags-continue] '(menu-item "Continue Tags Search" fileloop-continue :enable (and (featurep 'fileloop) (not (eq fileloop--operate-function 'ignore))) :help "Continue last tags search operation")) - (bindings--define-key menu [tags-srch] + (define-key menu [tags-srch] '(menu-item "Search Tagged Files..." tags-search :help "Search for a regexp in all tagged files")) - (bindings--define-key menu [project-search] + (define-key menu [project-search] '(menu-item "Search in Project Files..." project-find-regexp :help "Search for a regexp in files belonging to current project")) - (bindings--define-key menu [separator-tag-search] menu-bar-separator) + (define-key menu [separator-tag-search] menu-bar-separator) - (bindings--define-key menu [repeat-search-back] + (define-key menu [repeat-search-back] '(menu-item "Repeat Backwards" nonincremental-repeat-search-backward :enable (or (and (eq menu-bar-last-search-type 'string) @@ -376,7 +376,7 @@ in the tool bar will close the current window where possible." (and (eq menu-bar-last-search-type 'regexp) regexp-search-ring)) :help "Repeat last search backwards")) - (bindings--define-key menu [repeat-search-fwd] + (define-key menu [repeat-search-fwd] '(menu-item "Repeat Forward" nonincremental-repeat-search-forward :enable (or (and (eq menu-bar-last-search-type 'string) @@ -384,23 +384,23 @@ in the tool bar will close the current window where possible." (and (eq menu-bar-last-search-type 'regexp) regexp-search-ring)) :help "Repeat last search forward")) - (bindings--define-key menu [separator-repeat-search] + (define-key menu [separator-repeat-search] menu-bar-separator) - (bindings--define-key menu [re-search-backward] + (define-key menu [re-search-backward] '(menu-item "Regexp Backwards..." nonincremental-re-search-backward :help "Search backwards for a regular expression")) - (bindings--define-key menu [re-search-forward] + (define-key menu [re-search-forward] '(menu-item "Regexp Forward..." nonincremental-re-search-forward :help "Search forward for a regular expression")) - (bindings--define-key menu [search-backward] + (define-key menu [search-backward] '(menu-item "String Backwards..." nonincremental-search-backward :help "Search backwards for a string")) - (bindings--define-key menu [search-forward] + (define-key menu [search-forward] '(menu-item "String Forward..." nonincremental-search-forward :help "Search forward for a string")) menu)) @@ -409,25 +409,25 @@ in the tool bar will close the current window where possible." (defvar menu-bar-replace-menu (let ((menu (make-sparse-keymap "Replace"))) - (bindings--define-key menu [tags-repl-continue] + (define-key menu [tags-repl-continue] '(menu-item "Continue Replace" fileloop-continue :enable (and (featurep 'fileloop) (not (eq fileloop--operate-function 'ignore))) :help "Continue last tags replace operation")) - (bindings--define-key menu [tags-repl] + (define-key menu [tags-repl] '(menu-item "Replace in Tagged Files..." tags-query-replace :help "Interactively replace a regexp in all tagged files")) - (bindings--define-key menu [project-replace] + (define-key menu [project-replace] '(menu-item "Replace in Project Files..." project-query-replace-regexp :help "Interactively replace a regexp in files belonging to current project")) - (bindings--define-key menu [separator-replace-tags] + (define-key menu [separator-replace-tags] menu-bar-separator) - (bindings--define-key menu [query-replace-regexp] + (define-key menu [query-replace-regexp] '(menu-item "Replace Regexp..." query-replace-regexp :enable (not buffer-read-only) :help "Replace regular expression interactively, ask about each occurrence")) - (bindings--define-key menu [query-replace] + (define-key menu [query-replace] '(menu-item "Replace String..." query-replace :enable (not buffer-read-only) :help "Replace string interactively, ask about each occurrence")) @@ -437,49 +437,49 @@ in the tool bar will close the current window where possible." (defvar menu-bar-goto-menu (let ((menu (make-sparse-keymap "Go To"))) - (bindings--define-key menu [set-tags-name] + (define-key menu [set-tags-name] '(menu-item "Set Tags File Name..." visit-tags-table :visible (menu-bar-goto-uses-etags-p) :help "Tell navigation commands which tag table file to use")) - (bindings--define-key menu [separator-tag-file] + (define-key menu [separator-tag-file] '(menu-item "--" nil :visible (menu-bar-goto-uses-etags-p))) - (bindings--define-key menu [xref-forward] + (define-key menu [xref-forward] '(menu-item "Forward" xref-go-forward :visible (and (featurep 'xref) (not (xref-forward-history-empty-p))) :help "Forward to the position gone Back from")) - (bindings--define-key menu [xref-pop] + (define-key menu [xref-pop] '(menu-item "Back" xref-go-back :visible (and (featurep 'xref) (not (xref-marker-stack-empty-p))) :help "Back to the position of the last search")) - (bindings--define-key menu [xref-apropos] + (define-key menu [xref-apropos] '(menu-item "Find Apropos..." xref-find-apropos :help "Find function/variables whose names match regexp")) - (bindings--define-key menu [xref-find-otherw] + (define-key menu [xref-find-otherw] '(menu-item "Find Definition in Other Window..." xref-find-definitions-other-window :help "Find function/variable definition in another window")) - (bindings--define-key menu [xref-find-def] + (define-key menu [xref-find-def] '(menu-item "Find Definition..." xref-find-definitions :help "Find definition of function or variable")) - (bindings--define-key menu [separator-xref] + (define-key menu [separator-xref] menu-bar-separator) - (bindings--define-key menu [end-of-buf] + (define-key menu [end-of-buf] '(menu-item "Goto End of Buffer" end-of-buffer)) - (bindings--define-key menu [beg-of-buf] + (define-key menu [beg-of-buf] '(menu-item "Goto Beginning of Buffer" beginning-of-buffer)) - (bindings--define-key menu [go-to-pos] + (define-key menu [go-to-pos] '(menu-item "Goto Buffer Position..." goto-char :help "Read a number N and go to buffer position N")) - (bindings--define-key menu [go-to-line] + (define-key menu [go-to-line] '(menu-item "Goto Line..." goto-line :help "Read a line number and go to that line")) menu)) @@ -494,47 +494,47 @@ in the tool bar will close the current window where possible." (defvar menu-bar-edit-menu (let ((menu (make-sparse-keymap "Edit"))) - (bindings--define-key menu [execute-extended-command] + (define-key menu [execute-extended-command] '(menu-item "Execute Command" execute-extended-command :enable t :help "Read a command name, its arguments, then call it.")) ;; ns-win.el said: Add spell for platform consistency. (if (featurep 'ns) - (bindings--define-key menu [spell] + (define-key menu [spell] '(menu-item "Spell" ispell-menu-map))) - (bindings--define-key menu [fill] + (define-key menu [fill] '(menu-item "Fill" fill-region :enable (and mark-active (not buffer-read-only)) :help "Fill text in region to fit between left and right margin")) - (bindings--define-key menu [separator-bookmark] + (define-key menu [separator-bookmark] menu-bar-separator) - (bindings--define-key menu [bookmark] + (define-key menu [bookmark] '(menu-item "Bookmarks" menu-bar-bookmark-map)) - (bindings--define-key menu [goto] + (define-key menu [goto] `(menu-item "Go To" ,menu-bar-goto-menu)) - (bindings--define-key menu [replace] + (define-key menu [replace] `(menu-item "Replace" ,menu-bar-replace-menu)) - (bindings--define-key menu [i-search] + (define-key menu [i-search] `(menu-item "Incremental Search" ,menu-bar-i-search-menu)) - (bindings--define-key menu [search] + (define-key menu [search] `(menu-item "Search" ,menu-bar-search-menu)) - (bindings--define-key menu [separator-search] + (define-key menu [separator-search] menu-bar-separator) - (bindings--define-key menu [mark-whole-buffer] + (define-key menu [mark-whole-buffer] '(menu-item "Select All" mark-whole-buffer :help "Mark the whole buffer for a subsequent cut/copy")) - (bindings--define-key menu [clear] + (define-key menu [clear] '(menu-item "Clear" delete-active-region :enable (and mark-active (not buffer-read-only)) @@ -542,7 +542,7 @@ in the tool bar will close the current window where possible." "Delete the text in region between mark and current position")) - (bindings--define-key menu (if (featurep 'ns) [select-paste] + (define-key menu (if (featurep 'ns) [select-paste] [paste-from-menu]) ;; ns-win.el said: Change text to be more consistent with ;; surrounding menu items `paste', etc." @@ -550,7 +550,7 @@ in the tool bar will close the current window where possible." yank-menu :enable (and (cdr yank-menu) (not buffer-read-only)) :help "Choose a string from the kill ring and paste it")) - (bindings--define-key menu [paste] + (define-key menu [paste] `(menu-item "Paste" yank :enable (funcall ',(lambda () @@ -565,7 +565,7 @@ in the tool bar will close the current window where possible." (if cua-mode "\\[cua-paste]" "\\[yank]")))) - (bindings--define-key menu [copy] + (define-key menu [copy] ;; ns-win.el said: Substitute a Copy function that works better ;; under X (for GNUstep). `(menu-item "Copy" ,(if (featurep 'ns) @@ -581,7 +581,7 @@ in the tool bar will close the current window where possible." "\\[cua-copy-handler]") (t "\\[kill-ring-save]"))))) - (bindings--define-key menu [cut] + (define-key menu [cut] `(menu-item "Cut" kill-region :enable (and mark-active (not buffer-read-only)) :help @@ -592,15 +592,15 @@ in the tool bar will close the current window where possible." "\\[kill-region]")))) ;; ns-win.el said: Separate undo from cut/paste section. (if (featurep 'ns) - (bindings--define-key menu [separator-undo] menu-bar-separator)) + (define-key menu [separator-undo] menu-bar-separator)) - (bindings--define-key menu [undo-redo] + (define-key menu [undo-redo] '(menu-item "Redo" undo-redo :enable (and (not buffer-read-only) (undo--last-change-was-undo-p buffer-undo-list)) :help "Redo last undone edits")) - (bindings--define-key menu [undo] + (define-key menu [undo] '(menu-item "Undo" undo :enable (and (not buffer-read-only) (not (eq t buffer-undo-list)) @@ -667,43 +667,43 @@ Do the same for the keys of the same name." (defvar menu-bar-custom-menu (let ((menu (make-sparse-keymap "Customize"))) - (bindings--define-key menu [customize-apropos-faces] + (define-key menu [customize-apropos-faces] '(menu-item "Faces Matching..." customize-apropos-faces :help "Browse faces matching a regexp or word list")) - (bindings--define-key menu [customize-apropos-options] + (define-key menu [customize-apropos-options] '(menu-item "Options Matching..." customize-apropos-options :help "Browse options matching a regexp or word list")) - (bindings--define-key menu [customize-apropos] + (define-key menu [customize-apropos] '(menu-item "All Settings Matching..." customize-apropos :help "Browse customizable settings matching a regexp or word list")) - (bindings--define-key menu [separator-1] + (define-key menu [separator-1] menu-bar-separator) - (bindings--define-key menu [customize-group] + (define-key menu [customize-group] '(menu-item "Specific Group..." customize-group :help "Customize settings of specific group")) - (bindings--define-key menu [customize-face] + (define-key menu [customize-face] '(menu-item "Specific Face..." customize-face :help "Customize attributes of specific face")) - (bindings--define-key menu [customize-option] + (define-key menu [customize-option] '(menu-item "Specific Option..." customize-option :help "Customize value of specific option")) - (bindings--define-key menu [separator-2] + (define-key menu [separator-2] menu-bar-separator) - (bindings--define-key menu [customize-changed] + (define-key menu [customize-changed] '(menu-item "New Options..." customize-changed :help "Options and faces added or changed in recent Emacs versions")) - (bindings--define-key menu [customize-saved] + (define-key menu [customize-saved] '(menu-item "Saved Options" customize-saved :help "Customize previously saved options")) - (bindings--define-key menu [separator-3] + (define-key menu [separator-3] menu-bar-separator) - (bindings--define-key menu [customize-browse] + (define-key menu [customize-browse] '(menu-item "Browse Customization Groups" customize-browse :help "Tree-like browser of all the groups of customizable options")) - (bindings--define-key menu [customize] + (define-key menu [customize] '(menu-item "Top-level Emacs Customization Group" customize :help "Top-level groups of customizable options, and their descriptions")) - (bindings--define-key menu [customize-themes] + (define-key menu [customize-themes] '(menu-item "Custom Themes" customize-themes :help "Choose a pre-defined customization theme")) menu)) @@ -883,12 +883,12 @@ The selected font will be the default on both the existing and future frames." ;; dividers are displayed by manipulating frame parameters directly. (defvar menu-bar-showhide-window-divider-menu (let ((menu (make-sparse-keymap "Window Divider"))) - (bindings--define-key menu [customize] + (define-key menu [customize] '(menu-item "Customize" menu-bar-window-divider-customize :help "Customize window dividers" :visible (memq (window-system) '(x w32)))) - (bindings--define-key menu [bottom-and-right] + (define-key menu [bottom-and-right] '(menu-item "Bottom and Right" menu-bar-bottom-and-right-window-divider :help "Display window divider on the bottom and right of each window" @@ -900,7 +900,7 @@ The selected font will be the default on both the existing and future frames." (window-divider-width-valid-p (cdr (assq 'right-divider-width (frame-parameters)))))))) - (bindings--define-key menu [right-only] + (define-key menu [right-only] '(menu-item "Right Only" menu-bar-right-window-divider :help "Display window divider on the right of each window only" @@ -912,7 +912,7 @@ The selected font will be the default on both the existing and future frames." (window-divider-width-valid-p (cdr (assq 'right-divider-width (frame-parameters)))))))) - (bindings--define-key menu [bottom-only] + (define-key menu [bottom-only] '(menu-item "Bottom Only" menu-bar-bottom-window-divider :help "Display window divider on the bottom of each window only" @@ -924,7 +924,7 @@ The selected font will be the default on both the existing and future frames." (not (window-divider-width-valid-p (cdr (assq 'right-divider-width (frame-parameters))))))))) - (bindings--define-key menu [no-divider] + (define-key menu [no-divider] '(menu-item "None" menu-bar-no-window-divider :help "Do not display window dividers" @@ -973,7 +973,7 @@ The selected font will be the default on both the existing and future frames." (defvar menu-bar-showhide-fringe-ind-menu (let ((menu (make-sparse-keymap "Buffer boundaries"))) - (bindings--define-key menu [customize] + (define-key menu [customize] '(menu-item "Other (Customize)" menu-bar-showhide-fringe-ind-customize :help "Additional choices available through Custom buffer" @@ -983,7 +983,7 @@ The selected font will be the default on both the existing and future frames." ((top . left) (bottom . right)) ((t . right) (top . left)))))))) - (bindings--define-key menu [mixed] + (define-key menu [mixed] '(menu-item "Opposite, Arrows Right" menu-bar-showhide-fringe-ind-mixed :help "Show top/bottom indicators in opposite fringes, arrows in right" @@ -991,26 +991,26 @@ The selected font will be the default on both the existing and future frames." :button (:radio . (equal indicate-buffer-boundaries '((t . right) (top . left)))))) - (bindings--define-key menu [box] + (define-key menu [box] '(menu-item "Opposite, No Arrows" menu-bar-showhide-fringe-ind-box :help "Show top/bottom indicators in opposite fringes, no arrows" :visible (display-graphic-p) :button (:radio . (equal indicate-buffer-boundaries '((top . left) (bottom . right)))))) - (bindings--define-key menu [right] + (define-key menu [right] '(menu-item "In Right Fringe" menu-bar-showhide-fringe-ind-right :help "Show buffer boundaries and arrows in right fringe" :visible (display-graphic-p) :button (:radio . (eq indicate-buffer-boundaries 'right)))) - (bindings--define-key menu [left] + (define-key menu [left] '(menu-item "In Left Fringe" menu-bar-showhide-fringe-ind-left :help "Show buffer boundaries and arrows in left fringe" :visible (display-graphic-p) :button (:radio . (eq indicate-buffer-boundaries 'left)))) - (bindings--define-key menu [none] + (define-key menu [none] '(menu-item "No Indicators" menu-bar-showhide-fringe-ind-none :help "Hide all buffer boundary indicators and arrows" :visible (display-graphic-p) @@ -1048,42 +1048,42 @@ The selected font will be the default on both the existing and future frames." (defvar menu-bar-showhide-fringe-menu (let ((menu (make-sparse-keymap "Fringe"))) - (bindings--define-key menu [showhide-fringe-ind] + (define-key menu [showhide-fringe-ind] `(menu-item "Buffer Boundaries" ,menu-bar-showhide-fringe-ind-menu :visible (display-graphic-p) :help "Indicate buffer boundaries in fringe")) - (bindings--define-key menu [indicate-empty-lines] + (define-key menu [indicate-empty-lines] (menu-bar-make-toggle-command toggle-indicate-empty-lines indicate-empty-lines "Empty Line Indicators" "Indicating of empty lines %s" "Indicate trailing empty lines in fringe, globally")) - (bindings--define-key menu [customize] + (define-key menu [customize] '(menu-item "Customize Fringe" menu-bar-showhide-fringe-menu-customize :help "Detailed customization of fringe" :visible (display-graphic-p))) - (bindings--define-key menu [default] + (define-key menu [default] '(menu-item "Default" menu-bar-showhide-fringe-menu-customize-reset :help "Default width fringe on both left and right side" :visible (display-graphic-p) :button (:radio . (eq fringe-mode nil)))) - (bindings--define-key menu [right] + (define-key menu [right] '(menu-item "On the Right" menu-bar-showhide-fringe-menu-customize-right :help "Fringe only on the right side" :visible (display-graphic-p) :button (:radio . (equal fringe-mode '(0 . nil))))) - (bindings--define-key menu [left] + (define-key menu [left] '(menu-item "On the Left" menu-bar-showhide-fringe-menu-customize-left :help "Fringe only on the left side" :visible (display-graphic-p) :button (:radio . (equal fringe-mode '(nil . 0))))) - (bindings--define-key menu [none] + (define-key menu [none] '(menu-item "None" menu-bar-showhide-fringe-menu-customize-disable :help "Turn off fringe" :visible (display-graphic-p) @@ -1108,15 +1108,15 @@ The selected font will be the default on both the existing and future frames." (defvar menu-bar-showhide-scroll-bar-menu (let ((menu (make-sparse-keymap "Scroll Bar"))) - (bindings--define-key menu [horizontal] + (define-key menu [horizontal] (menu-bar-make-mm-toggle horizontal-scroll-bar-mode "Horizontal" "Horizontal scroll bar")) - (bindings--define-key menu [scrollbar-separator] + (define-key menu [scrollbar-separator] menu-bar-separator) - (bindings--define-key menu [right] + (define-key menu [right] '(menu-item "On the Right" menu-bar-right-scroll-bar :help "Scroll bar on the right side" :visible (display-graphic-p) @@ -1125,7 +1125,7 @@ The selected font will be the default on both the existing and future frames." nil 'vertical-scroll-bars) 'right))))) - (bindings--define-key menu [left] + (define-key menu [left] '(menu-item "On the Left" menu-bar-left-scroll-bar :help "Scroll bar on the left side" :visible (display-graphic-p) @@ -1134,7 +1134,7 @@ The selected font will be the default on both the existing and future frames." nil 'vertical-scroll-bars) 'left))))) - (bindings--define-key menu [none] + (define-key menu [none] '(menu-item "No Vertical Scroll Bar" menu-bar-no-scroll-bar :help "Turn off vertical scroll bar" :visible (display-graphic-p) @@ -1180,7 +1180,7 @@ The selected font will be the default on both the existing and future frames." (defvar menu-bar-showhide-tool-bar-menu (let ((menu (make-sparse-keymap "Tool Bar"))) - (bindings--define-key menu [showhide-tool-bar-left] + (define-key menu [showhide-tool-bar-left] '(menu-item "On the Left" menu-bar-showhide-tool-bar-menu-customize-enable-left :help "Tool bar at the left side" @@ -1192,7 +1192,7 @@ The selected font will be the default on both the existing and future frames." 'tool-bar-position) 'left))))) - (bindings--define-key menu [showhide-tool-bar-right] + (define-key menu [showhide-tool-bar-right] '(menu-item "On the Right" menu-bar-showhide-tool-bar-menu-customize-enable-right :help "Tool bar at the right side" @@ -1204,7 +1204,7 @@ The selected font will be the default on both the existing and future frames." 'tool-bar-position) 'right))))) - (bindings--define-key menu [showhide-tool-bar-bottom] + (define-key menu [showhide-tool-bar-bottom] '(menu-item "On the Bottom" menu-bar-showhide-tool-bar-menu-customize-enable-bottom :help "Tool bar at the bottom" @@ -1216,7 +1216,7 @@ The selected font will be the default on both the existing and future frames." 'tool-bar-position) 'bottom))))) - (bindings--define-key menu [showhide-tool-bar-top] + (define-key menu [showhide-tool-bar-top] '(menu-item "On the Top" menu-bar-showhide-tool-bar-menu-customize-enable-top :help "Tool bar at the top" @@ -1228,7 +1228,7 @@ The selected font will be the default on both the existing and future frames." 'tool-bar-position) 'top))))) - (bindings--define-key menu [showhide-tool-bar-none] + (define-key menu [showhide-tool-bar-none] '(menu-item "None" menu-bar-showhide-tool-bar-menu-customize-disable :help "Turn tool bar off" @@ -1271,35 +1271,35 @@ The selected font will be the default on both the existing and future frames." (defvar menu-bar-showhide-line-numbers-menu (let ((menu (make-sparse-keymap "Line Numbers"))) - (bindings--define-key menu [visual] + (define-key menu [visual] '(menu-item "Visual Line Numbers" menu-bar--display-line-numbers-mode-visual :help "Enable visual line numbers" :button (:radio . (eq display-line-numbers 'visual)) :visible (menu-bar-menu-frame-live-and-visible-p))) - (bindings--define-key menu [relative] + (define-key menu [relative] '(menu-item "Relative Line Numbers" menu-bar--display-line-numbers-mode-relative :help "Enable relative line numbers" :button (:radio . (eq display-line-numbers 'relative)) :visible (menu-bar-menu-frame-live-and-visible-p))) - (bindings--define-key menu [absolute] + (define-key menu [absolute] '(menu-item "Absolute Line Numbers" menu-bar--display-line-numbers-mode-absolute :help "Enable absolute line numbers" :button (:radio . (eq display-line-numbers t)) :visible (menu-bar-menu-frame-live-and-visible-p))) - (bindings--define-key menu [none] + (define-key menu [none] '(menu-item "No Line Numbers" menu-bar--display-line-numbers-mode-none :help "Disable line numbers" :button (:radio . (null display-line-numbers)) :visible (menu-bar-menu-frame-live-and-visible-p))) - (bindings--define-key menu [global] + (define-key menu [global] (menu-bar-make-mm-toggle global-display-line-numbers-mode "Global Line Numbers Mode" "Set line numbers globally")) @@ -1308,43 +1308,43 @@ The selected font will be the default on both the existing and future frames." (defvar menu-bar-showhide-menu (let ((menu (make-sparse-keymap "Show/Hide"))) - (bindings--define-key menu [display-line-numbers] + (define-key menu [display-line-numbers] `(menu-item "Line Numbers for All Lines" ,menu-bar-showhide-line-numbers-menu)) - (bindings--define-key menu [column-number-mode] + (define-key menu [column-number-mode] (menu-bar-make-mm-toggle column-number-mode "Column Numbers in Mode Line" "Show the current column number in the mode line")) - (bindings--define-key menu [line-number-mode] + (define-key menu [line-number-mode] (menu-bar-make-mm-toggle line-number-mode "Line Numbers in Mode Line" "Show the current line number in the mode line")) - (bindings--define-key menu [size-indication-mode] + (define-key menu [size-indication-mode] (menu-bar-make-mm-toggle size-indication-mode "Size Indication" "Show the size of the buffer in the mode line")) - (bindings--define-key menu [linecolumn-separator] + (define-key menu [linecolumn-separator] menu-bar-separator) - (bindings--define-key menu [showhide-battery] + (define-key menu [showhide-battery] (menu-bar-make-mm-toggle display-battery-mode "Battery Status" "Display battery status information in mode line")) - (bindings--define-key menu [showhide-date-time] + (define-key menu [showhide-date-time] (menu-bar-make-mm-toggle display-time-mode "Time, Load and Mail" "Display time, system load averages and \ mail status in mode line")) - (bindings--define-key menu [datetime-separator] + (define-key menu [datetime-separator] menu-bar-separator) - (bindings--define-key menu [showhide-speedbar] + (define-key menu [showhide-speedbar] '(menu-item "Speedbar" speedbar-frame-mode :help "Display a Speedbar quick-navigation frame" :button (:toggle @@ -1353,7 +1353,7 @@ mail status in mode line")) (frame-visible-p (symbol-value 'speedbar-frame)))))) - (bindings--define-key menu [showhide-outline-minor-mode] + (define-key menu [showhide-outline-minor-mode] '(menu-item "Outlines" outline-minor-mode :help "Turn outline-minor-mode on/off" :visible (seq-some #'local-variable-p @@ -1361,36 +1361,36 @@ mail status in mode line")) outline-regexp outline-level)) :button (:toggle . (bound-and-true-p outline-minor-mode)))) - (bindings--define-key menu [showhide-tab-line-mode] + (define-key menu [showhide-tab-line-mode] '(menu-item "Window Tab Line" global-tab-line-mode :help "Turn window-local tab-lines on/off" :visible (fboundp 'global-tab-line-mode) :button (:toggle . global-tab-line-mode))) - (bindings--define-key menu [showhide-window-divider] + (define-key menu [showhide-window-divider] `(menu-item "Window Divider" ,menu-bar-showhide-window-divider-menu :visible (memq (window-system) '(x w32)))) - (bindings--define-key menu [showhide-fringe] + (define-key menu [showhide-fringe] `(menu-item "Fringe" ,menu-bar-showhide-fringe-menu :visible (display-graphic-p))) - (bindings--define-key menu [showhide-scroll-bar] + (define-key menu [showhide-scroll-bar] `(menu-item "Scroll Bar" ,menu-bar-showhide-scroll-bar-menu :visible (display-graphic-p))) - (bindings--define-key menu [showhide-tooltip-mode] + (define-key menu [showhide-tooltip-mode] '(menu-item "Tooltips" tooltip-mode :help "Turn tooltips on/off" :visible (and (display-graphic-p) (fboundp 'x-show-tip)) :button (:toggle . tooltip-mode))) - (bindings--define-key menu [showhide-context-menu] + (define-key menu [showhide-context-menu] '(menu-item "Context Menus" context-menu-mode :help "Turn mouse-3 context menus on/off" :button (:toggle . context-menu-mode))) - (bindings--define-key menu [menu-bar-mode] + (define-key menu [menu-bar-mode] '(menu-item "Menu Bar" toggle-menu-bar-mode-from-frame :help "Turn menu bar on/off" :button @@ -1398,7 +1398,7 @@ mail status in mode line")) (frame-parameter (menu-bar-frame-for-menubar) 'menu-bar-lines))))) - (bindings--define-key menu [showhide-tab-bar] + (define-key menu [showhide-tab-bar] '(menu-item "Tab Bar" toggle-tab-bar-mode-from-frame :help "Turn tab bar on/off" :button @@ -1408,11 +1408,11 @@ mail status in mode line")) (if (and (boundp 'menu-bar-showhide-tool-bar-menu) (keymapp menu-bar-showhide-tool-bar-menu)) - (bindings--define-key menu [showhide-tool-bar] + (define-key menu [showhide-tool-bar] `(menu-item "Tool Bar" ,menu-bar-showhide-tool-bar-menu :visible (display-graphic-p))) ;; else not tool bar that can move. - (bindings--define-key menu [showhide-tool-bar] + (define-key menu [showhide-tool-bar] '(menu-item "Tool Bar" toggle-tool-bar-mode-from-frame :help "Turn tool bar on/off" :visible (display-graphic-p) @@ -1446,7 +1446,7 @@ mail status in mode line")) (defvar menu-bar-line-wrapping-menu (let ((menu (make-sparse-keymap "Line Wrapping"))) - (bindings--define-key menu [visual-wrap] + (define-key menu [visual-wrap] '(menu-item "Visual Wrap Prefix mode" visual-wrap-prefix-mode :help "Display continuation lines with visual context-dependent prefix" :visible (menu-bar-menu-frame-live-and-visible-p) @@ -1454,7 +1454,7 @@ mail status in mode line")) . (bound-and-true-p visual-wrap-prefix-mode)) :enable t)) - (bindings--define-key menu [word-wrap] + (define-key menu [word-wrap] '(menu-item "Word Wrap (Visual Line mode)" menu-bar--visual-line-mode-enable :help "Wrap long lines at word boundaries" @@ -1464,7 +1464,7 @@ mail status in mode line")) word-wrap)) :visible (menu-bar-menu-frame-live-and-visible-p))) - (bindings--define-key menu [truncate] + (define-key menu [truncate] '(menu-item "Truncate Long Lines" menu-bar--toggle-truncate-long-lines :help "Truncate long lines at window edge" @@ -1473,7 +1473,7 @@ mail status in mode line")) :visible (menu-bar-menu-frame-live-and-visible-p) :enable (not (truncated-partial-width-window-p)))) - (bindings--define-key menu [window-wrap] + (define-key menu [window-wrap] '(menu-item "Wrap at Window Edge" menu-bar--wrap-long-lines-window-edge :help "Wrap long lines at window edge" @@ -1491,7 +1491,7 @@ mail status in mode line")) (dolist (x '((char-fold-to-regexp "Fold Characters" "Character folding") (isearch-symbol-regexp "Whole Symbols" "Whole symbol") (word-search-regexp "Whole Words" "Whole word"))) - (bindings--define-key menu (vector (nth 0 x)) + (define-key menu (vector (nth 0 x)) `(menu-item ,(nth 1 x) ,(lambda () (interactive) @@ -1500,7 +1500,7 @@ mail status in mode line")) :help ,(format "Enable %s search" (downcase (nth 2 x))) :button (:radio . (eq search-default-mode #',(nth 0 x)))))) - (bindings--define-key menu [regexp-search] + (define-key menu [regexp-search] `(menu-item "Regular Expression" ,(lambda () (interactive) @@ -1509,7 +1509,7 @@ mail status in mode line")) :help "Enable regular-expression search" :button (:radio . (eq search-default-mode t)))) - (bindings--define-key menu [regular-search] + (define-key menu [regular-search] `(menu-item "Literal Search" ,(lambda () (interactive) @@ -1520,9 +1520,9 @@ mail status in mode line")) :help "Disable special search modes" :button (:radio . (not search-default-mode)))) - (bindings--define-key menu [custom-separator] + (define-key menu [custom-separator] menu-bar-separator) - (bindings--define-key menu [case-fold-search] + (define-key menu [case-fold-search] (menu-bar-make-toggle-command toggle-case-fold-search case-fold-search "Ignore Case" @@ -1533,74 +1533,74 @@ mail status in mode line")) (defvar menu-bar-options-menu (let ((menu (make-sparse-keymap "Options"))) - (bindings--define-key menu [customize] + (define-key menu [customize] `(menu-item "Customize Emacs" ,menu-bar-custom-menu)) - (bindings--define-key menu [package] + (define-key menu [package] '(menu-item "Manage Emacs Packages" package-list-packages :help "Install or uninstall additional Emacs packages")) - (bindings--define-key menu [save] + (define-key menu [save] '(menu-item "Save Options" menu-bar-options-save :help "Save options set from the menu above")) - (bindings--define-key menu [custom-separator] + (define-key menu [custom-separator] menu-bar-separator) - (bindings--define-key menu [menu-set-font] + (define-key menu [menu-set-font] '(menu-item "Set Default Font..." menu-set-font :visible (display-multi-font-p) :help "Select a default font")) (if (featurep 'system-font-setting) - (bindings--define-key menu [menu-system-font] + (define-key menu [menu-system-font] (menu-bar-make-toggle-command toggle-use-system-font font-use-system-font "Use System Font" "Use system font: %s" "Use the monospaced font defined by the system"))) - (bindings--define-key menu [showhide] + (define-key menu [showhide] `(menu-item "Show/Hide" ,menu-bar-showhide-menu)) - (bindings--define-key menu [showhide-separator] + (define-key menu [showhide-separator] menu-bar-separator) - (bindings--define-key menu [mule] + (define-key menu [mule] ;; It is better not to use backquote here, ;; because that makes a bootstrapping problem ;; if you need to recompile all the Lisp files using interpreted code. `(menu-item "Multilingual Environment" ,mule-menu-keymap)) ;;(setq menu-bar-final-items (cons 'mule menu-bar-final-items)) - ;;(bindings--define-key menu [preferences] + ;;(define-key menu [preferences] ;; `(menu-item "Preferences" ,menu-bar-preferences-menu ;; :help "Toggle important global options")) - (bindings--define-key menu [mule-separator] + (define-key menu [mule-separator] menu-bar-separator) - (bindings--define-key menu [debug-on-quit] + (define-key menu [debug-on-quit] (menu-bar-make-toggle-command toggle-debug-on-quit debug-on-quit "Enter Debugger on Quit/C-g" "Debug on Quit %s" "Enter Lisp debugger when C-g is pressed")) - (bindings--define-key menu [debug-on-error] + (define-key menu [debug-on-error] (menu-bar-make-toggle-command toggle-debug-on-error debug-on-error "Enter Debugger on Error" "Debug on Error %s" "Enter Lisp debugger when an error is signaled")) - (bindings--define-key menu [debugger-separator] + (define-key menu [debugger-separator] menu-bar-separator) - (bindings--define-key menu [blink-cursor-mode] + (define-key menu [blink-cursor-mode] (menu-bar-make-mm-toggle blink-cursor-mode "Blink Cursor" "Whether the cursor blinks (Blink Cursor mode)")) - (bindings--define-key menu [cursor-separator] + (define-key menu [cursor-separator] menu-bar-separator) - (bindings--define-key menu [save-desktop] + (define-key menu [save-desktop] (menu-bar-make-toggle-command toggle-save-desktop-globally desktop-save-mode "Save State between Sessions" @@ -1613,7 +1613,7 @@ mail status in mode line")) (set-default 'desktop-save-mode (not (symbol-value 'desktop-save-mode)))))) - (bindings--define-key menu [save-place] + (define-key menu [save-place] (menu-bar-make-toggle-command toggle-save-place-globally save-place-mode "Save Place in Files between Sessions" @@ -1626,7 +1626,7 @@ mail status in mode line")) (set-default 'save-place-mode (not (symbol-value 'save-place-mode)))))) - (bindings--define-key menu [uniquify] + (define-key menu [uniquify] (menu-bar-make-toggle-command toggle-uniquify-buffer-names uniquify-buffer-name-style "Use Directory Names in Buffer Names" @@ -1636,9 +1636,9 @@ mail status in mode line")) (if (not uniquify-buffer-name-style) 'post-forward-angle-brackets)))) - (bindings--define-key menu [edit-options-separator] + (define-key menu [edit-options-separator] menu-bar-separator) - (bindings--define-key menu [cua-mode] + (define-key menu [cua-mode] (menu-bar-make-mm-toggle cua-mode "Cut/Paste with C-x/C-c/C-v (CUA Mode)" @@ -1646,7 +1646,7 @@ mail status in mode line")) (:visible (or (not (boundp 'cua-enable-cua-keys)) cua-enable-cua-keys)))) - (bindings--define-key menu [cua-emulation-mode] + (define-key menu [cua-emulation-mode] (menu-bar-make-mm-toggle cua-mode "CUA Mode (without C-x/C-c/C-v)" @@ -1654,23 +1654,23 @@ mail status in mode line")) (:visible (and (boundp 'cua-enable-cua-keys) (not cua-enable-cua-keys))))) - (bindings--define-key menu [search-options] + (define-key menu [search-options] `(menu-item "Default Search Options" ,menu-bar-search-options-menu)) - (bindings--define-key menu [line-wrapping] + (define-key menu [line-wrapping] `(menu-item "Line Wrapping in This Buffer" ,menu-bar-line-wrapping-menu)) - (bindings--define-key menu [highlight-separator] + (define-key menu [highlight-separator] menu-bar-separator) - (bindings--define-key menu [highlight-paren-mode] + (define-key menu [highlight-paren-mode] (menu-bar-make-mm-toggle show-paren-mode "Highlight Matching Parentheses" "Highlight matching/mismatched parentheses at cursor (Show Paren mode)")) - (bindings--define-key menu [transient-mark-mode] + (define-key menu [transient-mark-mode] (menu-bar-make-mm-toggle transient-mark-mode "Highlight Active Region" @@ -1684,104 +1684,104 @@ mail status in mode line")) (defvar menu-bar-games-menu (let ((menu (make-sparse-keymap "Games"))) - (bindings--define-key menu [zone] + (define-key menu [zone] '(menu-item "Zone Out" zone :help "Play tricks with Emacs display when Emacs is idle")) - (bindings--define-key menu [tetris] + (define-key menu [tetris] '(menu-item "Tetris" tetris :help "Falling blocks game")) - (bindings--define-key menu [solitaire] + (define-key menu [solitaire] '(menu-item "Solitaire" solitaire :help "Get rid of all the stones")) - (bindings--define-key menu [snake] + (define-key menu [snake] '(menu-item "Snake" snake :help "Move snake around avoiding collisions")) - (bindings--define-key menu [pong] + (define-key menu [pong] '(menu-item "Pong" pong :help "Bounce the ball to your opponent")) - (bindings--define-key menu [mult] + (define-key menu [mult] '(menu-item "Multiplication Puzzle" mpuz :help "Exercise brain with multiplication")) - (bindings--define-key menu [life] + (define-key menu [life] '(menu-item "Life" life :help "Watch how John Conway's cellular automaton evolves")) - (bindings--define-key menu [hanoi] + (define-key menu [hanoi] '(menu-item "Towers of Hanoi" hanoi :help "Watch Towers-of-Hanoi puzzle solved by Emacs")) - (bindings--define-key menu [gomoku] + (define-key menu [gomoku] '(menu-item "Gomoku" gomoku :help "Mark 5 contiguous squares (like tic-tac-toe)")) - (bindings--define-key menu [bubbles] + (define-key menu [bubbles] '(menu-item "Bubbles" bubbles :help "Remove all bubbles using the fewest moves")) - (bindings--define-key menu [black-box] + (define-key menu [black-box] '(menu-item "Blackbox" blackbox :help "Find balls in a black box by shooting rays")) - (bindings--define-key menu [adventure] + (define-key menu [adventure] '(menu-item "Adventure" dunnet :help "Dunnet, a text Adventure game for Emacs")) - (bindings--define-key menu [5x5] + (define-key menu [5x5] '(menu-item "5x5" 5x5 :help "Fill in all the squares on a 5x5 board")) menu)) (defvar menu-bar-encryption-decryption-menu (let ((menu (make-sparse-keymap "Encryption/Decryption"))) - (bindings--define-key menu [insert-keys] + (define-key menu [insert-keys] '(menu-item "Insert Keys" epa-insert-keys :help "Insert public keys after the current point")) - (bindings--define-key menu [export-keys] + (define-key menu [export-keys] '(menu-item "Export Keys" epa-export-keys :help "Export public keys to a file")) - (bindings--define-key menu [import-keys-region] + (define-key menu [import-keys-region] '(menu-item "Import Keys from Region" epa-import-keys-region :help "Import public keys from the current region")) - (bindings--define-key menu [import-keys] + (define-key menu [import-keys] '(menu-item "Import Keys from File..." epa-import-keys :help "Import public keys from a file")) - (bindings--define-key menu [list-keys] + (define-key menu [list-keys] '(menu-item "List Keys" epa-list-keys :help "Browse your public keyring")) - (bindings--define-key menu [separator-keys] + (define-key menu [separator-keys] menu-bar-separator) - (bindings--define-key menu [sign-region] + (define-key menu [sign-region] '(menu-item "Sign Region" epa-sign-region :help "Create digital signature of the current region")) - (bindings--define-key menu [verify-region] + (define-key menu [verify-region] '(menu-item "Verify Region" epa-verify-region :help "Verify digital signature of the current region")) - (bindings--define-key menu [encrypt-region] + (define-key menu [encrypt-region] '(menu-item "Encrypt Region" epa-encrypt-region :help "Encrypt the current region")) - (bindings--define-key menu [decrypt-region] + (define-key menu [decrypt-region] '(menu-item "Decrypt Region" epa-decrypt-region :help "Decrypt the current region")) - (bindings--define-key menu [separator-file] + (define-key menu [separator-file] menu-bar-separator) - (bindings--define-key menu [sign-file] + (define-key menu [sign-file] '(menu-item "Sign File..." epa-sign-file :help "Create digital signature of a file")) - (bindings--define-key menu [verify-file] + (define-key menu [verify-file] '(menu-item "Verify File..." epa-verify-file :help "Verify digital signature of a file")) - (bindings--define-key menu [encrypt-file] + (define-key menu [encrypt-file] '(menu-item "Encrypt File..." epa-encrypt-file :help "Encrypt a file")) - (bindings--define-key menu [decrypt-file] + (define-key menu [decrypt-file] '(menu-item "Decrypt File..." epa-decrypt-file :help "Decrypt a file")) @@ -1789,24 +1789,24 @@ mail status in mode line")) (defvar menu-bar-shell-commands-menu (let ((menu (make-sparse-keymap "Shell Commands"))) - (bindings--define-key menu [project-interactive-shell] + (define-key menu [project-interactive-shell] '(menu-item "Run Shell In Project" project-shell :help "Run a subshell interactively, in the current project's root directory")) - (bindings--define-key menu [interactive-shell] + (define-key menu [interactive-shell] '(menu-item "Run Shell" shell :help "Run a subshell interactively")) - (bindings--define-key menu [async-shell-command] + (define-key menu [async-shell-command] '(menu-item "Async Shell Command..." async-shell-command :help "Invoke a shell command asynchronously in background")) - (bindings--define-key menu [shell-on-region] + (define-key menu [shell-on-region] '(menu-item "Shell Command on Region..." shell-command-on-region :enable mark-active :help "Pass marked region to a shell command")) - (bindings--define-key menu [shell] + (define-key menu [shell] '(menu-item "Shell Command..." shell-command :help "Invoke a shell command and catch its output")) @@ -1814,27 +1814,27 @@ mail status in mode line")) (defvar menu-bar-project-menu (let ((menu (make-sparse-keymap "Project"))) - (bindings--define-key menu [project-execute-extended-command] '(menu-item "Execute Extended Command..." project-execute-extended-command :help "Execute an extended command in project root directory")) - (bindings--define-key menu [project-query-replace-regexp] '(menu-item "Query Replace Regexp..." project-query-replace-regexp :help "Interactively replace a regexp in files belonging to current project")) - (bindings--define-key menu [project-or-external-find-regexp] '(menu-item "Find Regexp Including External Roots..." project-or-external-find-regexp :help "Search for a regexp in files belonging to current project or external files")) - (bindings--define-key menu [project-find-regexp] '(menu-item "Find Regexp..." project-find-regexp :help "Search for a regexp in files belonging to current project")) - (bindings--define-key menu [separator-project-search] menu-bar-separator) - (bindings--define-key menu [project-kill-buffers] '(menu-item "Kill Buffers..." project-kill-buffers :help "Kill the buffers belonging to the current project")) - (bindings--define-key menu [project-list-buffers] '(menu-item "List Buffers" project-list-buffers :help "Pop up a window listing all Emacs buffers belonging to current project")) - (bindings--define-key menu [project-switch-to-buffer] '(menu-item "Switch To Buffer..." project-switch-to-buffer :help "Prompt for a buffer belonging to current project, and switch to it")) - (bindings--define-key menu [separator-project-buffers] menu-bar-separator) - (bindings--define-key menu [project-async-shell-command] '(menu-item "Async Shell Command..." project-async-shell-command :help "Invoke a shell command in project root asynchronously in background")) - (bindings--define-key menu [project-shell-command] '(menu-item "Shell Command..." project-shell-command :help "Invoke a shell command in project root and catch its output")) - (bindings--define-key menu [project-eshell] '(menu-item "Run Eshell" project-eshell :help "Run eshell for the current project")) - (bindings--define-key menu [project-shell] '(menu-item "Run Shell" project-shell :help "Run a subshell interactively, in the current project's root directory")) - (bindings--define-key menu [project-compile] '(menu-item "Compile..." project-compile :help "Invoke compiler or Make for current project, view errors")) - (bindings--define-key menu [separator-project-programs] menu-bar-separator) - (bindings--define-key menu [project-switch-project] '(menu-item "Switch Project..." project-switch-project :help "Switch to another project and then run a command")) - (bindings--define-key menu [project-vc-dir] '(menu-item "VC Dir" project-vc-dir :help "Show the VC status of the project repository")) - (bindings--define-key menu [project-dired] '(menu-item "Open Project Root" project-dired :help "Read the root directory of the current project, to operate on its files")) - (bindings--define-key menu [project-find-dir] '(menu-item "Open Directory..." project-find-dir :help "Open existing directory that belongs to current project")) - (bindings--define-key menu [project-or-external-find-file] '(menu-item "Open File Including External Roots..." project-or-external-find-file :help "Open existing file that belongs to current project or its external roots")) - (bindings--define-key menu [project-open-file] '(menu-item "Open File..." project-find-file :help "Open an existing file that belongs to current project")) + (define-key menu [project-execute-extended-command] '(menu-item "Execute Extended Command..." project-execute-extended-command :help "Execute an extended command in project root directory")) + (define-key menu [project-query-replace-regexp] '(menu-item "Query Replace Regexp..." project-query-replace-regexp :help "Interactively replace a regexp in files belonging to current project")) + (define-key menu [project-or-external-find-regexp] '(menu-item "Find Regexp Including External Roots..." project-or-external-find-regexp :help "Search for a regexp in files belonging to current project or external files")) + (define-key menu [project-find-regexp] '(menu-item "Find Regexp..." project-find-regexp :help "Search for a regexp in files belonging to current project")) + (define-key menu [separator-project-search] menu-bar-separator) + (define-key menu [project-kill-buffers] '(menu-item "Kill Buffers..." project-kill-buffers :help "Kill the buffers belonging to the current project")) + (define-key menu [project-list-buffers] '(menu-item "List Buffers" project-list-buffers :help "Pop up a window listing all Emacs buffers belonging to current project")) + (define-key menu [project-switch-to-buffer] '(menu-item "Switch To Buffer..." project-switch-to-buffer :help "Prompt for a buffer belonging to current project, and switch to it")) + (define-key menu [separator-project-buffers] menu-bar-separator) + (define-key menu [project-async-shell-command] '(menu-item "Async Shell Command..." project-async-shell-command :help "Invoke a shell command in project root asynchronously in background")) + (define-key menu [project-shell-command] '(menu-item "Shell Command..." project-shell-command :help "Invoke a shell command in project root and catch its output")) + (define-key menu [project-eshell] '(menu-item "Run Eshell" project-eshell :help "Run eshell for the current project")) + (define-key menu [project-shell] '(menu-item "Run Shell" project-shell :help "Run a subshell interactively, in the current project's root directory")) + (define-key menu [project-compile] '(menu-item "Compile..." project-compile :help "Invoke compiler or Make for current project, view errors")) + (define-key menu [separator-project-programs] menu-bar-separator) + (define-key menu [project-switch-project] '(menu-item "Switch Project..." project-switch-project :help "Switch to another project and then run a command")) + (define-key menu [project-vc-dir] '(menu-item "VC Dir" project-vc-dir :help "Show the VC status of the project repository")) + (define-key menu [project-dired] '(menu-item "Open Project Root" project-dired :help "Read the root directory of the current project, to operate on its files")) + (define-key menu [project-find-dir] '(menu-item "Open Directory..." project-find-dir :help "Open existing directory that belongs to current project")) + (define-key menu [project-or-external-find-file] '(menu-item "Open File Including External Roots..." project-or-external-find-file :help "Open existing file that belongs to current project or its external roots")) + (define-key menu [project-open-file] '(menu-item "Open File..." project-find-file :help "Open an existing file that belongs to current project")) menu)) (defvar menu-bar-project-item @@ -1848,112 +1848,112 @@ mail status in mode line")) (defvar menu-bar-tools-menu (let ((menu (make-sparse-keymap "Tools"))) - (bindings--define-key menu [games] + (define-key menu [games] `(menu-item "Games" ,menu-bar-games-menu)) - (bindings--define-key menu [separator-games] + (define-key menu [separator-games] menu-bar-separator) - (bindings--define-key menu [encryption-decryption] + (define-key menu [encryption-decryption] `(menu-item "Encryption/Decryption" ,menu-bar-encryption-decryption-menu)) - (bindings--define-key menu [separator-encryption-decryption] + (define-key menu [separator-encryption-decryption] menu-bar-separator) - (bindings--define-key menu [simple-calculator] + (define-key menu [simple-calculator] '(menu-item "Simple Calculator" calculator :help "Invoke the Emacs built-in quick calculator")) - (bindings--define-key menu [calc] + (define-key menu [calc] '(menu-item "Programmable Calculator" calc :help "Invoke the Emacs built-in full scientific calculator")) - (bindings--define-key menu [calendar] + (define-key menu [calendar] '(menu-item "Calendar" calendar :help "Invoke the Emacs built-in calendar")) - (bindings--define-key menu [separator-net] + (define-key menu [separator-net] menu-bar-separator) - (bindings--define-key menu [browse-web] + (define-key menu [browse-web] '(menu-item "Browse the Web..." browse-web)) - (bindings--define-key menu [directory-search] + (define-key menu [directory-search] '(menu-item "Directory Servers" eudc-tools-menu)) - (bindings--define-key menu [compose-mail] + (define-key menu [compose-mail] '(menu-item "Compose New Mail" compose-mail :visible (and mail-user-agent (not (eq mail-user-agent 'ignore))) :help "Start writing a new mail message")) - (bindings--define-key menu [rmail] + (define-key menu [rmail] '(menu-item "Read Mail" menu-bar-read-mail :visible (and read-mail-command (not (eq read-mail-command 'ignore))) :help "Read your mail")) - (bindings--define-key menu [gnus] + (define-key menu [gnus] '(menu-item "Read Net News" gnus :help "Read network news groups")) - (bindings--define-key menu [separator-vc] + (define-key menu [separator-vc] menu-bar-separator) - (bindings--define-key menu [vc] nil) ;Create the place for the VC menu. + (define-key menu [vc] nil) ;Create the place for the VC menu. - (bindings--define-key menu [separator-compare] + (define-key menu [separator-compare] menu-bar-separator) - (bindings--define-key menu [epatch] + (define-key menu [epatch] '(menu-item "Apply Patch" menu-bar-epatch-menu)) - (bindings--define-key menu [ediff-merge] + (define-key menu [ediff-merge] '(menu-item "Merge" menu-bar-ediff-merge-menu)) - (bindings--define-key menu [compare] + (define-key menu [compare] '(menu-item "Compare (Ediff)" menu-bar-ediff-menu)) - (bindings--define-key menu [separator-spell] + (define-key menu [separator-spell] menu-bar-separator) - (bindings--define-key menu [spell] + (define-key menu [spell] '(menu-item "Spell Checking" ispell-menu-map)) - (bindings--define-key menu [separator-prog] + (define-key menu [separator-prog] menu-bar-separator) - (bindings--define-key menu [semantic] + (define-key menu [semantic] '(menu-item "Source Code Parsers (Semantic)" semantic-mode :help "Toggle automatic parsing in source code buffers (Semantic mode)" :button (:toggle . (bound-and-true-p semantic-mode)))) - (bindings--define-key menu [eglot] + (define-key menu [eglot] '(menu-item "Language Server Support (Eglot)" eglot :help "Start language server suitable for this buffer's major-mode")) - (bindings--define-key menu [project] + (define-key menu [project] menu-bar-project-item) - (bindings--define-key menu [ede] + (define-key menu [ede] '(menu-item "Project Support (EDE)" global-ede-mode :help "Toggle the Emacs Development Environment (Global EDE mode)" :button (:toggle . (bound-and-true-p global-ede-mode)))) - (bindings--define-key menu [gdb] + (define-key menu [gdb] '(menu-item "Debugger (GDB)..." gdb :help "Debug a program from within Emacs with GDB")) - (bindings--define-key menu [project-compile] + (define-key menu [project-compile] '(menu-item "Compile Project..." project-compile :help "Invoke compiler or Make for current project, view errors")) - (bindings--define-key menu [compile] + (define-key menu [compile] '(menu-item "Compile..." compile :help "Invoke compiler or Make in current buffer's directory, view errors")) - (bindings--define-key menu [shell-commands] + (define-key menu [shell-commands] `(menu-item "Shell Commands" ,menu-bar-shell-commands-menu)) - (bindings--define-key menu [rgrep] + (define-key menu [rgrep] '(menu-item "Recursive Grep..." rgrep :help "Interactively ask for parameters and search recursively")) - (bindings--define-key menu [grep] + (define-key menu [grep] '(menu-item "Search Files (Grep)..." grep :help "Search files for strings or regexps (with Grep)")) menu)) @@ -1963,58 +1963,58 @@ mail status in mode line")) (defvar menu-bar-describe-menu (let ((menu (make-sparse-keymap "Describe"))) - (bindings--define-key menu [mule-diag] + (define-key menu [mule-diag] '(menu-item "Show All of Mule Status" mule-diag :help "Display multilingual environment settings")) - (bindings--define-key menu [describe-coding-system-briefly] + (define-key menu [describe-coding-system-briefly] '(menu-item "Describe Coding System (Briefly)" describe-current-coding-system-briefly)) - (bindings--define-key menu [describe-coding-system] + (define-key menu [describe-coding-system] '(menu-item "Describe Coding System..." describe-coding-system)) - (bindings--define-key menu [describe-input-method] + (define-key menu [describe-input-method] '(menu-item "Describe Input Method..." describe-input-method :help "Keyboard layout for specific input method")) - (bindings--define-key menu [describe-language-environment] + (define-key menu [describe-language-environment] `(menu-item "Describe Language Environment" ,describe-language-environment-map)) - (bindings--define-key menu [separator-desc-mule] + (define-key menu [separator-desc-mule] menu-bar-separator) - (bindings--define-key menu [list-keybindings] + (define-key menu [list-keybindings] '(menu-item "List Key Bindings" describe-bindings :help "Display all current key bindings (keyboard shortcuts)")) - (bindings--define-key menu [list-recent-keystrokes] + (define-key menu [list-recent-keystrokes] '(menu-item "Show Recent Inputs" view-lossage :help "Display last few input events and the commands \ they ran")) - (bindings--define-key menu [describe-current-display-table] + (define-key menu [describe-current-display-table] '(menu-item "Describe Display Table" describe-current-display-table :help "Describe the current display table")) - (bindings--define-key menu [describe-package] + (define-key menu [describe-package] '(menu-item "Describe Package..." describe-package :help "Display documentation of a Lisp package")) - (bindings--define-key menu [describe-face] + (define-key menu [describe-face] '(menu-item "Describe Face..." describe-face :help "Display the properties of a face")) - (bindings--define-key menu [describe-variable] + (define-key menu [describe-variable] '(menu-item "Describe Variable..." describe-variable :help "Display documentation of variable/option")) - (bindings--define-key menu [describe-function] + (define-key menu [describe-function] '(menu-item "Describe Function..." describe-function :help "Display documentation of function/command")) - (bindings--define-key menu [describe-command] + (define-key menu [describe-command] '(menu-item "Describe Command..." describe-command :help "Display documentation of command")) - (bindings--define-key menu [shortdoc-display-group] + (define-key menu [shortdoc-display-group] '(menu-item "Function Group Overview..." shortdoc-display-group :help "Display a function overview for a specific topic")) - (bindings--define-key menu [describe-key-1] + (define-key menu [describe-key-1] '(menu-item "Describe Key or Mouse Operation..." describe-key ;; Users typically don't identify keys and menu items... :help "Display documentation of command bound to a \ key, a click, or a menu-item")) - (bindings--define-key menu [describe-mode] + (define-key menu [describe-mode] '(menu-item "Describe Buffer Modes" describe-mode :help "Describe this buffer's major and minor mode")) menu)) @@ -2059,40 +2059,40 @@ key, a click, or a menu-item")) (defvar menu-bar-search-documentation-menu (let ((menu (make-sparse-keymap "Search Documentation"))) - (bindings--define-key menu [search-documentation-strings] + (define-key menu [search-documentation-strings] '(menu-item "Search Documentation Strings..." apropos-documentation :help "Find functions and variables whose doc strings match a regexp")) - (bindings--define-key menu [find-any-object-by-name] + (define-key menu [find-any-object-by-name] '(menu-item "Find Any Object by Name..." apropos :help "Find symbols of any kind whose names match a regexp")) - (bindings--define-key menu [find-option-by-value] + (define-key menu [find-option-by-value] '(menu-item "Find Options by Value..." apropos-value :help "Find variables whose values match a regexp")) - (bindings--define-key menu [find-options-by-name] + (define-key menu [find-options-by-name] '(menu-item "Find Options by Name..." apropos-user-option :help "Find user options whose names match a regexp")) - (bindings--define-key menu [find-commands-by-name] + (define-key menu [find-commands-by-name] '(menu-item "Find Commands by Name..." apropos-command :help "Find commands whose names match a regexp")) - (bindings--define-key menu [sep1] + (define-key menu [sep1] menu-bar-separator) - (bindings--define-key menu [lookup-symbol-in-manual] + (define-key menu [lookup-symbol-in-manual] '(menu-item "Look Up Symbol in Manual..." info-lookup-symbol :help "Display manual section that describes a symbol")) - (bindings--define-key menu [lookup-command-in-manual] + (define-key menu [lookup-command-in-manual] '(menu-item "Look Up Command in User Manual..." Info-goto-emacs-command-node :help "Display manual section that describes a command")) - (bindings--define-key menu [lookup-key-in-manual] + (define-key menu [lookup-key-in-manual] '(menu-item "Look Up Key in User Manual..." Info-goto-emacs-key-command-node :help "Display manual section that describes a key")) - (bindings--define-key menu [lookup-subject-in-elisp-manual] + (define-key menu [lookup-subject-in-elisp-manual] '(menu-item "Look Up Subject in ELisp Manual..." elisp-index-search :help "Find description of a subject in Emacs Lisp manual")) - (bindings--define-key menu [lookup-subject-in-emacs-manual] + (define-key menu [lookup-subject-in-emacs-manual] '(menu-item "Look Up Subject in User Manual..." emacs-index-search :help "Find description of a subject in Emacs User manual")) - (bindings--define-key menu [emacs-terminology] + (define-key menu [emacs-terminology] '(menu-item "Emacs Terminology" search-emacs-glossary :help "Display the Glossary section of the Emacs manual")) menu)) @@ -2100,24 +2100,24 @@ key, a click, or a menu-item")) (defvar menu-bar-manuals-menu (let ((menu (make-sparse-keymap "More Manuals"))) - (bindings--define-key menu [man] + (define-key menu [man] '(menu-item "Read Man Page..." manual-entry :help "Man-page docs for external commands and libraries")) - (bindings--define-key menu [sep2] + (define-key menu [sep2] menu-bar-separator) - (bindings--define-key menu [order-emacs-manuals] + (define-key menu [order-emacs-manuals] '(menu-item "Ordering Manuals" view-order-manuals :help "How to order manuals from the Free Software Foundation")) - (bindings--define-key menu [lookup-subject-in-all-manuals] + (define-key menu [lookup-subject-in-all-manuals] '(menu-item "Lookup Subject in all Manuals..." info-apropos :help "Find description of a subject in all installed manuals")) - (bindings--define-key menu [other-manuals] + (define-key menu [other-manuals] '(menu-item "All Other Manuals (Info)" Info-directory :help "Read any of the installed manuals")) - (bindings--define-key menu [emacs-lisp-reference] + (define-key menu [emacs-lisp-reference] '(menu-item "Emacs Lisp Reference" menu-bar-read-lispref :help "Read the Emacs Lisp Reference manual")) - (bindings--define-key menu [emacs-lisp-intro] + (define-key menu [emacs-lisp-intro] '(menu-item "Introduction to Emacs Lisp" menu-bar-read-lispintro :help "Read the Introduction to Emacs Lisp Programming")) menu)) @@ -2129,66 +2129,66 @@ key, a click, or a menu-item")) (defvar menu-bar-help-menu (let ((menu (make-sparse-keymap "Help"))) - (bindings--define-key menu [about-gnu-project] + (define-key menu [about-gnu-project] '(menu-item "About GNU" describe-gnu-project :help "About the GNU System, GNU Project, and GNU/Linux")) - (bindings--define-key menu [about-emacs] + (define-key menu [about-emacs] '(menu-item "About Emacs" about-emacs :help "Display version number, copyright info, and basic help")) - (bindings--define-key menu [sep4] + (define-key menu [sep4] menu-bar-separator) - (bindings--define-key menu [describe-no-warranty] + (define-key menu [describe-no-warranty] '(menu-item "(Non)Warranty" describe-no-warranty :help "Explain that Emacs has NO WARRANTY")) - (bindings--define-key menu [describe-copying] + (define-key menu [describe-copying] '(menu-item "Copying Conditions" describe-copying :help "Show the Emacs license (GPL)")) - (bindings--define-key menu [getting-new-versions] + (define-key menu [getting-new-versions] '(menu-item "Getting New Versions" describe-distribution :help "How to get the latest version of Emacs")) - (bindings--define-key menu [sep2] + (define-key menu [sep2] menu-bar-separator) - (bindings--define-key menu [external-packages] + (define-key menu [external-packages] '(menu-item "Finding Extra Packages" view-external-packages :help "How to get more Lisp packages for use in Emacs")) - (bindings--define-key menu [find-emacs-packages] + (define-key menu [find-emacs-packages] '(menu-item "Search Built-in Packages" finder-by-keyword :help "Find built-in packages and features by keyword")) - (bindings--define-key menu [more-manuals] + (define-key menu [more-manuals] `(menu-item "More Manuals" ,menu-bar-manuals-menu)) - (bindings--define-key menu [emacs-manual] + (define-key menu [emacs-manual] '(menu-item "Read the Emacs Manual" info-emacs-manual :help "Full documentation of Emacs features")) - (bindings--define-key menu [describe] + (define-key menu [describe] `(menu-item "Describe" ,menu-bar-describe-menu)) - (bindings--define-key menu [search-documentation] + (define-key menu [search-documentation] `(menu-item "Search Documentation" ,menu-bar-search-documentation-menu)) - (bindings--define-key menu [sep1] + (define-key menu [sep1] menu-bar-separator) - (bindings--define-key menu [emacs-psychotherapist] + (define-key menu [emacs-psychotherapist] '(menu-item "Emacs Psychotherapist" doctor :help "Our doctor will help you feel better")) - (bindings--define-key menu [send-emacs-bug-report] + (define-key menu [send-emacs-bug-report] '(menu-item "Send Bug Report..." report-emacs-bug :help "Send e-mail to Emacs maintainers")) - (bindings--define-key menu [emacs-manual-bug] + (define-key menu [emacs-manual-bug] '(menu-item "How to Report a Bug" info-emacs-bug :help "Read about how to report an Emacs bug")) - (bindings--define-key menu [emacs-known-problems] + (define-key menu [emacs-known-problems] '(menu-item "Emacs Known Problems" view-emacs-problems :help "Read about known problems with Emacs")) - (bindings--define-key menu [emacs-news] + (define-key menu [emacs-news] '(menu-item "Emacs News" view-emacs-news :help "New features of this version")) - (bindings--define-key menu [emacs-faq] + (define-key menu [emacs-faq] '(menu-item "Emacs FAQ" view-emacs-FAQ :help "Frequently asked (and answered) questions about Emacs")) - (bindings--define-key menu [emacs-tutorial-language-specific] + (define-key menu [emacs-tutorial-language-specific] '(menu-item "Emacs Tutorial (choose language)..." help-with-tutorial-spec-language :help "Learn how to use Emacs (choose a language)")) - (bindings--define-key menu [emacs-tutorial] + (define-key menu [emacs-tutorial] '(menu-item "Emacs Tutorial" help-with-tutorial :help "Learn how to use Emacs")) @@ -2196,21 +2196,21 @@ key, a click, or a menu-item")) ;; FIXME? There already is an "About Emacs" (sans ...) entry in the Help menu. (and (featurep 'ns) (not (eq system-type 'darwin)) - (bindings--define-key menu [info-panel] + (define-key menu [info-panel] '(menu-item "About Emacs..." ns-do-emacs-info-panel))) menu)) -(bindings--define-key global-map [menu-bar tools] +(define-key global-map [menu-bar tools] (cons "Tools" menu-bar-tools-menu)) -(bindings--define-key global-map [menu-bar buffer] +(define-key global-map [menu-bar buffer] (cons "Buffers" global-buffers-menu-map)) -(bindings--define-key global-map [menu-bar options] +(define-key global-map [menu-bar options] (cons "Options" menu-bar-options-menu)) -(bindings--define-key global-map [menu-bar edit] +(define-key global-map [menu-bar edit] (cons "Edit" menu-bar-edit-menu)) -(bindings--define-key global-map [menu-bar file] +(define-key global-map [menu-bar file] (cons "File" menu-bar-file-menu)) -(bindings--define-key global-map [menu-bar help-menu] +(define-key global-map [menu-bar help-menu] (cons (purecopy "Help") menu-bar-help-menu)) (define-key global-map [menu-bar mouse-1] 'menu-bar-open-mouse) @@ -2576,38 +2576,38 @@ It must accept a buffer as its only required argument.") ;; This shouldn't be necessary, but there's a funny ;; bug in keymap.c that I don't understand yet. -stef minibuffer-local-completion-map)) - (bindings--define-key map [menu-bar minibuf] + (define-key map [menu-bar minibuf] (cons "Minibuf" (make-sparse-keymap "Minibuf")))) (let ((map minibuffer-local-completion-map)) - (bindings--define-key map [menu-bar minibuf ?\?] + (define-key map [menu-bar minibuf ?\?] '(menu-item "List Completions" minibuffer-completion-help :help "Display all possible completions")) - (bindings--define-key map [menu-bar minibuf space] + (define-key map [menu-bar minibuf space] '(menu-item "Complete Word" minibuffer-complete-word :help "Complete at most one word")) - (bindings--define-key map [menu-bar minibuf tab] + (define-key map [menu-bar minibuf tab] '(menu-item "Complete" minibuffer-complete :help "Complete as far as possible"))) (let ((map minibuffer-local-map)) - (bindings--define-key map [menu-bar minibuf quit] + (define-key map [menu-bar minibuf quit] '(menu-item "Quit" abort-recursive-edit :help "Abort input and exit minibuffer")) - (bindings--define-key map [menu-bar minibuf return] + (define-key map [menu-bar minibuf return] '(menu-item "Enter" exit-minibuffer :key-sequence "\r" :help "Terminate input and exit minibuffer")) - (bindings--define-key map [menu-bar minibuf isearch-forward] + (define-key map [menu-bar minibuf isearch-forward] '(menu-item "Isearch History Forward" isearch-forward :help "Incrementally search minibuffer history forward")) - (bindings--define-key map [menu-bar minibuf isearch-backward] + (define-key map [menu-bar minibuf isearch-backward] '(menu-item "Isearch History Backward" isearch-backward :help "Incrementally search minibuffer history backward")) - (bindings--define-key map [menu-bar minibuf next] + (define-key map [menu-bar minibuf next] '(menu-item "Next History Item" next-history-element :help "Put next minibuffer history element in the minibuffer")) - (bindings--define-key map [menu-bar minibuf previous] + (define-key map [menu-bar minibuf previous] '(menu-item "Previous History Item" previous-history-element :help "Put previous minibuffer history element in the minibuffer"))) diff --git a/lisp/replace.el b/lisp/replace.el index 2285b19b519..51b8799ab76 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1315,7 +1315,7 @@ a previously found match." (define-key map "r" 'occur-rename-buffer) (define-key map "c" 'clone-buffer) (define-key map "\C-c\C-f" 'next-error-follow-minor-mode) - (bindings--define-key map [menu-bar occur] (cons "Occur" occur-menu-map)) + (define-key map [menu-bar occur] (cons "Occur" occur-menu-map)) map) "Keymap for `occur-mode'.") @@ -1368,7 +1368,7 @@ Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it. (define-key map "\C-c\C-c" 'occur-cease-edit) (define-key map "\C-o" 'occur-mode-display-occurrence) (define-key map "\C-c\C-f" 'next-error-follow-minor-mode) - (bindings--define-key map [menu-bar occur] (cons "Occur" occur-menu-map)) + (define-key map [menu-bar occur] (cons "Occur" occur-menu-map)) map) "Keymap for `occur-edit-mode'.") diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index 2188aa67e54..21a8c751252 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -830,15 +830,15 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") (setq menu-bar-final-items '(buffer services hide-app quit)) ;; If running under GNUstep, "Help" is moved and renamed "Info". - (bindings--define-key global-map [menu-bar help-menu] + (define-key global-map [menu-bar help-menu] (cons "Info" menu-bar-help-menu)) - (bindings--define-key global-map [menu-bar quit] + (define-key global-map [menu-bar quit] '(menu-item "Quit" save-buffers-kill-emacs :help "Save unsaved buffers, then exit")) - (bindings--define-key global-map [menu-bar hide-app] + (define-key global-map [menu-bar hide-app] '(menu-item "Hide" ns-do-hide-emacs :help "Hide Emacs")) - (bindings--define-key global-map [menu-bar services] + (define-key global-map [menu-bar services] (cons "Services" (make-sparse-keymap "Services"))))) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 8f212e96933..8fd1aa90b31 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -940,76 +940,76 @@ In the latter case, VC mode is deactivated for this buffer." (let ((map (make-sparse-keymap "Version Control"))) ;;(define-key map [show-files] ;; '("Show Files under VC" . (vc-directory t))) - (bindings--define-key map [vc-retrieve-tag] + (define-key map [vc-retrieve-tag] '(menu-item "Retrieve Tag" vc-retrieve-tag :help "Retrieve tagged version or branch")) - (bindings--define-key map [vc-create-tag] + (define-key map [vc-create-tag] '(menu-item "Create Tag" vc-create-tag :help "Create version tag")) - (bindings--define-key map [vc-print-branch-log] + (define-key map [vc-print-branch-log] '(menu-item "Show Branch History..." vc-print-branch-log :help "List the change log for another branch")) - (bindings--define-key map [vc-switch-branch] + (define-key map [vc-switch-branch] '(menu-item "Switch Branch..." vc-switch-branch :help "Switch to another branch")) - (bindings--define-key map [vc-create-branch] + (define-key map [vc-create-branch] '(menu-item "Create Branch..." vc-create-branch :help "Make a new branch")) - (bindings--define-key map [separator1] menu-bar-separator) - (bindings--define-key map [vc-annotate] + (define-key map [separator1] menu-bar-separator) + (define-key map [vc-annotate] '(menu-item "Annotate" vc-annotate :help "Display the edit history of the current file using colors")) - (bindings--define-key map [vc-rename-file] + (define-key map [vc-rename-file] '(menu-item "Rename File" vc-rename-file :help "Rename file")) - (bindings--define-key map [vc-revision-other-window] + (define-key map [vc-revision-other-window] '(menu-item "Show Other Version" vc-revision-other-window :help "Visit another version of the current file in another window")) - (bindings--define-key map [vc-diff] + (define-key map [vc-diff] '(menu-item "Compare with Base Version" vc-diff :help "Compare file set with the base version")) - (bindings--define-key map [vc-root-diff] + (define-key map [vc-root-diff] '(menu-item "Compare Tree with Base Version" vc-root-diff :help "Compare current tree with the base version")) - (bindings--define-key map [vc-update-change-log] + (define-key map [vc-update-change-log] '(menu-item "Update ChangeLog" vc-update-change-log :help "Find change log file and add entries from recent version control logs")) - (bindings--define-key map [vc-log-out] + (define-key map [vc-log-out] '(menu-item "Show Outgoing Log" vc-log-outgoing :help "Show a log of changes that will be sent with a push operation")) - (bindings--define-key map [vc-log-in] + (define-key map [vc-log-in] '(menu-item "Show Incoming Log" vc-log-incoming :help "Show a log of changes that will be received with a pull operation")) - (bindings--define-key map [vc-print-log] + (define-key map [vc-print-log] '(menu-item "Show History" vc-print-log :help "List the change log of the current file set in a window")) - (bindings--define-key map [vc-print-root-log] + (define-key map [vc-print-root-log] '(menu-item "Show Top of the Tree History " vc-print-root-log :help "List the change log for the current tree in a window")) - (bindings--define-key map [separator2] menu-bar-separator) - (bindings--define-key map [vc-insert-header] + (define-key map [separator2] menu-bar-separator) + (define-key map [vc-insert-header] '(menu-item "Insert Header" vc-insert-headers :help "Insert headers into a file for use with a version control system.")) - (bindings--define-key map [vc-revert] + (define-key map [vc-revert] '(menu-item "Revert to Base Version" vc-revert :help "Revert working copies of the selected file set to their repository contents")) ;; TODO Only :enable if (vc-find-backend-function backend 'push) - (bindings--define-key map [vc-push] + (define-key map [vc-push] '(menu-item "Push Changes" vc-push :help "Push the current branch's changes")) - (bindings--define-key map [vc-update] + (define-key map [vc-update] '(menu-item "Update to Latest Version" vc-update :help "Update the current fileset's files to their tip revisions")) - (bindings--define-key map [vc-next-action] + (define-key map [vc-next-action] '(menu-item "Check In/Out" vc-next-action :help "Do the next logical version control operation on the current fileset")) - (bindings--define-key map [vc-register] + (define-key map [vc-register] '(menu-item "Register" vc-register :help "Register file set into a version control system")) - (bindings--define-key map [vc-ignore] + (define-key map [vc-ignore] '(menu-item "Ignore File..." vc-ignore :help "Ignore a file under current version control system")) - (bindings--define-key map [vc-dir-root] + (define-key map [vc-dir-root] '(menu-item "VC Dir" vc-dir-root :help "Show the VC status of the repository")) map)) commit 5b471384d1805bfb9e78314f8cb1f4d09aa378f7 Author: Pip Cet Date: Wed Aug 21 19:13:23 2024 +0000 Purecopy removal: Lisp code * lisp/emacs-lisp/bytecomp.el (byte-compile-cond-jump-table): Don't request our hash tables be purecopied. Adjust comment. * lisp/progmodes/elisp-mode.el (elisp--local-variables-completion-table): Use 'defconst' rather than 'defvar' now the purespace problem is gone * lisp/rfn-eshadow.el (file-name-shadow-properties): Remove obsolete comment. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index f058fc48cc7..11f2ffa6063 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -4640,13 +4640,12 @@ Return (TAIL VAR TEST CASES), where: cases)))) (setq jump-table (make-hash-table :test test - :purecopy t :size nvalues))) (setq default-tag (byte-compile-make-tag)) ;; The structure of byte-switch code: ;; ;; varref var - ;; constant #s(hash-table purecopy t data (val1 (TAG1) val2 (TAG2))) + ;; constant #s(hash-table data (val1 (TAG1) val2 (TAG2))) ;; switch ;; goto DEFAULT-TAG ;; TAG1 diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 2b6d9d2b8bb..c24a1f4672b 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -489,11 +489,7 @@ use of `macroexpand-all' as a way to find the \"underlying raw code\".") var)) vars)))))) -(defvar elisp--local-variables-completion-table - ;; Use `defvar' rather than `defconst' since defconst would purecopy this - ;; value, which would doubly fail: it would fail because purecopy can't - ;; handle the recursive bytecode object, and it would fail because it would - ;; move `lastpos' and `lastvars' to pure space where they'd be immutable! +(defconst elisp--local-variables-completion-table (let ((lastpos nil) (lastvars nil)) (letrec ((hookfun (lambda () (setq lastpos nil) diff --git a/lisp/rfn-eshadow.el b/lisp/rfn-eshadow.el index 5cf483bf0b1..c1e0e3da22b 100644 --- a/lisp/rfn-eshadow.el +++ b/lisp/rfn-eshadow.el @@ -92,7 +92,6 @@ (sexp :tag "Value"))))) (defcustom file-name-shadow-properties - ;; FIXME: should we purecopy this? '(face file-name-shadow field shadow) "Properties given to the `shadowed' part of a filename in the minibuffer. Only used when `file-name-shadow-mode' is active. commit a54ff8c18fa9b97b737d0de1a5e160b454ac294d Author: Pip Cet Date: Wed Aug 21 08:50:02 2024 +0000 Unexec removal: Build system * configure.ac (CYGWIN_OBJ): Remove comment. * src/Makefile.in (PAXCTL, SETFATTR, PAXCTL_dumped, PAXCTL_notdumped): Remove definitions. (emacs$(EXEEXT), temacs$(EXEEXT), bootstrap-emacs$(EXEEXT)): * src/deps.mk: Remove 'unexec'-specific code. diff --git a/configure.ac b/configure.ac index 425e9cc4663..b320c4978d6 100644 --- a/configure.ac +++ b/configure.ac @@ -7207,7 +7207,6 @@ AC_SUBST([RALLOC_OBJ]) if test "$opsys" = "cygwin"; then CYGWIN_OBJ="cygw32.o" - ## Cygwin differs because of its unexec(). PRE_ALLOC_OBJ= POST_ALLOC_OBJ=lastfile.o elif test "$opsys" = "mingw32"; then diff --git a/src/Makefile.in b/src/Makefile.in index 03c2c8d6e0a..51352dd6d74 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -126,16 +126,6 @@ LD_SWITCH_SYSTEM_TEMACS=@LD_SWITCH_SYSTEM_TEMACS@ ## Flags to pass to ld only for temacs. TEMACS_LDFLAGS = $(LD_SWITCH_SYSTEM) $(LD_SWITCH_SYSTEM_TEMACS) -## If needed, the names of the paxctl and setfattr programs. -## On grsecurity/PaX systems, unexec will fail due to a gap between -## the bss section and the heap. Older versions need paxctl to work -## around this, newer ones setfattr. See Bug#11398 and Bug#16343. -PAXCTL = @PAXCTL@ -SETFATTR = @SETFATTR@ -## Commands to set PaX flags on dumped and not-dumped instances of Emacs. -PAXCTL_dumped = @PAXCTL_dumped@ -PAXCTL_notdumped = @PAXCTL_notdumped@ - ## Some systems define this to request special libraries. LIBS_SYSTEM=@LIBS_SYSTEM@ @@ -652,15 +642,7 @@ emacs$(EXEEXT): temacs$(EXEEXT) \ ifeq ($(SYSTEM_TYPE),cygwin) find ${top_builddir} -name '*.eln' | rebase -v -O -T - endif -ifeq ($(DUMPING),unexec) - LC_ALL=C $(RUN_TEMACS) -batch $(BUILD_DETAILS) -l loadup --temacs=dump - ifneq ($(PAXCTL_dumped),) - $(PAXCTL_dumped) emacs$(EXEEXT) - endif - cp -f $@ bootstrap-emacs$(EXEEXT) -else rm -f $@ && cp -f temacs$(EXEEXT) $@ -endif ## On Haiku, also produce a binary named Emacs with the appropriate ## icon set. @@ -749,11 +731,6 @@ endif endif $(AM_V_at)mv $@.tmp $@ $(MKDIR_P) $(etc) -ifeq ($(DUMPING),unexec) - ifneq ($(PAXCTL_notdumped),) - $(PAXCTL_notdumped) $@ - endif -endif ifeq ($(XCONFIGURE),android) ## The Android package internally links to a shared library named @@ -989,21 +966,11 @@ endif bootstrap-emacs$(EXEEXT): temacs$(EXEEXT) $(MAKE) -C ../lisp update-subdirs -ifeq ($(DUMPING),unexec) - $(RUN_TEMACS) --batch $(BUILD_DETAILS) -l loadup --temacs=bootstrap - ifneq ($(PAXCTL_dumped),) - $(PAXCTL_dumped) emacs$(EXEEXT) - endif - mv -f emacs$(EXEEXT) bootstrap-emacs$(EXEEXT) - @: Compile some files earlier to speed up further compilation. - $(MAKE) -C ../lisp compile-first EMACS="$(bootstrap_exe)" -else @: In the pdumper case, make compile-first after the dump cp -f temacs$(EXEEXT) bootstrap-emacs$(EXEEXT) ifeq ($(DO_CODESIGN),yes) codesign -s - -f bootstrap-emacs$(EXEEXT) endif -endif ifeq ($(DUMPING),pdumper) $(bootstrap_pdmp): bootstrap-emacs$(EXEEXT) diff --git a/src/deps.mk b/src/deps.mk index decb6670473..0ba43a014f8 100644 --- a/src/deps.mk +++ b/src/deps.mk @@ -92,7 +92,7 @@ editfns.o: editfns.c window.h buffer.h systime.h $(INTERVALS_H) character.h \ emacs.o: emacs.c commands.h systty.h syssignal.h blockinput.h process.h \ termhooks.h buffer.h atimer.h systime.h $(INTERVALS_H) lisp.h $(config_h) \ globals.h ../lib/unistd.h window.h dispextern.h keyboard.h keymap.h \ - frame.h coding.h gnutls.h msdos.h dosfns.h unexec.h + frame.h coding.h gnutls.h msdos.h dosfns.h fileio.o: fileio.c window.h buffer.h systime.h $(INTERVALS_H) character.h \ coding.h msdos.h blockinput.h atimer.h lisp.h $(config_h) frame.h \ commands.h globals.h ../lib/unistd.h @@ -202,14 +202,6 @@ terminfo.o: terminfo.c tparam.h lisp.h globals.h $(config_h) tparam.o: tparam.c tparam.h lisp.h $(config_h) undo.o: undo.c buffer.h commands.h window.h dispextern.h msdos.h \ lisp.h globals.h $(config_h) -unexaix.o: unexaix.c lisp.h unexec.h $(config_h) -unexcw.o: unexcw.c lisp.h unexec.h $(config_h) -unexcoff.o: unexcoff.c lisp.h unexec.h $(config_h) -unexelf.o: unexelf.c unexec.h ../lib/unistd.h $(config_h) -unexhp9k800.o: unexhp9k800.c unexec.h $(config_h) -unexmacosx.o: unexmacosx.c unexec.h $(config_h) -unexsol.o: unexsol.c lisp.h unexec.h $(config_h) -unexw32.o: unexw32.c unexec.h $(config_h) w16select.o: w16select.c dispextern.h frame.h blockinput.h atimer.h systime.h \ msdos.h buffer.h charset.h coding.h composite.h lisp.h $(config_h) widget.o: widget.c xterm.h frame.h dispextern.h widgetprv.h \ commit 0e37b11e659dd58c520d557820b006a8d03c71e6 Author: Pip Cet Date: Wed Aug 21 08:45:13 2024 +0000 Unexec removal: Documentation adjustments * doc/lispref/internals.texi (Building Emacs): * doc/lispref/os.texi (Command-Line Arguments): Remove documentation for 'unexec'-specific code and arguments. * etc/PROBLEMS: Remove unexec-specific problems. diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 00a3704fcac..fb7fe9aad76 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -76,23 +76,6 @@ Like @samp{pdump}, but used while @dfn{bootstrapping} Emacs, when no previous Emacs binary and no @file{*.elc} byte-compiled Lisp files are available. The produced dump file is usually named @file{bootstrap-emacs.pdmp} in this case. - -@item dump -@cindex unexec -This method causes @command{temacs} to dump out an executable program, -called @file{emacs}, which has all the standard Lisp files already -preloaded into it. (The @samp{-batch} argument prevents -@command{temacs} from trying to initialize any of its data on the -terminal, so that the tables of terminal information are empty in the -dumped Emacs.) This method is also known as @dfn{unexec}, because it -produces a program file from a running process, and thus is in some -sense the opposite of executing a program to start a process. -Although this method was the way that Emacs traditionally saved its -state, it is now deprecated. - -@item bootstrap -Like @samp{dump}, but used when bootstrapping Emacs with the -@code{unexec} method. @end table @cindex preloaded Lisp files @@ -227,17 +210,6 @@ that problem, you can put functions on the Emacs. @end defun -@defun dump-emacs to-file from-file -@cindex unexec -This function dumps the current state of Emacs into an executable file -@var{to-file}, using the @code{unexec} method. It takes symbols from -@var{from-file} (this is normally the executable file @file{temacs}). - -This function cannot be used in an Emacs that was already dumped. -This function is deprecated, and by default Emacs is built without -@code{unexec} support so this function is not available. -@end defun - @defun pdumper-stats If the current Emacs session restored its state from a dump file, this function returns information about the dump file and the diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index be26fb5063c..8f70ff30645 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -590,10 +590,10 @@ displays the startup messages. The value of this variable is @code{t} once the command line has been processed. -If you redump Emacs by calling @code{dump-emacs} (@pxref{Building -Emacs}), you may wish to set this variable to @code{nil} first in -order to cause the new dumped Emacs to process its new command-line -arguments. +If you redump Emacs by calling @code{dump-emacs-portable} +(@pxref{Building Emacs}), you may wish to set this variable to +@code{nil} first in order to cause the new dumped Emacs to process its +new command-line arguments. @end defvar @defvar command-switch-alist diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 6075f7c18ff..8fc57ea609a 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -2936,20 +2936,6 @@ This was observed for Emacs 28.1 on Solaris 10 32-bit sparc, with Oracle Developer Studio 12.6 (Sun C 5.15). The failure was intermittent, and running GNU Make a second time would typically finish the build. -*** On Solaris 10, Emacs crashes during the build process. -(This applies only with './configure --with-unexec=yes', which is rare.) -This was reported for Emacs 25.2 on i386-pc-solaris2.10 with Sun -Studio 12 (Sun C 5.9) and with Oracle Developer Studio 12.6 (Sun C -5.15), and intermittently for sparc-sun-solaris2.10 with Oracle -Developer Studio 12.5 (Sun C 5.14). Disabling compiler optimization -seems to fix the bug, as does upgrading the Solaris 10 operating -system to Update 11. The cause of the bug is unknown: it may be that -Emacs's archaic memory-allocation scheme is not compatible with -slightly-older versions of Solaris and/or Oracle Studio, or it may be -something else. Since the cause is not known, possibly the bug is -still present in newer versions of Emacs, Oracle Studio, and/or -Solaris. See Bug#26638. - *** On Solaris, C-x doesn't get through to Emacs when you use the console. This is a Solaris feature (at least on Intel x86 cpus). Type C-r @@ -4085,71 +4071,6 @@ minimum supported Windows version is 8.1, and the computer hardware (CPU, memory, disk) should also match the minimum Windows 8.1 requirements. -*** Segfault during 'make' - -If Emacs segfaults when 'make' executes one of these commands: - - LC_ALL=C ./temacs -batch -l loadup bootstrap - LC_ALL=C ./temacs -batch -l loadup dump - -the problem may be due to inadequate workarounds for address space -layout randomization (ASLR), an operating system feature that -randomizes the virtual address space of a process. ASLR is commonly -enabled in Linux and NetBSD kernels, and is intended to deter exploits -of pointer-related bugs in applications. If ASLR is enabled, the -command: - - cat /proc/sys/kernel/randomize_va_space # GNU/Linux - sysctl security.pax.aslr.global # NetBSD - -outputs a nonzero value. - -These segfaults should not occur on most modern systems, because the -Emacs build procedure uses the command 'setfattr' or 'paxctl' to mark -the Emacs executable as requiring non-randomized address space, and -Emacs uses the 'personality' system call to disable address space -randomization when dumping. However, older kernels may not support -'setfattr', 'paxctl', or 'personality', and newer Linux kernels have a -secure computing mode (seccomp) that can be configured to disable the -'personality' call. - -It may be possible to work around the 'personality' problem in a newer -Linux kernel by configuring seccomp to allow the 'personality' call. -For example, if you are building Emacs under Docker, you can run the -Docker container with a security profile that allows 'personality' by -using Docker's --security-opt option with an appropriate profile; see -. - -To work around the ASLR problem in either an older or a newer kernel, -you can temporarily disable the feature while building Emacs. On -GNU/Linux you can do so using the following command (as root). - - echo 0 > /proc/sys/kernel/randomize_va_space - -You can re-enable the feature when you are done, by echoing the -original value back to the file. NetBSD uses a different command, -e.g., 'sysctl -w security.pax.aslr.global=0'. - -Alternatively, you can try using the 'setarch' command when building -temacs like this, where -R disables address space randomization: - - setarch $(uname -m) -R make - -ASLR is not the only problem that can break Emacs dumping. Another -issue is that in Red Hat Linux kernels, Exec-shield is enabled by -default, and this creates a different memory layout. Emacs should -handle this at build time, but if this fails the following -instructions may be useful. Exec-shield is enabled on your system if - - cat /proc/sys/kernel/exec-shield - -prints a nonzero value. You can temporarily disable it as follows: - - echo 0 > /proc/sys/kernel/exec-shield - -As with randomize_va_space, you can re-enable Exec-shield when you are -done, by echoing the original value back to the file. - *** openSUSE 10.3: Segfault in bcopy during dumping. This is due to a bug in the bcopy implementation in openSUSE 10.3. @@ -4297,17 +4218,6 @@ should do. pen@lysator.liu.se says (Feb 1998) that the Compose key does work if you link with the MIT X11 libraries instead of the Solaris X11 libraries. -** OpenBSD - -*** OpenBSD 4.0 macppc: Segfault during dumping. - -The build aborts with signal 11 when the command './temacs --batch ---load loadup bootstrap' tries to load files.el. A workaround seems -to be to reduce the level of compiler optimization used during the -build (from -O2 to -O1). It is possible this is an OpenBSD -GCC problem specific to the macppc architecture, possibly only -occurring with older versions of GCC (e.g. 3.3.5). - ** AIX *** AIX 4.3.x or 4.4: Compiling fails. commit 9a0728af9df7c208a7e93f8e970b7348b1273fee Author: Pip Cet Date: Wed Aug 21 08:44:14 2024 +0000 Don't recognize "bootstrap" option for --temacs This option only makes sense for unexec dumping. * src/emacs.c (main): Recognize "pbootstrap" only, not "bootstrap". diff --git a/src/emacs.c b/src/emacs.c index 496a107d49d..13413e36459 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1310,8 +1310,7 @@ main (int argc, char **argv) if (strcmp (temacs, "pdump") == 0 || strcmp (temacs, "pbootstrap") == 0) gflags.will_dump_with_pdumper_ = true; - if (strcmp (temacs, "bootstrap") == 0 || - strcmp (temacs, "pbootstrap") == 0) + if (strcmp (temacs, "pbootstrap") == 0) gflags.will_bootstrap_ = true; gflags.will_dump_ = will_dump_with_pdumper_p (); commit 1c495735b4fd7411bca39161b45e0115d0d377b9 Author: Pip Cet Date: Wed Aug 21 08:59:25 2024 +0000 Pure storage removal: Documentation * etc/NEWS: Document removal of unexec dumper. * etc/PROBLEMS: Remove pure space problems. diff --git a/etc/NEWS b/etc/NEWS index d96e49402ba..f00b2cd7bee 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -24,6 +24,11 @@ applies, and please also update docstrings as needed. * Installation Changes in Emacs 31.1 ++++ +** Unexec dumper removed. +The traditional unexec dumper, deprecated since Emacs 27, has been +removed. + ** Changed GCC default options on 32-bit x86 systems. When using GCC 4 or later to build Emacs on 32-bit x86 systems, 'configure' now defaults to using the GCC options '-mfpmath=sse' (if the diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 30506b3c87a..6075f7c18ff 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -4150,31 +4150,6 @@ prints a nonzero value. You can temporarily disable it as follows: As with randomize_va_space, you can re-enable Exec-shield when you are done, by echoing the original value back to the file. -*** temacs prints "Pure Lisp storage exhausted". - -This means that the Lisp code loaded from the .elc and .el files during -'temacs --batch --load loadup dump' took up more space than was allocated. - -This could be caused by - 1) adding code to the preloaded Lisp files - 2) adding more preloaded files in loadup.el - 3) having a site-init.el or site-load.el which loads files. - Note that ANY site-init.el or site-load.el is nonstandard; - if you have received Emacs from some other site and it contains a - site-init.el or site-load.el file, consider deleting that file. - 4) getting the wrong .el or .elc files - (not from the directory you expected). - 5) deleting some .elc files that are supposed to exist. - This would cause the source files (.el files) to be - loaded instead. They take up more room, so you lose. - 6) a bug in the Emacs distribution which underestimates the space required. - -If the need for more space is legitimate, change the definition -of PURESIZE in puresize.h. - -But in some of the cases listed above, this problem is a consequence -of something else that is wrong. Be sure to check and fix the real problem. - *** openSUSE 10.3: Segfault in bcopy during dumping. This is due to a bug in the bcopy implementation in openSUSE 10.3. @@ -4194,13 +4169,6 @@ binary null characters, and the 'file' utility says: We don't know what exactly causes this failure. A work-around is to build Emacs in a directory on a local disk. -*** The dumped Emacs crashes when run, trying to write pure data. - -On a system where getpagesize is not a system call, it is defined -as a macro. If the definition (in both unex*.c and malloc.c) is wrong, -it can cause problems like this. You might be able to find the correct -value in the man page for a.out(5). - * Problems on legacy systems This section covers bugs reported on very old hardware or software. commit 647f6aa4c06f681df8d2ab6520d8bcd273dff1a8 Author: Pip Cet Date: Tue Aug 20 19:16:58 2024 +0000 Pure storage removal: Bump nativecomp ABI Use "9" as MPS builds use "7" and "8". * src/comp.c (ABI_VERSION): Bump. diff --git a/src/comp.c b/src/comp.c index 5e8b49f7ffc..ac26ead08d9 100644 --- a/src/comp.c +++ b/src/comp.c @@ -468,7 +468,7 @@ load_gccjit_if_necessary (bool mandatory) /* Increase this number to force a new Vcomp_abi_hash to be generated. */ -#define ABI_VERSION "6" +#define ABI_VERSION "9" /* Length of the hashes used for eln file naming. */ #define HASH_LENGTH 8 commit c9ab3258760c5ef2baf3ecf2a2a0051fc3fb4612 Author: Pip Cet Date: Tue Aug 20 19:15:16 2024 +0000 Pure storage removal: Remove documentation As pure storage is now gone, it no longer needs to be documented. * doc/lispref/elisp.texi (Top): * doc/lispref/internals.texi (GNU Emacs Internals): Remove "Pure Storage" section. (Building Emacs, Garbage Collection, Writing Emacs Primitives): * doc/lispref/symbols.texi (Standard Properties): Remove references to pure storage. * src/alloc.c (Fgarbage_collect): Remove docstring text referring to pure storage. diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index 1ce89c6431f..0715971e579 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -1651,7 +1651,6 @@ Tips and Conventions GNU Emacs Internals * Building Emacs:: How the dumped Emacs is made. -* Pure Storage:: Kludge to make preloaded Lisp functions shareable. * Garbage Collection:: Reclaiming space for Lisp objects no longer used. * Stack-allocated Objects:: Temporary conses and strings on C stack. * Memory Usage:: Info about total size of Lisp objects made so far. diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index a5480a9bf8a..00a3704fcac 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -12,7 +12,6 @@ internal aspects of GNU Emacs that may be of interest to C programmers. @menu * Building Emacs:: How the dumped Emacs is made. -* Pure Storage:: Kludge to make preloaded Lisp functions shareable. * Garbage Collection:: Reclaiming space for Lisp objects no longer used. * Stack-allocated Objects:: Temporary conses and strings on C stack. * Memory Usage:: Info about total size of Lisp objects made so far. @@ -251,71 +250,6 @@ If the current session was not restored from a dump file, the value is @code{nil}. @end defun -@node Pure Storage -@section Pure Storage -@cindex pure storage - - Emacs Lisp uses two kinds of storage for user-created Lisp objects: -@dfn{normal storage} and @dfn{pure storage}. Normal storage is where -all the new data created during an Emacs session are kept -(@pxref{Garbage Collection}). Pure storage is used for certain data -in the preloaded standard Lisp files---data that should never change -during actual use of Emacs. - - Pure storage is allocated only while @command{temacs} is loading the -standard preloaded Lisp libraries. In the file @file{emacs}, it is -marked as read-only (on operating systems that permit this), so that -the memory space can be shared by all the Emacs jobs running on the -machine at once. Pure storage is not expandable; a fixed amount is -allocated when Emacs is compiled, and if that is not sufficient for -the preloaded libraries, @file{temacs} allocates dynamic memory for -the part that didn't fit. If Emacs will be dumped using the -@code{pdump} method (@pxref{Building Emacs}), the pure-space overflow -is of no special importance (it just means some of the preloaded stuff -cannot be shared with other Emacs jobs). However, if Emacs will be -dumped using the now obsolete @code{unexec} method, the resulting -image will work, but garbage collection (@pxref{Garbage Collection}) -is disabled in this situation, causing a memory leak. Such an -overflow normally won't happen unless you try to preload additional -libraries or add features to the standard ones. Emacs will display a -warning about the overflow when it starts, if it was dumped using -@code{unexec}. If this happens, you should increase the compilation -parameter @code{SYSTEM_PURESIZE_EXTRA} in the file -@file{src/puresize.h} and rebuild Emacs. - -@defun purecopy object -This function makes a copy in pure storage of @var{object}, and returns -it. It copies a string by simply making a new string with the same -characters, but without text properties, in pure storage. It -recursively copies the contents of vectors and cons cells. It does -not make copies of other objects such as symbols, but just returns -them unchanged. It signals an error if asked to copy markers. - -This function is a no-op except while Emacs is being built and dumped; -it is usually called only in preloaded Lisp files. -@end defun - -@defvar pure-bytes-used -The value of this variable is the number of bytes of pure storage -allocated so far. Typically, in a dumped Emacs, this number is very -close to the total amount of pure storage available---if it were not, -we would preallocate less. -@end defvar - -@defvar purify-flag -This variable determines whether @code{defun} should make a copy of the -function definition in pure storage. If it is non-@code{nil}, then the -function definition is copied into pure storage. - -This flag is @code{t} while loading all of the basic functions for -building Emacs initially (allowing those functions to be shareable and -non-collectible). Dumping Emacs as an executable always writes -@code{nil} in this variable, regardless of the value it actually has -before and after dumping. - -You should not change this flag in a running Emacs. -@end defvar - @node Garbage Collection @section Garbage Collection @@ -526,12 +460,6 @@ Total heap size, in @var{unit-size} units. @item free-size Heap space which is not currently used, in @var{unit-size} units. @end table - -If there was overflow in pure space (@pxref{Pure Storage}), and Emacs -was dumped using the (now obsolete) @code{unexec} method -(@pxref{Building Emacs}), then @code{garbage-collect} returns -@code{nil}, because a real garbage collection cannot be done in that -case. @end deffn @defopt garbage-collection-messages @@ -967,7 +895,6 @@ improves user experience. the variables are never written once Emacs is dumped. These variables with initializers are allocated in an area of memory that becomes read-only (on certain operating systems) as a result of dumping Emacs. -@xref{Pure Storage}. @cindex @code{defsubr}, Lisp symbol for a primitive Defining the C function is not enough to make a Lisp primitive diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi index c3dc08df2df..1ce3bd4853a 100644 --- a/doc/lispref/symbols.texi +++ b/doc/lispref/symbols.texi @@ -593,8 +593,7 @@ modes. @xref{Setting Hooks}. If the value is non-@code{nil}, the named function is considered to be pure (@pxref{What Is a Function}). Calls with constant arguments can be evaluated at compile time. This may shift run time errors to -compile time. Not to be confused with pure storage (@pxref{Pure -Storage}). +compile time. @item risky-local-variable If the value is non-@code{nil}, the named variable is considered risky diff --git a/src/alloc.c b/src/alloc.c index ea142fb1076..8c8e1a99829 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -6296,10 +6296,6 @@ where each entry has the form (NAME SIZE USED FREE), where: keeps around for future allocations (maybe because it does not know how to return them to the OS). -However, if there was overflow in pure space, and Emacs was dumped -using the \"unexec\" method, `garbage-collect' returns nil, because -real GC can't be done. - Note that calling this function does not guarantee that absolutely all unreachable objects will be garbage-collected. Emacs uses a mark-and-sweep garbage collector, but is conservative when it comes to commit bd2b59f07337c4f5980666875207bf877634b1b3 Author: Pip Cet Date: Tue Aug 20 19:09:14 2024 +0000 Pure storage removal: Adjust nativecomp code * lisp/emacs-lisp/comp.el (comp-curr-allocation-class, comp-ctxt) (comp--emit-for-top-level, comp--emit-lambda-for-top-level) (comp--finalize-relocs): Remove 'd-impure' allocation class. * src/comp.c (PURE_RELOC_SYM, DATA_RELOC_IMPURE_SYM) (TEXT_DATA_RELOC_IMPURE_SYM): Remove definitions. (comp_t): Remove 'pure_ptr', 'check_impure', 'data_relocs_impure', 'd_impure_idx'. (helper_link_table): Remove 'pure_write_error'. (obj_to_reloc): Adjust to removal of 'data_relocs_impure'. (emit_PURE_P): Remove function. (declare_imported_data, declare_runtime_imported_funcs) (emit_ctxt_code): Adjust to removed fields. (define_setcar_setcdr): Don't call 'CHECK_IMPURE'. (define_CHECK_IMPURE): Remove function. (Fcomp__compile_ctxt_to_file0, check_comp_unit_relocs, load_comp_unit) (Fcomp__register_lambda): Adjust to removed allocation class 'd-impure'. (syms_of_comp): Don't define 'd-impure'. * src/comp.h (struct Lisp_Native_Comp_Unit): Drop support for allocation class 'd-impure'. * src/lisp.h (allocate_native_comp_unit): * src/pdumper.c (dump_do_dump_relocation): Adjust to struct change. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index aea38c60d41..dbd14b2740d 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -155,7 +155,7 @@ native compilation runs.") (defvar comp-curr-allocation-class 'd-default "Current allocation class. -Can be one of: `d-default', `d-impure' or `d-ephemeral'. See `comp-ctxt'.") +Can be one of: `d-default' or `d-ephemeral'. See `comp-ctxt'.") (defconst comp-passes '(comp--spill-lap comp--limplify @@ -395,9 +395,6 @@ Needed to replace immediate byte-compiled lambdas with the compiled reference.") :documentation "Documentation index -> documentation") (d-default (make-comp-data-container) :type comp-data-container :documentation "Standard data relocated in use by functions.") - (d-impure (make-comp-data-container) :type comp-data-container - :documentation "Relocated data that cannot be moved into pure space. -This is typically for top-level forms other than defun.") (d-ephemeral (make-comp-data-container) :type comp-data-container :documentation "Relocated data not necessary after load.") (with-late-load nil :type boolean @@ -1615,7 +1612,7 @@ and the annotation emission." (unless for-late-load (comp--emit (comp--call 'eval - (let ((comp-curr-allocation-class 'd-impure)) + (let ((comp-curr-allocation-class 'd-default)) (make--comp-mvar :constant (byte-to-native-top-level-form form))) (make--comp-mvar :constant @@ -1625,7 +1622,7 @@ and the annotation emission." "Emit the creation of subrs for lambda FUNC. These are stored in the reloc data array." (let ((args (comp--prepare-args-for-top-level func))) - (let ((comp-curr-allocation-class 'd-impure)) + (let ((comp-curr-allocation-class 'd-default)) (comp--add-const-to-relocs (comp-func-byte-func func))) (comp--emit (comp--call 'comp--register-lambda @@ -3271,28 +3268,15 @@ Update all insn accordingly." (let* ((d-default (comp-ctxt-d-default comp-ctxt)) (d-default-idx (comp-data-container-idx d-default)) - (d-impure (comp-ctxt-d-impure comp-ctxt)) - (d-impure-idx (comp-data-container-idx d-impure)) (d-ephemeral (comp-ctxt-d-ephemeral comp-ctxt)) (d-ephemeral-idx (comp-data-container-idx d-ephemeral))) - ;; We never want compiled lambdas ending up in pure space. A copy must - ;; be already present in impure (see `comp--emit-lambda-for-top-level'). - (cl-loop for obj being each hash-keys of d-default-idx - when (gethash obj (comp-ctxt-lambda-fixups-h comp-ctxt)) - do (cl-assert (gethash obj d-impure-idx)) - (remhash obj d-default-idx)) - ;; Remove entries in d-impure already present in d-default. - (cl-loop for obj being each hash-keys of d-impure-idx - when (gethash obj d-default-idx) - do (remhash obj d-impure-idx)) - ;; Remove entries in d-ephemeral already present in d-default or - ;; d-impure. + ;; Remove entries in d-ephemeral already present in d-default (cl-loop for obj being each hash-keys of d-ephemeral-idx - when (or (gethash obj d-default-idx) (gethash obj d-impure-idx)) + when (gethash obj d-default-idx) do (remhash obj d-ephemeral-idx)) ;; Fix-up indexes in each relocation class and fill corresponding ;; reloc lists. - (mapc #'comp--finalize-container (list d-default d-impure d-ephemeral)) + (mapc #'comp--finalize-container (list d-default d-ephemeral)) ;; Make a vector from the function documentation hash table. (cl-loop with h = (comp-ctxt-function-docs comp-ctxt) with v = (make-vector (hash-table-count h) nil) @@ -3302,13 +3286,13 @@ Update all insn accordingly." finally do (setf (comp-ctxt-function-docs comp-ctxt) v)) ;; And now we conclude with the following: We need to pass to - ;; `comp--register-lambda' the index in the impure relocation - ;; array to store revived lambdas, but given we know it only now - ;; we fix it up as last. + ;; `comp--register-lambda' the index in the relocation array to + ;; store revived lambdas, but given we know it only now we fix it up + ;; as last. (cl-loop for f being each hash-keys of (comp-ctxt-lambda-fixups-h comp-ctxt) using (hash-value mvar) with reverse-h = (make-hash-table) ;; Make sure idx is unique. - for idx = (gethash f d-impure-idx) + for idx = (gethash f d-default-idx) do (cl-assert (null (gethash idx reverse-h))) (cl-assert (fixnump idx)) diff --git a/src/comp.c b/src/comp.c index e43732f369e..5e8b49f7ffc 100644 --- a/src/comp.c +++ b/src/comp.c @@ -476,16 +476,13 @@ load_gccjit_if_necessary (bool mandatory) /* C symbols emitted for the load relocation mechanism. */ #define CURRENT_THREAD_RELOC_SYM "current_thread_reloc" #define F_SYMBOLS_WITH_POS_ENABLED_RELOC_SYM "f_symbols_with_pos_enabled_reloc" -#define PURE_RELOC_SYM "pure_reloc" #define DATA_RELOC_SYM "d_reloc" -#define DATA_RELOC_IMPURE_SYM "d_reloc_imp" #define DATA_RELOC_EPHEMERAL_SYM "d_reloc_eph" #define FUNC_LINK_TABLE_SYM "freloc_link_table" #define LINK_TABLE_HASH_SYM "freloc_hash" #define COMP_UNIT_SYM "comp_unit" #define TEXT_DATA_RELOC_SYM "text_data_reloc" -#define TEXT_DATA_RELOC_IMPURE_SYM "text_data_reloc_imp" #define TEXT_DATA_RELOC_EPHEMERAL_SYM "text_data_reloc_eph" #define TEXT_OPTIM_QLY_SYM "text_optim_qly" @@ -619,7 +616,6 @@ typedef struct { gcc_jit_type *thread_state_ptr_type; gcc_jit_rvalue *current_thread_ref; /* Other globals. */ - gcc_jit_rvalue *pure_ptr; #ifndef LIBGCCJIT_HAVE_gcc_jit_context_new_bitcast /* This version of libgccjit has really limited support for casting therefore this union will be used for the scope. */ @@ -651,7 +647,6 @@ typedef struct { gcc_jit_function *setcar; gcc_jit_function *setcdr; gcc_jit_function *check_type; - gcc_jit_function *check_impure; gcc_jit_function *maybe_gc_or_quit; Lisp_Object func_blocks_h; /* blk_name -> gcc_block. */ Lisp_Object exported_funcs_h; /* c-func-name -> gcc_jit_function *. */ @@ -659,8 +654,6 @@ typedef struct { Lisp_Object emitter_dispatcher; /* Synthesized struct holding data relocs. */ reloc_array_t data_relocs; - /* Same as before but can't go in pure space. */ - reloc_array_t data_relocs_impure; /* Same as before but content does not survive load phase. */ reloc_array_t data_relocs_ephemeral; /* Global structure holding function relocations. */ @@ -670,7 +663,6 @@ typedef struct { gcc_jit_lvalue *func_relocs_local; gcc_jit_function *memcpy; Lisp_Object d_default_idx; - Lisp_Object d_impure_idx; Lisp_Object d_ephemeral_idx; } comp_t; @@ -708,7 +700,6 @@ helper_sanitizer_assert (Lisp_Object, Lisp_Object); static void *helper_link_table[] = { wrong_type_argument, helper_PSEUDOVECTOR_TYPEP_XUNTAG, - pure_write_error, push_handler, record_unwind_protect_excursion, helper_unbind_n, @@ -939,13 +930,6 @@ obj_to_reloc (Lisp_Object obj) goto found; } - idx = Fgethash (obj, comp.d_impure_idx, Qnil); - if (!NILP (idx)) - { - reloc.array = comp.data_relocs_impure; - goto found; - } - idx = Fgethash (obj, comp.d_ephemeral_idx, Qnil); if (!NILP (idx)) { @@ -1987,28 +1971,6 @@ emit_XSETCDR (gcc_jit_rvalue *c, gcc_jit_rvalue *n) NULL), n); } - -static gcc_jit_rvalue * -emit_PURE_P (gcc_jit_rvalue *ptr) -{ - - emit_comment ("PURE_P"); - - return - gcc_jit_context_new_comparison ( - comp.ctxt, - NULL, - GCC_JIT_COMPARISON_LE, - emit_binary_op ( - GCC_JIT_BINARY_OP_MINUS, - comp.uintptr_type, - ptr, - comp.pure_ptr), - gcc_jit_context_new_rvalue_from_int (comp.ctxt, - comp.uintptr_type, - PURESIZE)); -} - /*************************************/ /* Code emitted by LIMPLE statemes. */ @@ -2925,10 +2887,6 @@ declare_imported_data (void) declare_imported_data_relocs (CALL1I (comp-ctxt-d-default, Vcomp_ctxt), DATA_RELOC_SYM, TEXT_DATA_RELOC_SYM); - comp.data_relocs_impure = - declare_imported_data_relocs (CALL1I (comp-ctxt-d-impure, Vcomp_ctxt), - DATA_RELOC_IMPURE_SYM, - TEXT_DATA_RELOC_IMPURE_SYM); comp.data_relocs_ephemeral = declare_imported_data_relocs (CALL1I (comp-ctxt-d-ephemeral, Vcomp_ctxt), DATA_RELOC_EPHEMERAL_SYM, @@ -2962,8 +2920,6 @@ declare_runtime_imported_funcs (void) args[1] = comp.int_type; ADD_IMPORTED (helper_PSEUDOVECTOR_TYPEP_XUNTAG, comp.bool_type, 2, args); - ADD_IMPORTED (pure_write_error, comp.void_type, 1, NULL); - args[0] = comp.lisp_obj_type; args[1] = comp.int_type; ADD_IMPORTED (push_handler, comp.handler_ptr_type, 2, args); @@ -3039,15 +2995,6 @@ emit_ctxt_code (void) comp.bool_ptr_type, F_SYMBOLS_WITH_POS_ENABLED_RELOC_SYM)); - comp.pure_ptr = - gcc_jit_lvalue_as_rvalue ( - gcc_jit_context_new_global ( - comp.ctxt, - NULL, - GCC_JIT_GLOBAL_EXPORTED, - comp.void_ptr_type, - PURE_RELOC_SYM)); - gcc_jit_context_new_global ( comp.ctxt, NULL, @@ -3709,19 +3656,6 @@ define_setcar_setcdr (void) /* CHECK_CONS (cell); */ emit_CHECK_CONS (gcc_jit_param_as_rvalue (cell)); - /* CHECK_IMPURE (cell, XCONS (cell)); */ - gcc_jit_rvalue *args[] = - { gcc_jit_param_as_rvalue (cell), - emit_XCONS (gcc_jit_param_as_rvalue (cell)) }; - - gcc_jit_block_add_eval (entry_block, - NULL, - gcc_jit_context_new_call (comp.ctxt, - NULL, - comp.check_impure, - 2, - args)); - /* XSETCDR (cell, newel); */ if (!i) emit_XSETCAR (gcc_jit_param_as_rvalue (cell), @@ -4025,52 +3959,6 @@ static void define_SYMBOL_WITH_POS_SYM (void) comp.lisp_symbol_with_position_sym)); } -static void -define_CHECK_IMPURE (void) -{ - gcc_jit_param *param[] = - { gcc_jit_context_new_param (comp.ctxt, - NULL, - comp.lisp_obj_type, - "obj"), - gcc_jit_context_new_param (comp.ctxt, - NULL, - comp.void_ptr_type, - "ptr") }; - comp.check_impure = - gcc_jit_context_new_function (comp.ctxt, NULL, - GCC_JIT_FUNCTION_INTERNAL, - comp.void_type, - "CHECK_IMPURE", - 2, - param, - 0); - - DECL_BLOCK (entry_block, comp.check_impure); - DECL_BLOCK (err_block, comp.check_impure); - DECL_BLOCK (ok_block, comp.check_impure); - - comp.block = entry_block; - comp.func = comp.check_impure; - - emit_cond_jump (emit_PURE_P (gcc_jit_param_as_rvalue (param[0])), /* FIXME */ - err_block, - ok_block); - gcc_jit_block_end_with_void_return (ok_block, NULL); - - gcc_jit_rvalue *pure_write_error_arg = - gcc_jit_param_as_rvalue (param[0]); - - comp.block = err_block; - gcc_jit_block_add_eval (comp.block, - NULL, - emit_call (intern_c_string ("pure_write_error"), - comp.void_type, 1,&pure_write_error_arg, - false)); - - gcc_jit_block_end_with_void_return (err_block, NULL); -} - static void define_maybe_gc_or_quit (void) { @@ -4948,8 +4836,6 @@ DEFUN ("comp--compile-ctxt-to-file0", Fcomp__compile_ctxt_to_file0, comp.d_default_idx = CALL1I (comp-data-container-idx, CALL1I (comp-ctxt-d-default, Vcomp_ctxt)); - comp.d_impure_idx = - CALL1I (comp-data-container-idx, CALL1I (comp-ctxt-d-impure, Vcomp_ctxt)); comp.d_ephemeral_idx = CALL1I (comp-data-container-idx, CALL1I (comp-ctxt-d-ephemeral, Vcomp_ctxt)); @@ -5281,17 +5167,12 @@ check_comp_unit_relocs (struct Lisp_Native_Comp_Unit *comp_u) { dynlib_handle_ptr handle = comp_u->handle; Lisp_Object *data_relocs = dynlib_sym (handle, DATA_RELOC_SYM); - Lisp_Object *data_imp_relocs = dynlib_sym (handle, DATA_RELOC_IMPURE_SYM); EMACS_INT d_vec_len = XFIXNUM (Flength (comp_u->data_vec)); - for (ptrdiff_t i = 0; i < d_vec_len; i++) - if (!EQ (data_relocs[i], AREF (comp_u->data_vec, i))) - return false; - d_vec_len = XFIXNUM (Flength (comp_u->data_impure_vec)); for (ptrdiff_t i = 0; i < d_vec_len; i++) { - Lisp_Object x = data_imp_relocs[i]; + Lisp_Object x = data_relocs[i]; if (EQ (x, Qlambda_fixup)) return false; else if (NATIVE_COMP_FUNCTIONP (x)) @@ -5299,7 +5180,7 @@ check_comp_unit_relocs (struct Lisp_Native_Comp_Unit *comp_u) if (NILP (Fgethash (x, comp_u->lambda_gc_guard_h, Qnil))) return false; } - else if (!EQ (x, AREF (comp_u->data_impure_vec, i))) + else if (!EQ (x, AREF (comp_u->data_vec, i))) return false; } return true; @@ -5363,7 +5244,7 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, /* Always set data_imp_relocs pointer in the compilation unit (in can be used in 'dump_do_dump_relocation'). */ - comp_u->data_imp_relocs = dynlib_sym (handle, DATA_RELOC_IMPURE_SYM); + comp_u->data_relocs = dynlib_sym (handle, DATA_RELOC_SYM); if (!comp_u->loaded_once) { @@ -5371,16 +5252,12 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, dynlib_sym (handle, CURRENT_THREAD_RELOC_SYM); bool **f_symbols_with_pos_enabled_reloc = dynlib_sym (handle, F_SYMBOLS_WITH_POS_ENABLED_RELOC_SYM); - void **pure_reloc = dynlib_sym (handle, PURE_RELOC_SYM); - Lisp_Object *data_relocs = dynlib_sym (handle, DATA_RELOC_SYM); - Lisp_Object *data_imp_relocs = comp_u->data_imp_relocs; + Lisp_Object *data_relocs = comp_u->data_relocs; void **freloc_link_table = dynlib_sym (handle, FUNC_LINK_TABLE_SYM); if (!(current_thread_reloc && f_symbols_with_pos_enabled_reloc - && pure_reloc && data_relocs - && data_imp_relocs && data_eph_relocs && freloc_link_table && top_level_run) @@ -5390,7 +5267,6 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, *current_thread_reloc = ¤t_thread; *f_symbols_with_pos_enabled_reloc = &symbols_with_pos_enabled; - *pure_reloc = pure; /* Imported functions. */ *freloc_link_table = freloc.link_table; @@ -5401,21 +5277,11 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, comp_u->optimize_qualities = load_static_obj (comp_u, TEXT_OPTIM_QLY_SYM); comp_u->data_vec = load_static_obj (comp_u, TEXT_DATA_RELOC_SYM); - comp_u->data_impure_vec = - load_static_obj (comp_u, TEXT_DATA_RELOC_IMPURE_SYM); - - if (!NILP (Vpurify_flag)) - /* Non impure can be copied into pure space. */ - comp_u->data_vec = Fpurecopy (comp_u->data_vec); } EMACS_INT d_vec_len = XFIXNUM (Flength (comp_u->data_vec)); for (EMACS_INT i = 0; i < d_vec_len; i++) data_relocs[i] = AREF (comp_u->data_vec, i); - - d_vec_len = XFIXNUM (Flength (comp_u->data_impure_vec)); - for (EMACS_INT i = 0; i < d_vec_len; i++) - data_imp_relocs[i] = AREF (comp_u->data_impure_vec, i); } if (!loading_dump) @@ -5567,7 +5433,7 @@ This gets called by top_level_run during the load phase. */) eassert (NILP (Fgethash (c_name, cu->lambda_c_name_idx_h, Qnil))); Fputhash (c_name, reloc_idx, cu->lambda_c_name_idx_h); /* Do the real relocation fixup. */ - cu->data_imp_relocs[XFIXNUM (reloc_idx)] = tem; + cu->data_relocs[XFIXNUM (reloc_idx)] = tem; return tem; } @@ -5749,7 +5615,6 @@ natively-compiled one. */); /* Allocation classes. */ DEFSYM (Qd_default, "d-default"); - DEFSYM (Qd_impure, "d-impure"); DEFSYM (Qd_ephemeral, "d-ephemeral"); /* Others. */ diff --git a/src/comp.h b/src/comp.h index 158ed0b46df..2a60cb38955 100644 --- a/src/comp.h +++ b/src/comp.h @@ -35,17 +35,15 @@ struct Lisp_Native_Comp_Unit /* Guard anonymous lambdas against Garbage Collection and serve sanity checks. */ Lisp_Object lambda_gc_guard_h; - /* Hash c_name -> d_reloc_imp index. */ + /* Hash c_name -> d_reloc index. */ Lisp_Object lambda_c_name_idx_h; /* Hash doc-idx -> function documentation. */ Lisp_Object data_fdoc_v; - /* Analogous to the constant vector but per compilation unit. */ + /* Analogous to the constant vector but per compilation unit. Must be + last. */ Lisp_Object data_vec; - /* 'data_impure_vec' must be last (see allocate_native_comp_unit). - Same as data_vec but for data that cannot be moved to pure space. */ - Lisp_Object data_impure_vec; /* STUFFS WE DO NOT DUMP!! */ - Lisp_Object *data_imp_relocs; + Lisp_Object *data_relocs; bool loaded_once; bool load_ongoing; dynlib_handle_ptr handle; diff --git a/src/lisp.h b/src/lisp.h index 5ebbe4f9860..695d5f200ea 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -5498,7 +5498,7 @@ INLINE struct Lisp_Native_Comp_Unit * allocate_native_comp_unit (void) { return ALLOCATE_ZEROED_PSEUDOVECTOR (struct Lisp_Native_Comp_Unit, - data_impure_vec, PVEC_NATIVE_COMP_UNIT); + data_vec, PVEC_NATIVE_COMP_UNIT); } #else INLINE bool diff --git a/src/pdumper.c b/src/pdumper.c index 5bd0d8ca44a..40798ff48e9 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -5498,12 +5498,12 @@ dump_do_dump_relocation (const uintptr_t dump_base, if (!NILP (lambda_data_idx)) { /* This is an anonymous lambda. - We must fixup d_reloc_imp so the lambda can be referenced + We must fixup d_reloc so the lambda can be referenced by code. */ Lisp_Object tem; XSETSUBR (tem, subr); Lisp_Object *fixup = - &(comp_u->data_imp_relocs[XFIXNUM (lambda_data_idx)]); + &(comp_u->data_relocs[XFIXNUM (lambda_data_idx)]); eassert (EQ (*fixup, Qlambda_fixup)); *fixup = tem; Fputhash (tem, Qt, comp_u->lambda_gc_guard_h); commit 69fea4f29a1390912e4140a3ebacc50b7338db6f Author: Pip Cet Date: Tue Aug 20 19:08:33 2024 +0000 Pure storage removal: Remove docstring hack This should no longer be needed. * src/eval.c (Fautoload): Don't try to work around pure storage bug. diff --git a/src/eval.c b/src/eval.c index 6d0e8f101d7..28aa14c6234 100644 --- a/src/eval.c +++ b/src/eval.c @@ -2314,12 +2314,6 @@ this does nothing and returns nil. */) && !AUTOLOADP (XSYMBOL (function)->u.s.function)) return Qnil; - if (!NILP (Vpurify_flag) && BASE_EQ (docstring, make_fixnum (0))) - /* `read1' in lread.c has found the docstring starting with "\ - and assumed the docstring will be provided by Snarf-documentation, so it - passed us 0 instead. But that leads to accidental sharing in purecopy's - hash-consing, so we use a (hopefully) unique integer instead. */ - docstring = make_ufixnum (XHASH (function)); return Fdefalias (function, list5 (Qautoload, file, docstring, interactive, type), Qnil); commit afd61deaaeb5e5e6845bdf995ac5ee9a3479599c Author: Pip Cet Date: Tue Aug 20 19:04:44 2024 +0000 Pure storage removal: Remove purecopy hash table flag * lisp/emacs-liqsp/comp.el (comp--jump-table-optimizable): Adjust comment. * src/category.c (hash_get_category_set): * src/emacs-module.c (syms_of_module): * src/fns.c (make_hash_table): Remove 'purecopy' flag and update docstring. (Fmake_hash_table): Ignore ':purecopy' argument. * src/frame.c (make_frame): * src/image.c (xpm_make_color_table_h): * src/lisp.h (struct Lisp_Hash_Table): Drop 'purecopy' flag. * src/pdumper.c (dump_hash_table): Don't dump 'purecopy' flag. * src/print.c (print_object): Don't print 'purecopy' flag * src/json.c (json_parse_object): * src/lread.c (readevalloop, read_internal_start): * src/pgtkterm.c (syms_of_pgtkterm): * src/profiler.c (export_log): * src/xfaces.c (syms_of_xfaces): * src/xterm.c (syms_of_xterm): Adjust calls to 'make_hash_table'. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 2966ed255ac..aea38c60d41 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -1190,7 +1190,7 @@ Return value is the fall-through block name." (defun comp--jump-table-optimizable (jmp-table) "Return t if JMP-TABLE can be optimized out." ;; Identify LAP sequences like: - ;; (byte-constant #s(hash-table test eq purecopy t data (created 126 deleted 126 changed 126)) . 24) + ;; (byte-constant #s(hash-table test eq data (created 126 deleted 126 changed 126)) . 24) ;; (byte-switch) ;; (TAG 126 . 10) (let ((targets (hash-table-values jmp-table))) diff --git a/src/category.c b/src/category.c index ef29a1a681a..85a2ea0ad0f 100644 --- a/src/category.c +++ b/src/category.c @@ -51,7 +51,7 @@ hash_get_category_set (Lisp_Object table, Lisp_Object category_set) if (NILP (XCHAR_TABLE (table)->extras[1])) set_char_table_extras (table, 1, - make_hash_table (&hashtest_equal, DEFAULT_HASH_SIZE, Weak_None, false)); + make_hash_table (&hashtest_equal, DEFAULT_HASH_SIZE, Weak_None)); struct Lisp_Hash_Table *h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]); hash_hash_t hash; ptrdiff_t i = hash_lookup_get_hash (h, category_set, &hash); diff --git a/src/emacs-module.c b/src/emacs-module.c index d818b6cdeb9..e3a935236ca 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -1709,7 +1709,7 @@ syms_of_module (void) { staticpro (&Vmodule_refs_hash); Vmodule_refs_hash - = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); + = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None); DEFSYM (Qmodule_load_failed, "module-load-failed"); Fput (Qmodule_load_failed, Qerror_conditions, diff --git a/src/fns.c b/src/fns.c index 75fd20a2d79..7c2ddb8707c 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4847,15 +4847,11 @@ static const hash_idx_t empty_hash_index_vector[] = {-1}; Give the table initial capacity SIZE, 0 <= SIZE <= MOST_POSITIVE_FIXNUM. - WEAK specifies the weakness of the table. - - If PURECOPY is non-nil, the table can be copied to pure storage via - `purecopy' when Emacs is being dumped. Such tables can no longer be - changed after purecopy. */ + WEAK specifies the weakness of the table. */ Lisp_Object make_hash_table (const struct hash_table_test *test, EMACS_INT size, - hash_table_weakness_t weak, bool purecopy) + hash_table_weakness_t weak) { eassert (SYMBOLP (test->name)); eassert (0 <= size && size <= min (MOST_POSITIVE_FIXNUM, PTRDIFF_MAX)); @@ -4901,7 +4897,6 @@ make_hash_table (const struct hash_table_test *test, EMACS_INT size, } h->next_weak = NULL; - h->purecopy = purecopy; h->mutable = true; return make_lisp_hash_table (h); } @@ -5735,13 +5730,8 @@ key, value, one of key or value, or both key and value, depending on WEAK. WEAK t is equivalent to `key-and-value'. Default value of WEAK is nil. -:purecopy PURECOPY -- If PURECOPY is non-nil, the table can be copied -to pure storage when Emacs is being dumped, making the contents of the -table read only. Any further changes to purified tables will result -in an error. - -The keywords arguments :rehash-threshold and :rehash-size are obsolete -and ignored. +The keywords arguments :rehash-threshold, :rehash-size, and :purecopy +are obsolete and ignored. usage: (make-hash-table &rest KEYWORD-ARGS) */) (ptrdiff_t nargs, Lisp_Object *args) @@ -5749,7 +5739,6 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) Lisp_Object test_arg = Qnil; Lisp_Object weakness_arg = Qnil; Lisp_Object size_arg = Qnil; - Lisp_Object purecopy_arg = Qnil; if (nargs & 1) error ("Odd number of arguments"); @@ -5763,9 +5752,8 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) weakness_arg = arg; else if (BASE_EQ (kw, QCsize)) size_arg = arg; - else if (BASE_EQ (kw, QCpurecopy)) - purecopy_arg = arg; - else if (BASE_EQ (kw, QCrehash_threshold) || BASE_EQ (kw, QCrehash_size)) + else if (BASE_EQ (kw, QCrehash_threshold) || BASE_EQ (kw, QCrehash_size) + || BASE_EQ (kw, QCpurecopy)) ; /* ignore obsolete keyword arguments */ else signal_error ("Invalid keyword argument", kw); @@ -5781,8 +5769,6 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) else test = get_hash_table_user_test (test_arg); - bool purecopy = !NILP (purecopy_arg); - EMACS_INT size; if (NILP (size_arg)) size = DEFAULT_HASH_SIZE; @@ -5805,7 +5791,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) else signal_error ("Invalid hash table weakness", weakness_arg); - return make_hash_table (test, size, weak, purecopy); + return make_hash_table (test, size, weak); } diff --git a/src/frame.c b/src/frame.c index 78fa41bbe62..4597dd5cecd 100644 --- a/src/frame.c +++ b/src/frame.c @@ -1043,7 +1043,7 @@ make_frame (bool mini_p) rw->pixel_height = rw->total_lines * FRAME_LINE_HEIGHT (f); fset_face_hash_table - (f, make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false)); + (f, make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None)); if (mini_p) { diff --git a/src/image.c b/src/image.c index 0012abcb451..92906f5274c 100644 --- a/src/image.c +++ b/src/image.c @@ -6200,7 +6200,7 @@ xpm_make_color_table_h (void (**put_func) (Lisp_Object, const char *, int, { *put_func = xpm_put_color_table_h; *get_func = xpm_get_color_table_h; - return make_hash_table (&hashtest_equal, DEFAULT_HASH_SIZE, Weak_None, false); + return make_hash_table (&hashtest_equal, DEFAULT_HASH_SIZE, Weak_None); } static void diff --git a/src/json.c b/src/json.c index 282dca6e8ff..bfdf7af0ab0 100644 --- a/src/json.c +++ b/src/json.c @@ -1564,7 +1564,7 @@ json_parse_object (struct json_parser *parser) case json_object_hashtable: { EMACS_INT value = (parser->object_workspace_current - first) / 2; - result = make_hash_table (&hashtest_equal, value, Weak_None, false); + result = make_hash_table (&hashtest_equal, value, Weak_None); struct Lisp_Hash_Table *h = XHASH_TABLE (result); for (size_t i = first; i < parser->object_workspace_current; i += 2) { diff --git a/src/lisp.h b/src/lisp.h index 1370fe7e30f..5ebbe4f9860 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2620,10 +2620,6 @@ struct Lisp_Hash_Table /* Hash table test (only used when frozen in dump) */ hash_table_std_test_t frozen_test : 2; - /* True if the table can be purecopied. The table cannot be - changed afterwards. */ - bool_bf purecopy : 1; - /* True if the table is mutable. Ordinarily tables are mutable, but some tables are not: while a table is being mutated it is immutable for recursive attempts to mutate it. */ @@ -4258,7 +4254,7 @@ extern char *extract_data_from_object (Lisp_Object, ptrdiff_t *, ptrdiff_t *); EMACS_UINT hash_string (char const *, ptrdiff_t); EMACS_UINT sxhash (Lisp_Object); Lisp_Object make_hash_table (const struct hash_table_test *, EMACS_INT, - hash_table_weakness_t, bool); + hash_table_weakness_t); Lisp_Object hash_table_weakness_symbol (hash_table_weakness_t weak); ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object); ptrdiff_t hash_lookup_get_hash (struct Lisp_Hash_Table *h, Lisp_Object key, diff --git a/src/lread.c b/src/lread.c index a95abd687ac..8adb862d9a0 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2490,11 +2490,11 @@ readevalloop (Lisp_Object readcharfun, if (! HASH_TABLE_P (read_objects_map) || XHASH_TABLE (read_objects_map)->count) read_objects_map - = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); + = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None); if (! HASH_TABLE_P (read_objects_completed) || XHASH_TABLE (read_objects_completed)->count) read_objects_completed - = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); + = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None); if (!NILP (Vpurify_flag) && c == '(') val = read0 (readcharfun, false); else @@ -2740,11 +2740,11 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end, if (! HASH_TABLE_P (read_objects_map) || XHASH_TABLE (read_objects_map)->count) read_objects_map - = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); + = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None); if (! HASH_TABLE_P (read_objects_completed) || XHASH_TABLE (read_objects_completed)->count) read_objects_completed - = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); + = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None); if (STRINGP (stream) || ((CONSP (stream) && STRINGP (XCAR (stream))))) diff --git a/src/pdumper.c b/src/pdumper.c index 5a55dccf09f..5bd0d8ca44a 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2747,7 +2747,6 @@ dump_hash_table (struct dump_context *ctx, Lisp_Object object) dump_pseudovector_lisp_fields (ctx, &out->header, &hash->header); DUMP_FIELD_COPY (out, hash, count); DUMP_FIELD_COPY (out, hash, weakness); - DUMP_FIELD_COPY (out, hash, purecopy); DUMP_FIELD_COPY (out, hash, mutable); DUMP_FIELD_COPY (out, hash, frozen_test); if (hash->key_and_value) diff --git a/src/pgtkterm.c b/src/pgtkterm.c index 246604ec18b..5b55c1b488d 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -7485,7 +7485,7 @@ If set to a non-float value, there will be no wait at all. */); DEFVAR_LISP ("pgtk-keysym-table", Vpgtk_keysym_table, doc: /* Hash table of character codes indexed by X keysym codes. */); - Vpgtk_keysym_table = make_hash_table (&hashtest_eql, 900, Weak_None, false); + Vpgtk_keysym_table = make_hash_table (&hashtest_eql, 900, Weak_None); window_being_scrolled = Qnil; staticpro (&window_being_scrolled); diff --git a/src/print.c b/src/print.c index 8f28b14e8b6..35a2dac6263 100644 --- a/src/print.c +++ b/src/print.c @@ -2605,9 +2605,6 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) printcharfun, escapeflag); } - if (h->purecopy) - print_c_string (" purecopy t", printcharfun); - ptrdiff_t size = h->count; if (size > 0) { diff --git a/src/profiler.c b/src/profiler.c index 6e1dc46abd3..80173ac735e 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -562,7 +562,7 @@ export_log (struct profiler_log *plog) the log but close enough, and will never confuse two distinct keys in the log. */ Lisp_Object h = make_hash_table (&hashtest_equal, DEFAULT_HASH_SIZE, - Weak_None, false); + Weak_None); for (int i = 0; i < log->size; i++) { int count = get_log_count (log, i); diff --git a/src/xfaces.c b/src/xfaces.c index 7763fdd4953..9c54fe5b051 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -7518,7 +7518,7 @@ only for this purpose. */); doc: /* Hash table of global face definitions (for internal use only.) */); Vface_new_frame_defaults = /* 33 entries is enough to fit all basic faces */ - make_hash_table (&hashtest_eq, 33, Weak_None, false); + make_hash_table (&hashtest_eq, 33, Weak_None); DEFVAR_LISP ("face-default-stipple", Vface_default_stipple, doc: /* Default stipple pattern used on monochrome displays. diff --git a/src/xterm.c b/src/xterm.c index f78b20e0d58..c723362c91a 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -32739,7 +32739,7 @@ If set to a non-float value, there will be no wait at all. */); DEFVAR_LISP ("x-keysym-table", Vx_keysym_table, doc: /* Hash table of character codes indexed by X keysym codes. */); - Vx_keysym_table = make_hash_table (&hashtest_eql, 900, Weak_None, false); + Vx_keysym_table = make_hash_table (&hashtest_eql, 900, Weak_None); DEFVAR_BOOL ("x-frame-normalize-before-maximize", x_frame_normalize_before_maximize, commit e1e101c6c10b6e5110c2c47946d477a752828a78 Author: Pip Cet Date: Tue Aug 20 19:02:29 2024 +0000 Pure storage removal: Remove support for pinned objects * src/alloc.c (symbol_block_pinned): Remove variable. (init_symbol): Don't initialize 'pinned flag'. (pinned_objects): Remove variable. (mark_pinned_objects, mark_pinned_symbols): Remove functions. (garbage_collect): Don't call 'mark_pinned_objects', 'mark_pinned_symbols'. * src/lisp.h (struct Lisp_Symbol): Remove 'pinned' flag. * src/pdumper.c (dump_symbol): Remove 'pinned' flag from dump. diff --git a/src/alloc.c b/src/alloc.c index ff491719547..ea142fb1076 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3898,13 +3898,6 @@ struct symbol_block static struct symbol_block *symbol_block; static int symbol_block_index = SYMBOL_BLOCK_SIZE; -/* Pointer to the first symbol_block that contains pinned symbols. - Tests for 24.4 showed that at dump-time, Emacs contains about 15K symbols, - 10K of which are pinned (and all but 250 of them are interned in obarray), - whereas a "typical session" has in the order of 30K symbols. - `symbol_block_pinned' lets mark_pinned_symbols scan only 15K symbols rather - than 30K to find the 10K symbols we need to mark. */ -static struct symbol_block *symbol_block_pinned; /* List of free symbols. */ @@ -3930,7 +3923,6 @@ init_symbol (Lisp_Object val, Lisp_Object name) p->u.s.interned = SYMBOL_UNINTERNED; p->u.s.trapped_write = SYMBOL_UNTRAPPED_WRITE; p->u.s.declared_special = false; - p->u.s.pinned = false; } DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0, @@ -5666,13 +5658,6 @@ Does not copy symbols. Copies strings without text properties. */) return purecopy (obj); } -/* Pinned objects are marked before every GC cycle. */ -static struct pinned_object -{ - Lisp_Object object; - struct pinned_object *next; -} *pinned_objects; - static Lisp_Object purecopy (Lisp_Object obj) { @@ -5882,13 +5867,6 @@ compact_undo_list (Lisp_Object list) return list; } -static void -mark_pinned_objects (void) -{ - for (struct pinned_object *pobj = pinned_objects; pobj; pobj = pobj->next) - mark_object (pobj->object); -} - #if defined HAVE_ANDROID && !defined (__clang__) /* The Android gcc is broken and needs the following version of @@ -5912,29 +5890,6 @@ android_make_lisp_symbol (struct Lisp_Symbol *sym) #endif -static void -mark_pinned_symbols (void) -{ - struct symbol_block *sblk; - int lim; - struct Lisp_Symbol *sym, *end; - - if (symbol_block_pinned == symbol_block) - lim = symbol_block_index; - else - lim = SYMBOL_BLOCK_SIZE; - - for (sblk = symbol_block_pinned; sblk; sblk = sblk->next) - { - sym = sblk->symbols, end = sym + lim; - for (; sym < end; ++sym) - if (sym->u.s.pinned) - mark_object (make_lisp_symbol (sym)); - - lim = SYMBOL_BLOCK_SIZE; - } -} - static void visit_vectorlike_root (struct gc_root_visitor visitor, struct Lisp_Vector *ptr, @@ -6198,8 +6153,6 @@ garbage_collect (void) struct gc_root_visitor visitor = { .visit = mark_object_root_visitor }; visit_static_gc_roots (visitor); - mark_pinned_objects (); - mark_pinned_symbols (); mark_lread (); mark_terminals (); mark_kboards (); diff --git a/src/lisp.h b/src/lisp.h index 93469a5c63e..1370fe7e30f 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -797,9 +797,6 @@ struct Lisp_Symbol special (with `defvar' etc), and shouldn't be lexically bound. */ bool_bf declared_special : 1; - /* True if pointed to from purespace and hence can't be GC'd. */ - bool_bf pinned : 1; - /* The symbol's name, as a Lisp string. */ Lisp_Object name; diff --git a/src/pdumper.c b/src/pdumper.c index 1d45e37d67e..5a55dccf09f 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2502,7 +2502,6 @@ dump_symbol (struct dump_context *ctx, DUMP_FIELD_COPY (&out, symbol, u.s.trapped_write); DUMP_FIELD_COPY (&out, symbol, u.s.interned); DUMP_FIELD_COPY (&out, symbol, u.s.declared_special); - DUMP_FIELD_COPY (&out, symbol, u.s.pinned); dump_field_lv (ctx, &out, symbol, &symbol->u.s.name, WEIGHT_STRONG); switch (symbol->u.s.redirect) { commit 5ec86966638885a0f8df8afa28a01ca103ad2a49 Author: Pip Cet Date: Tue Aug 20 19:00:20 2024 +0000 Pure storage removal: Replace calls to removed functions * src/alloc.c (string_bytes, pin_string, valid_lisp_object_p) (process_mark_stack, survives_gc_p, syms_of_alloc): * src/androidterm.c (android_term_init): Replace call to 'build_pure_c_string'. * src/buffer.c (init_buffer_once, syms_of_buffer): * src/bytecode.c (exec_byte_code): * src/callint.c (syms_of_callint): * src/callproc.c (syms_of_callproc): * src/category.c (Fdefine_category): * src/coding.c (syms_of_coding): * src/comp.c (Fcomp__compile_ctxt_to_file0) (maybe_defer_native_compilation, syms_of_comp): * src/data.c (Fsetcar, Fsetcdr, Fdefalias, Faset, syms_of_data): * src/dbusbind.c (syms_of_dbusbind): * src/doc.c (Fsnarf_documentation): * src/emacs-module.c (syms_of_module): * src/eval.c (Finternal__define_uninitialized_variable) (Fdefconst_1, define_error, syms_of_eval): * src/fileio.c (syms_of_fileio): * src/fns.c (Ffillarray, Fclear_string, check_mutable_hash_table): * src/fontset.c (syms_of_fontset): * src/frame.c (make_initial_frame): * src/haikufns.c (syms_of_haikufns): * src/intervals.c (create_root_interval): * src/keyboard.c (syms_of_keyboard): * src/keymap.c (Fmake_sparse_keymap, Fset_keymap_parent) (store_in_keymap, syms_of_keymap): * src/lisp.h: * src/lread.c (Fload, read0, intern_c_string_1, define_symbol) (Fintern, defsubr, syms_of_lread): * src/pdumper.c (Fdump_emacs_portable): * src/pgtkfns.c (syms_of_pgtkfns): * src/pgtkterm.c (syms_of_pgtkterm): * src/process.c (syms_of_process): * src/search.c (syms_of_search): * src/sqlite.c (syms_of_sqlite): * src/syntax.c (syms_of_syntax): * src/treesit.c (syms_of_treesit): * src/w32fns.c (syms_of_w32fns): * src/xdisp.c (syms_of_xdisp): * src/xfaces.c (syms_of_xfaces): * src/xfns.c (syms_of_xfns): * src/xftfont.c (syms_of_xftfont): * src/xterm.c (syms_of_xterm): Remove calls to 'PURE_P', 'CHECK_IMPURE', 'Fpurecopy', and replace calls to 'build_pure_c_string', 'pure_list', 'pure_listn', etc., by impure equivalents. diff --git a/src/alloc.c b/src/alloc.c index a9df5ca885f..ff491719547 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -1765,7 +1765,7 @@ string_bytes (struct Lisp_String *s) ptrdiff_t nbytes = (s->u.s.size_byte < 0 ? s->u.s.size & ~ARRAY_MARK_FLAG : s->u.s.size_byte); - if (!PURE_P (s) && !pdumper_object_p (s) && s->u.s.data + if (!pdumper_object_p (s) && s->u.s.data && nbytes != SDATA_NBYTES (SDATA_OF_STRING (s))) emacs_abort (); return nbytes; @@ -2612,7 +2612,7 @@ pin_string (Lisp_Object string) unsigned char *data = s->u.s.data; if (!(size > LARGE_STRING_BYTES - || PURE_P (data) || pdumper_object_p (data) + || pdumper_object_p (data) || s->u.s.size_byte == -3)) { eassert (s->u.s.size_byte == -1); @@ -5570,8 +5570,6 @@ valid_lisp_object_p (Lisp_Object obj) return 1; void *p = XPNTR (obj); - if (PURE_P (p)) - return 1; if (BARE_SYMBOL_P (obj) && c_symbol_p (p)) return ((char *) p - (char *) lispsym) % sizeof lispsym[0] == 0; @@ -6756,8 +6754,6 @@ process_mark_stack (ptrdiff_t base_sp) Lisp_Object obj = mark_stack_pop (); mark_obj: ; void *po = XPNTR (obj); - if (PURE_P (po)) - continue; #if GC_REMEMBER_LAST_MARKED last_marked[last_marked_index++] = obj; @@ -7001,8 +6997,7 @@ process_mark_stack (ptrdiff_t base_sp) break; default: emacs_abort (); } - if (!PURE_P (XSTRING (ptr->u.s.name))) - set_string_marked (XSTRING (ptr->u.s.name)); + set_string_marked (XSTRING (ptr->u.s.name)); mark_interval_tree (string_intervals (ptr->u.s.name)); /* Inner loop to mark next symbol in this bucket, if any. */ po = ptr = ptr->u.s.next; @@ -7135,7 +7130,7 @@ survives_gc_p (Lisp_Object obj) emacs_abort (); } - return survives_p || PURE_P (XPNTR (obj)); + return survives_p; } @@ -7804,10 +7799,10 @@ allocated but to know if we're in the preload phase of Emacs's build. */); /* We build this in advance because if we wait until we need it, we might not be able to allocate the memory to hold it. */ Vmemory_signal_data - = pure_list (Qerror, - build_pure_c_string ("Memory exhausted--use" - " M-x save-some-buffers then" - " exit and restart Emacs")); + = list (Qerror, + build_string ("Memory exhausted--use" + " M-x save-some-buffers then" + " exit and restart Emacs")); DEFVAR_LISP ("memory-full", Vmemory_full, doc: /* Non-nil means Emacs cannot get much more Lisp memory. */); diff --git a/src/androidterm.c b/src/androidterm.c index 4561f2d1df3..c0470176489 100644 --- a/src/androidterm.c +++ b/src/androidterm.c @@ -6632,7 +6632,7 @@ android_term_init (void) x_display_list = dpyinfo; dpyinfo->name_list_element - = Fcons (build_pure_c_string ("android"), Qnil); + = Fcons (build_string ("android"), Qnil); color_file = Fexpand_file_name (build_string ("rgb.txt"), Vdata_directory); diff --git a/src/buffer.c b/src/buffer.c index 663a47ec72f..c6e7d9679ae 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -4788,8 +4788,8 @@ init_buffer_once (void) set_buffer_intervals (&buffer_defaults, NULL); set_buffer_intervals (&buffer_local_symbols, NULL); /* This is not strictly necessary, but let's make them initialized. */ - bset_name (&buffer_defaults, build_pure_c_string (" *buffer-defaults*")); - bset_name (&buffer_local_symbols, build_pure_c_string (" *buffer-local-symbols*")); + bset_name (&buffer_defaults, build_string (" *buffer-defaults*")); + bset_name (&buffer_local_symbols, build_string (" *buffer-local-symbols*")); BUFFER_PVEC_INIT (&buffer_defaults); BUFFER_PVEC_INIT (&buffer_local_symbols); @@ -4797,7 +4797,7 @@ init_buffer_once (void) /* Must do these before making the first buffer! */ /* real setup is done in bindings.el */ - bset_mode_line_format (&buffer_defaults, build_pure_c_string ("%-")); + bset_mode_line_format (&buffer_defaults, build_string ("%-")); bset_header_line_format (&buffer_defaults, Qnil); bset_tab_line_format (&buffer_defaults, Qnil); bset_abbrev_mode (&buffer_defaults, Qnil); @@ -4865,7 +4865,7 @@ init_buffer_once (void) current_buffer = 0; pdumper_remember_lv_ptr_raw (¤t_buffer, Lisp_Vectorlike); - QSFundamental = build_pure_c_string ("Fundamental"); + QSFundamental = build_string ("Fundamental"); DEFSYM (Qfundamental_mode, "fundamental-mode"); bset_major_mode (&buffer_defaults, Qfundamental_mode); @@ -4879,10 +4879,10 @@ init_buffer_once (void) /* Super-magic invisible buffer. */ Vprin1_to_string_buffer = - Fget_buffer_create (build_pure_c_string (" prin1"), Qt); + Fget_buffer_create (build_string (" prin1"), Qt); Vbuffer_alist = Qnil; - Fset_buffer (Fget_buffer_create (build_pure_c_string ("*scratch*"), Qnil)); + Fset_buffer (Fget_buffer_create (build_string ("*scratch*"), Qnil)); inhibit_modification_hooks = 0; } @@ -5066,9 +5066,9 @@ syms_of_buffer (void) Qoverwrite_mode_binary)); Fput (Qprotected_field, Qerror_conditions, - pure_list (Qprotected_field, Qerror)); + list (Qprotected_field, Qerror)); Fput (Qprotected_field, Qerror_message, - build_pure_c_string ("Attempt to modify a protected field")); + build_string ("Attempt to modify a protected field")); DEFSYM (Qclone_indirect_buffer_hook, "clone-indirect-buffer-hook"); diff --git a/src/bytecode.c b/src/bytecode.c index f719b036d14..75a040a8489 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1638,7 +1638,6 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, record_in_backtrace (Qsetcar, &TOP, 2); wrong_type_argument (Qconsp, cell); } - CHECK_IMPURE (cell, XCONS (cell)); XSETCAR (cell, newval); TOP = newval; NEXT; @@ -1653,7 +1652,6 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, record_in_backtrace (Qsetcdr, &TOP, 2); wrong_type_argument (Qconsp, cell); } - CHECK_IMPURE (cell, XCONS (cell)); XSETCDR (cell, newval); TOP = newval; NEXT; diff --git a/src/callint.c b/src/callint.c index 1af9666e5a4..02279725bce 100644 --- a/src/callint.c +++ b/src/callint.c @@ -822,10 +822,10 @@ syms_of_callint (void) callint_message = Qnil; staticpro (&callint_message); - preserved_fns = pure_list (intern_c_string ("region-beginning"), - intern_c_string ("region-end"), - intern_c_string ("point"), - intern_c_string ("mark")); + preserved_fns = list (intern_c_string ("region-beginning"), + intern_c_string ("region-end"), + intern_c_string ("point"), + intern_c_string ("mark")); staticpro (&preserved_fns); DEFSYM (Qlist, "list"); diff --git a/src/callproc.c b/src/callproc.c index 3f2c60a2151..361fbebb93f 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -2171,9 +2171,9 @@ See `setenv' and `getenv'. */); Use this instead of calling `ctags' directly, as `ctags' may have been renamed to comply with executable naming restrictions on the system. */); #if !defined HAVE_ANDROID || defined ANDROID_STUBIFY - Vctags_program_name = build_pure_c_string ("ctags"); + Vctags_program_name = build_string ("ctags"); #else - Vctags_program_name = build_pure_c_string ("libctags.so"); + Vctags_program_name = build_string ("libctags.so"); #endif DEFVAR_LISP ("etags-program-name", Vetags_program_name, @@ -2181,9 +2181,9 @@ renamed to comply with executable naming restrictions on the system. */); Use this instead of calling `etags' directly, as `etags' may have been renamed to comply with executable naming restrictions on the system. */); #if !defined HAVE_ANDROID || defined ANDROID_STUBIFY - Vetags_program_name = build_pure_c_string ("etags"); + Vetags_program_name = build_string ("etags"); #else - Vetags_program_name = build_pure_c_string ("libetags.so"); + Vetags_program_name = build_string ("libetags.so"); #endif DEFVAR_LISP ("hexl-program-name", Vhexl_program_name, @@ -2191,9 +2191,9 @@ renamed to comply with executable naming restrictions on the system. */); Use this instead of calling `hexl' directly, as `hexl' may have been renamed to comply with executable naming restrictions on the system. */); #if !defined HAVE_ANDROID || defined ANDROID_STUBIFY - Vhexl_program_name = build_pure_c_string ("hexl"); + Vhexl_program_name = build_string ("hexl"); #else - Vhexl_program_name = build_pure_c_string ("libhexl.so"); + Vhexl_program_name = build_string ("libhexl.so"); #endif DEFVAR_LISP ("emacsclient-program-name", Vemacsclient_program_name, @@ -2202,9 +2202,9 @@ Use this instead of calling `emacsclient' directly, as `emacsclient' may have been renamed to comply with executable naming restrictions on the system. */); #if !defined HAVE_ANDROID || defined ANDROID_STUBIFY - Vemacsclient_program_name = build_pure_c_string ("emacsclient"); + Vemacsclient_program_name = build_string ("emacsclient"); #else - Vemacsclient_program_name = build_pure_c_string ("libemacsclient.so"); + Vemacsclient_program_name = build_string ("libemacsclient.so"); #endif DEFVAR_LISP ("movemail-program-name", Vmovemail_program_name, @@ -2216,9 +2216,9 @@ the system. */); use movemail from another source. */ #if !defined HAVE_ANDROID || defined ANDROID_STUBIFY \ || defined HAVE_MAILUTILS - Vmovemail_program_name = build_pure_c_string ("movemail"); + Vmovemail_program_name = build_string ("movemail"); #else - Vmovemail_program_name = build_pure_c_string ("libmovemail.so"); + Vmovemail_program_name = build_string ("libmovemail.so"); #endif DEFVAR_LISP ("ebrowse-program-name", Vebrowse_program_name, @@ -2227,9 +2227,9 @@ Use this instead of calling `ebrowse' directly, as `ebrowse' may have been renamed to comply with executable naming restrictions on the system. */); #if !defined HAVE_ANDROID || defined ANDROID_STUBIFY - Vebrowse_program_name = build_pure_c_string ("ebrowse"); + Vebrowse_program_name = build_string ("ebrowse"); #else - Vebrowse_program_name = build_pure_c_string ("libebrowse.so"); + Vebrowse_program_name = build_string ("libebrowse.so"); #endif DEFVAR_LISP ("rcs2log-program-name", Vrcs2log_program_name, @@ -2238,9 +2238,9 @@ Use this instead of calling `rcs2log' directly, as `rcs2log' may have been renamed to comply with executable naming restrictions on the system. */); #if !defined HAVE_ANDROID || defined ANDROID_STUBIFY - Vrcs2log_program_name = build_pure_c_string ("rcs2log"); + Vrcs2log_program_name = build_string ("rcs2log"); #else /* HAVE_ANDROID && !ANDROID_STUBIFY */ - Vrcs2log_program_name = build_pure_c_string ("librcs2log.so"); + Vrcs2log_program_name = build_string ("librcs2log.so"); #endif /* !HAVE_ANDROID || ANDROID_STUBIFY */ defsubr (&Scall_process); diff --git a/src/category.c b/src/category.c index 498b6a2a1c9..ef29a1a681a 100644 --- a/src/category.c +++ b/src/category.c @@ -118,8 +118,6 @@ the current buffer's category table. */) if (!NILP (CATEGORY_DOCSTRING (table, XFIXNAT (category)))) error ("Category `%c' is already defined", (int) XFIXNAT (category)); - if (!NILP (Vpurify_flag)) - docstring = Fpurecopy (docstring); SET_CATEGORY_DOCSTRING (table, XFIXNAT (category), docstring); return Qnil; diff --git a/src/coding.c b/src/coding.c index cd5a12972e6..ae7979d86eb 100644 --- a/src/coding.c +++ b/src/coding.c @@ -11766,7 +11766,7 @@ syms_of_coding (void) Vcode_conversion_reused_workbuf = Qnil; staticpro (&Vcode_conversion_workbuf_name); - Vcode_conversion_workbuf_name = build_pure_c_string (" *code-conversion-work*"); + Vcode_conversion_workbuf_name = build_string (" *code-conversion-work*"); reused_workbuf_in_use = false; PDUMPER_REMEMBER_SCALAR (reused_workbuf_in_use); @@ -11830,9 +11830,9 @@ syms_of_coding (void) /* Error signaled when there's a problem with detecting a coding system. */ DEFSYM (Qcoding_system_error, "coding-system-error"); Fput (Qcoding_system_error, Qerror_conditions, - pure_list (Qcoding_system_error, Qerror)); + list (Qcoding_system_error, Qerror)); Fput (Qcoding_system_error, Qerror_message, - build_pure_c_string ("Invalid coding system")); + build_string ("Invalid coding system")); DEFSYM (Qtranslation_table, "translation-table"); Fput (Qtranslation_table, Qchar_table_extra_slots, make_fixnum (2)); @@ -12107,22 +12107,22 @@ used for encoding standard output and error streams. */); DEFVAR_LISP ("eol-mnemonic-unix", eol_mnemonic_unix, doc: /* String displayed in mode line for UNIX-like (LF) end-of-line format. */); - eol_mnemonic_unix = build_pure_c_string (":"); + eol_mnemonic_unix = build_string (":"); DEFVAR_LISP ("eol-mnemonic-dos", eol_mnemonic_dos, doc: /* String displayed in mode line for DOS-like (CRLF) end-of-line format. */); - eol_mnemonic_dos = build_pure_c_string ("\\"); + eol_mnemonic_dos = build_string ("\\"); DEFVAR_LISP ("eol-mnemonic-mac", eol_mnemonic_mac, doc: /* String displayed in mode line for MAC-like (CR) end-of-line format. */); - eol_mnemonic_mac = build_pure_c_string ("/"); + eol_mnemonic_mac = build_string ("/"); DEFVAR_LISP ("eol-mnemonic-undecided", eol_mnemonic_undecided, doc: /* String displayed in mode line when end-of-line format is not yet determined. */); - eol_mnemonic_undecided = build_pure_c_string (":"); + eol_mnemonic_undecided = build_string (":"); DEFVAR_LISP ("enable-character-translation", Venable_character_translation, doc: /* @@ -12262,7 +12262,7 @@ internal character representation. */); intern_c_string (":for-unibyte"), args[coding_arg_for_unibyte] = Qt, intern_c_string (":docstring"), - (build_pure_c_string + (build_string ("Do no conversion.\n" "\n" "When you visit a file with this coding, the file is read into a\n" @@ -12282,7 +12282,7 @@ internal character representation. */); plist[8] = intern_c_string (":charset-list"); plist[9] = args[coding_arg_charset_list] = list1 (Qascii); plist[11] = args[coding_arg_for_unibyte] = Qnil; - plist[13] = build_pure_c_string ("No conversion on encoding, " + plist[13] = build_string ("No conversion on encoding, " "automatic conversion on decoding."); plist[15] = args[coding_arg_eol_type] = Qnil; args[coding_arg_plist] = CALLMANY (Flist, plist); diff --git a/src/comp.c b/src/comp.c index e89385de1d6..e43732f369e 100644 --- a/src/comp.c +++ b/src/comp.c @@ -4961,7 +4961,6 @@ DEFUN ("comp--compile-ctxt-to-file0", Fcomp__compile_ctxt_to_file0, define_GET_SYMBOL_WITH_POSITION (); define_CHECK_TYPE (); define_SYMBOL_WITH_POS_SYM (); - define_CHECK_IMPURE (); define_bool_to_lisp_obj (); define_setcar_setcdr (); define_add1_sub1 (); @@ -5209,10 +5208,10 @@ maybe_defer_native_compilation (Lisp_Object function_name, Lisp_Object src = concat2 (CALL1I (file-name-sans-extension, Vload_true_file_name), - build_pure_c_string (".el")); + build_string (".el")); if (NILP (Ffile_exists_p (src))) { - src = concat2 (src, build_pure_c_string (".gz")); + src = concat2 (src, build_string (".gz")); if (NILP (Ffile_exists_p (src))) return; } @@ -5767,48 +5766,48 @@ natively-compiled one. */); /* To be signaled by the compiler. */ DEFSYM (Qnative_compiler_error, "native-compiler-error"); Fput (Qnative_compiler_error, Qerror_conditions, - pure_list (Qnative_compiler_error, Qerror)); + list (Qnative_compiler_error, Qerror)); Fput (Qnative_compiler_error, Qerror_message, - build_pure_c_string ("Native compiler error")); + build_string ("Native compiler error")); DEFSYM (Qnative_ice, "native-ice"); Fput (Qnative_ice, Qerror_conditions, - pure_list (Qnative_ice, Qnative_compiler_error, Qerror)); + list (Qnative_ice, Qnative_compiler_error, Qerror)); Fput (Qnative_ice, Qerror_message, - build_pure_c_string ("Internal native compiler error")); + build_string ("Internal native compiler error")); /* By the load machinery. */ DEFSYM (Qnative_lisp_load_failed, "native-lisp-load-failed"); Fput (Qnative_lisp_load_failed, Qerror_conditions, - pure_list (Qnative_lisp_load_failed, Qerror)); + list (Qnative_lisp_load_failed, Qerror)); Fput (Qnative_lisp_load_failed, Qerror_message, - build_pure_c_string ("Native elisp load failed")); + build_string ("Native elisp load failed")); DEFSYM (Qnative_lisp_wrong_reloc, "native-lisp-wrong-reloc"); Fput (Qnative_lisp_wrong_reloc, Qerror_conditions, - pure_list (Qnative_lisp_wrong_reloc, Qnative_lisp_load_failed, Qerror)); + list (Qnative_lisp_wrong_reloc, Qnative_lisp_load_failed, Qerror)); Fput (Qnative_lisp_wrong_reloc, Qerror_message, - build_pure_c_string ("Primitive redefined or wrong relocation")); + build_string ("Primitive redefined or wrong relocation")); DEFSYM (Qwrong_register_subr_call, "wrong-register-subr-call"); Fput (Qwrong_register_subr_call, Qerror_conditions, - pure_list (Qwrong_register_subr_call, Qnative_lisp_load_failed, Qerror)); + list (Qwrong_register_subr_call, Qnative_lisp_load_failed, Qerror)); Fput (Qwrong_register_subr_call, Qerror_message, - build_pure_c_string ("comp--register-subr can only be called during " - "native lisp load phase.")); + build_string ("comp--register-subr can only be called during " + "native lisp load phase.")); DEFSYM (Qnative_lisp_file_inconsistent, "native-lisp-file-inconsistent"); Fput (Qnative_lisp_file_inconsistent, Qerror_conditions, - pure_list (Qnative_lisp_file_inconsistent, Qnative_lisp_load_failed, Qerror)); + list (Qnative_lisp_file_inconsistent, Qnative_lisp_load_failed, Qerror)); Fput (Qnative_lisp_file_inconsistent, Qerror_message, - build_pure_c_string ("eln file inconsistent with current runtime " - "configuration, please recompile")); + build_string ("eln file inconsistent with current runtime " + "configuration, please recompile")); DEFSYM (Qcomp_sanitizer_error, "comp-sanitizer-error"); Fput (Qcomp_sanitizer_error, Qerror_conditions, - pure_list (Qcomp_sanitizer_error, Qerror)); + list (Qcomp_sanitizer_error, Qerror)); Fput (Qcomp_sanitizer_error, Qerror_message, - build_pure_c_string ("Native code sanitizer runtime error")); + build_string ("Native code sanitizer runtime error")); DEFSYM (Qnative__compile_async, "native--compile-async"); diff --git a/src/data.c b/src/data.c index 95c1d857964..9492c8041c8 100644 --- a/src/data.c +++ b/src/data.c @@ -687,7 +687,6 @@ DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0, (register Lisp_Object cell, Lisp_Object newcar) { CHECK_CONS (cell); - CHECK_IMPURE (cell, XCONS (cell)); XSETCAR (cell, newcar); return newcar; } @@ -697,7 +696,6 @@ DEFUN ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0, (register Lisp_Object cell, Lisp_Object newcdr) { CHECK_CONS (cell); - CHECK_IMPURE (cell, XCONS (cell)); XSETCDR (cell, newcdr); return newcdr; } @@ -995,10 +993,6 @@ The return value is undefined. */) (register Lisp_Object symbol, Lisp_Object definition, Lisp_Object docstring) { CHECK_SYMBOL (symbol); - if (!NILP (Vpurify_flag) - /* If `definition' is a keymap, immutable (and copying) is wrong. */ - && !KEYMAPP (definition)) - definition = Fpurecopy (definition); defalias (symbol, definition); @@ -2588,7 +2582,6 @@ bool-vector. IDX starts at 0. */) if (VECTORP (array)) { - CHECK_IMPURE (array, XVECTOR (array)); if (idxval < 0 || idxval >= ASIZE (array)) args_out_of_range (array, idx); ASET (array, idxval, newelt); @@ -2606,14 +2599,12 @@ bool-vector. IDX starts at 0. */) } else if (RECORDP (array)) { - CHECK_IMPURE (array, XVECTOR (array)); if (idxval < 0 || idxval >= PVSIZE (array)) args_out_of_range (array, idx); ASET (array, idxval, newelt); } else /* STRINGP */ { - CHECK_IMPURE (array, XSTRING (array)); if (idxval < 0 || idxval >= SCHARS (array)) args_out_of_range (array, idx); CHECK_CHARACTER (newelt); @@ -4072,7 +4063,7 @@ syms_of_data (void) DEFSYM (Qaref, "aref"); DEFSYM (Qaset, "aset"); - error_tail = pure_cons (Qerror, Qnil); + error_tail = Fcons (Qerror, Qnil); /* ERROR is used as a signaler for random errors for which nothing else is right. */ @@ -4080,14 +4071,14 @@ syms_of_data (void) Fput (Qerror, Qerror_conditions, error_tail); Fput (Qerror, Qerror_message, - build_pure_c_string ("error")); + build_string ("error")); #define PUT_ERROR(sym, tail, msg) \ - Fput (sym, Qerror_conditions, pure_cons (sym, tail)); \ - Fput (sym, Qerror_message, build_pure_c_string (msg)) + Fput (sym, Qerror_conditions, Fcons (sym, tail)); \ + Fput (sym, Qerror_message, build_string (msg)) PUT_ERROR (Qquit, Qnil, "Quit"); - PUT_ERROR (Qminibuffer_quit, pure_cons (Qquit, Qnil), "Quit"); + PUT_ERROR (Qminibuffer_quit, Fcons (Qquit, Qnil), "Quit"); PUT_ERROR (Quser_error, error_tail, ""); PUT_ERROR (Qwrong_length_argument, error_tail, "Wrong length argument"); @@ -4114,14 +4105,14 @@ syms_of_data (void) PUT_ERROR (Qno_catch, error_tail, "No catch for tag"); PUT_ERROR (Qend_of_file, error_tail, "End of file during parsing"); - arith_tail = pure_cons (Qarith_error, error_tail); + arith_tail = Fcons (Qarith_error, error_tail); Fput (Qarith_error, Qerror_conditions, arith_tail); - Fput (Qarith_error, Qerror_message, build_pure_c_string ("Arithmetic error")); + Fput (Qarith_error, Qerror_message, build_string ("Arithmetic error")); PUT_ERROR (Qbeginning_of_buffer, error_tail, "Beginning of buffer"); PUT_ERROR (Qend_of_buffer, error_tail, "End of buffer"); PUT_ERROR (Qbuffer_read_only, error_tail, "Buffer is read-only"); - PUT_ERROR (Qtext_read_only, pure_cons (Qbuffer_read_only, error_tail), + PUT_ERROR (Qtext_read_only, Fcons (Qbuffer_read_only, error_tail), "Text is read-only"); PUT_ERROR (Qinhibited_interaction, error_tail, "User interaction while inhibited"); @@ -4144,10 +4135,10 @@ syms_of_data (void) PUT_ERROR (Qunderflow_error, Fcons (Qrange_error, arith_tail), "Arithmetic underflow error"); - recursion_tail = pure_cons (Qrecursion_error, error_tail); + recursion_tail = Fcons (Qrecursion_error, error_tail); Fput (Qrecursion_error, Qerror_conditions, recursion_tail); - Fput (Qrecursion_error, Qerror_message, build_pure_c_string - ("Excessive recursive calling error")); + Fput (Qrecursion_error, Qerror_message, + build_string ("Excessive recursive calling error")); PUT_ERROR (Qexcessive_lisp_nesting, recursion_tail, "Lisp nesting exceeds `max-lisp-eval-depth'"); diff --git a/src/dbusbind.c b/src/dbusbind.c index 1a8bcfdf5d4..ab48936cc87 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -1909,7 +1909,7 @@ syms_of_dbusbind (void) Fput (Qdbus_error, Qerror_conditions, list2 (Qdbus_error, Qerror)); Fput (Qdbus_error, Qerror_message, - build_pure_c_string ("D-Bus error")); + build_string ("D-Bus error")); DEFSYM (QD_Bus, "D-Bus"); /* Lisp symbols of the system and session buses. */ @@ -1959,7 +1959,7 @@ syms_of_dbusbind (void) Vdbus_compiled_version, doc: /* The version of D-Bus Emacs is compiled against. */); #ifdef DBUS_VERSION_STRING - Vdbus_compiled_version = build_pure_c_string (DBUS_VERSION_STRING); + Vdbus_compiled_version = build_string (DBUS_VERSION_STRING); #else Vdbus_compiled_version = Qnil; #endif diff --git a/src/doc.c b/src/doc.c index fdb61be2097..6f74a999366 100644 --- a/src/doc.c +++ b/src/doc.c @@ -559,7 +559,6 @@ the same file name is found in the `doc-directory'. */) int i = ARRAYELTS (buildobj); while (0 <= --i) Vbuild_files = Fcons (build_string (buildobj[i]), Vbuild_files); - Vbuild_files = Fpurecopy (Vbuild_files); } fd = doc_open (name, O_RDONLY, 0); diff --git a/src/emacs-module.c b/src/emacs-module.c index e267ba165fd..d818b6cdeb9 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -1713,40 +1713,40 @@ syms_of_module (void) DEFSYM (Qmodule_load_failed, "module-load-failed"); Fput (Qmodule_load_failed, Qerror_conditions, - pure_list (Qmodule_load_failed, Qerror)); + list (Qmodule_load_failed, Qerror)); Fput (Qmodule_load_failed, Qerror_message, - build_pure_c_string ("Module load failed")); + build_string ("Module load failed")); DEFSYM (Qmodule_open_failed, "module-open-failed"); Fput (Qmodule_open_failed, Qerror_conditions, - pure_list (Qmodule_open_failed, Qmodule_load_failed, Qerror)); + list (Qmodule_open_failed, Qmodule_load_failed, Qerror)); Fput (Qmodule_open_failed, Qerror_message, - build_pure_c_string ("Module could not be opened")); + build_string ("Module could not be opened")); DEFSYM (Qmodule_not_gpl_compatible, "module-not-gpl-compatible"); Fput (Qmodule_not_gpl_compatible, Qerror_conditions, - pure_list (Qmodule_not_gpl_compatible, Qmodule_load_failed, Qerror)); + list (Qmodule_not_gpl_compatible, Qmodule_load_failed, Qerror)); Fput (Qmodule_not_gpl_compatible, Qerror_message, - build_pure_c_string ("Module is not GPL compatible")); + build_string ("Module is not GPL compatible")); DEFSYM (Qmissing_module_init_function, "missing-module-init-function"); Fput (Qmissing_module_init_function, Qerror_conditions, - pure_list (Qmissing_module_init_function, Qmodule_load_failed, - Qerror)); + list (Qmissing_module_init_function, Qmodule_load_failed, + Qerror)); Fput (Qmissing_module_init_function, Qerror_message, - build_pure_c_string ("Module does not export an " + build_string ("Module does not export an " "initialization function")); DEFSYM (Qmodule_init_failed, "module-init-failed"); Fput (Qmodule_init_failed, Qerror_conditions, - pure_list (Qmodule_init_failed, Qmodule_load_failed, Qerror)); + list (Qmodule_init_failed, Qmodule_load_failed, Qerror)); Fput (Qmodule_init_failed, Qerror_message, - build_pure_c_string ("Module initialization failed")); + build_string ("Module initialization failed")); DEFSYM (Qinvalid_arity, "invalid-arity"); - Fput (Qinvalid_arity, Qerror_conditions, pure_list (Qinvalid_arity, Qerror)); + Fput (Qinvalid_arity, Qerror_conditions, list (Qinvalid_arity, Qerror)); Fput (Qinvalid_arity, Qerror_message, - build_pure_c_string ("Invalid function arity")); + build_string ("Invalid function arity")); DEFSYM (Qmodule_function_p, "module-function-p"); DEFSYM (Qunicode_string_p, "unicode-string-p"); diff --git a/src/eval.c b/src/eval.c index d0a2abf0089..6d0e8f101d7 100644 --- a/src/eval.c +++ b/src/eval.c @@ -817,8 +817,6 @@ value. */) XSYMBOL (symbol)->u.s.declared_special = true; if (!NILP (doc)) { - if (!NILP (Vpurify_flag)) - doc = Fpurecopy (doc); Fput (symbol, Qvariable_documentation, doc); } LOADHIST_ATTACH (symbol); @@ -967,8 +965,6 @@ More specifically, behaves like (defconst SYM 'INITVALUE DOCSTRING). */) CHECK_SYMBOL (sym); Lisp_Object tem = initvalue; Finternal__define_uninitialized_variable (sym, docstring); - if (!NILP (Vpurify_flag)) - tem = Fpurecopy (tem); Fset_default (sym, tem); /* FIXME: set-default-toplevel-value? */ Fput (sym, Qrisky_local_variable, Qt); /* FIXME: Why? */ return sym; @@ -2001,8 +1997,8 @@ define_error (Lisp_Object name, const char *message, Lisp_Object parent) eassert (CONSP (parent_conditions)); eassert (!NILP (Fmemq (parent, parent_conditions))); eassert (NILP (Fmemq (name, parent_conditions))); - Fput (name, Qerror_conditions, pure_cons (name, parent_conditions)); - Fput (name, Qerror_message, build_pure_c_string (message)); + Fput (name, Qerror_conditions, Fcons (name, parent_conditions)); + Fput (name, Qerror_message, build_string (message)); } /* Use this for arithmetic overflow, e.g., when an integer result is @@ -4477,7 +4473,7 @@ alist of active lexical bindings. */); also use something like Fcons (Qnil, Qnil), but json.c treats any cons cell as error data, so use an uninterned symbol instead. */ Qcatch_all_memory_full - = Fmake_symbol (build_pure_c_string ("catch-all-memory-full")); + = Fmake_symbol (build_string ("catch-all-memory-full")); staticpro (&list_of_t); list_of_t = list1 (Qt); diff --git a/src/fileio.c b/src/fileio.c index 94bb496f22c..30ed2ddeb55 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -6666,39 +6666,39 @@ behaves as if file names were encoded in `utf-8'. */); DEFSYM (Qcar_less_than_car, "car-less-than-car"); Fput (Qfile_error, Qerror_conditions, - Fpurecopy (list2 (Qfile_error, Qerror))); + list2 (Qfile_error, Qerror)); Fput (Qfile_error, Qerror_message, - build_pure_c_string ("File error")); + build_string ("File error")); Fput (Qfile_already_exists, Qerror_conditions, - Fpurecopy (list3 (Qfile_already_exists, Qfile_error, Qerror))); + list3 (Qfile_already_exists, Qfile_error, Qerror)); Fput (Qfile_already_exists, Qerror_message, - build_pure_c_string ("File already exists")); + build_string ("File already exists")); Fput (Qfile_date_error, Qerror_conditions, - Fpurecopy (list3 (Qfile_date_error, Qfile_error, Qerror))); + list3 (Qfile_date_error, Qfile_error, Qerror)); Fput (Qfile_date_error, Qerror_message, - build_pure_c_string ("Cannot set file date")); + build_string ("Cannot set file date")); Fput (Qfile_missing, Qerror_conditions, - Fpurecopy (list3 (Qfile_missing, Qfile_error, Qerror))); + list3 (Qfile_missing, Qfile_error, Qerror)); Fput (Qfile_missing, Qerror_message, - build_pure_c_string ("File is missing")); + build_string ("File is missing")); Fput (Qpermission_denied, Qerror_conditions, - Fpurecopy (list3 (Qpermission_denied, Qfile_error, Qerror))); + list3 (Qpermission_denied, Qfile_error, Qerror)); Fput (Qpermission_denied, Qerror_message, - build_pure_c_string ("Cannot access file or directory")); + build_string ("Cannot access file or directory")); Fput (Qfile_notify_error, Qerror_conditions, - Fpurecopy (list3 (Qfile_notify_error, Qfile_error, Qerror))); + list3 (Qfile_notify_error, Qfile_error, Qerror)); Fput (Qfile_notify_error, Qerror_message, - build_pure_c_string ("File notification error")); + build_string ("File notification error")); Fput (Qremote_file_error, Qerror_conditions, - Fpurecopy (list3 (Qremote_file_error, Qfile_error, Qerror))); + list3 (Qremote_file_error, Qfile_error, Qerror)); Fput (Qremote_file_error, Qerror_message, - build_pure_c_string ("Remote file error")); + build_string ("Remote file error")); DEFVAR_LISP ("file-name-handler-alist", Vfile_name_handler_alist, doc: /* Alist of elements (REGEXP . HANDLER) for file names handled specially. diff --git a/src/fns.c b/src/fns.c index cf337dc0808..75fd20a2d79 100644 --- a/src/fns.c +++ b/src/fns.c @@ -3266,7 +3266,6 @@ ARRAY is a vector, string, char-table, or bool-vector. */) size = SCHARS (array); if (size != 0) { - CHECK_IMPURE (array, XSTRING (array)); unsigned char str[MAX_MULTIBYTE_LENGTH]; int len; if (STRING_MULTIBYTE (array)) @@ -3307,7 +3306,6 @@ This makes STRING unibyte and may change its length. */) ptrdiff_t len = SBYTES (string); if (len != 0 || STRING_MULTIBYTE (string)) { - CHECK_IMPURE (string, XSTRING (string)); memset (SDATA (string), 0, len); STRING_SET_CHARS (string, len); STRING_SET_UNIBYTE (string); @@ -5127,7 +5125,6 @@ check_mutable_hash_table (Lisp_Object obj, struct Lisp_Hash_Table *h) { if (!h->mutable) signal_error ("hash table test modifies table", obj); - eassert (!PURE_P (h)); } /* Put an entry into hash table H that associates KEY with VALUE. diff --git a/src/fontset.c b/src/fontset.c index 755942138f7..ea35bb05e74 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -2174,7 +2174,7 @@ syms_of_fontset (void) set_fontset_id (Vdefault_fontset, make_fixnum (0)); set_fontset_name (Vdefault_fontset, - build_pure_c_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default")); + build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default")); ASET (Vfontset_table, 0, Vdefault_fontset); next_fontset_id = 1; PDUMPER_REMEMBER_SCALAR (next_fontset_id); @@ -2232,7 +2232,7 @@ alternate fontnames (if any) are tried instead. */); doc: /* Alist of fontset names vs the aliases. */); Vfontset_alias_alist = list1 (Fcons (FONTSET_NAME (Vdefault_fontset), - build_pure_c_string ("fontset-default"))); + build_string ("fontset-default"))); DEFVAR_LISP ("vertical-centering-font-regexp", Vvertical_centering_font_regexp, diff --git a/src/frame.c b/src/frame.c index f6053fca3ef..78fa41bbe62 100644 --- a/src/frame.c +++ b/src/frame.c @@ -1207,7 +1207,7 @@ make_initial_frame (void) Vframe_list = Fcons (frame, Vframe_list); tty_frame_count = 1; - fset_name (f, build_pure_c_string ("F1")); + fset_name (f, build_string ("F1")); SET_FRAME_VISIBLE (f, 1); diff --git a/src/haikufns.c b/src/haikufns.c index b4b88b434e4..c92dfe64ebc 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -3300,7 +3300,7 @@ invalid color. */); int len = sprintf (cairo_version, "%d.%d.%d", CAIRO_VERSION_MAJOR, CAIRO_VERSION_MINOR, CAIRO_VERSION_MICRO); - Vcairo_version_string = make_pure_string (cairo_version, len, len, false); + Vcairo_version_string = make_specified_string (cairo_version, len, len, false); } #endif diff --git a/src/intervals.c b/src/intervals.c index cebb77a3614..0e4ad249dc1 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -100,7 +100,6 @@ create_root_interval (Lisp_Object parent) } else { - CHECK_IMPURE (parent, XSTRING (parent)); new->total_length = SCHARS (parent); eassert (TOTAL_LENGTH (new) >= 0); set_string_intervals (parent, new); diff --git a/src/keyboard.c b/src/keyboard.c index 6d28dca9aeb..ab6dd65d5fc 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -12841,14 +12841,14 @@ syms_of_keyboard (void) pending_funcalls = Qnil; staticpro (&pending_funcalls); - Vlispy_mouse_stem = build_pure_c_string ("mouse"); + Vlispy_mouse_stem = build_string ("mouse"); staticpro (&Vlispy_mouse_stem); - regular_top_level_message = build_pure_c_string ("Back to top level"); + regular_top_level_message = build_string ("Back to top level"); staticpro (®ular_top_level_message); #ifdef HAVE_STACK_OVERFLOW_HANDLING recover_top_level_message - = build_pure_c_string ("Re-entering top level after C stack overflow"); + = build_string ("Re-entering top level after C stack overflow"); staticpro (&recover_top_level_message); #endif DEFVAR_LISP ("internal--top-level-message", Vinternal__top_level_message, diff --git a/src/keymap.c b/src/keymap.c index 7f464ed9159..a625ec9d8ca 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -120,8 +120,6 @@ in case you use it as a menu with `x-popup-menu'. */) { if (!NILP (string)) { - if (!NILP (Vpurify_flag)) - string = Fpurecopy (string); return list2 (Qkeymap, string); } return list1 (Qkeymap); @@ -300,7 +298,6 @@ Return PARENT. PARENT should be nil or another keymap. */) If we came to the end, add the parent in PREV. */ if (!CONSP (list) || KEYMAPP (list)) { - CHECK_IMPURE (prev, XCONS (prev)); XSETCDR (prev, parent); return parent; } @@ -743,7 +740,7 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, /* If we are preparing to dump, and DEF is a menu element with a menu item indicator, copy it to ensure it is not pure. */ - if (CONSP (def) && PURE_P (XCONS (def)) + if (CONSP (def) && (EQ (XCAR (def), Qmenu_item) || STRINGP (XCAR (def)))) def = Fcons (XCAR (def), XCDR (def)); @@ -787,7 +784,6 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, { if (FIXNATP (idx) && XFIXNAT (idx) < ASIZE (elt)) { - CHECK_IMPURE (elt, XVECTOR (elt)); ASET (elt, XFIXNAT (idx), def); return def; } @@ -845,7 +841,6 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, } else if (EQ (idx, XCAR (elt))) { - CHECK_IMPURE (elt, XCONS (elt)); if (remove) /* Remove the element. */ insertion_point = Fdelq (elt, insertion_point); @@ -900,7 +895,6 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, } else elt = Fcons (idx, def); - CHECK_IMPURE (insertion_point, XCONS (insertion_point)); XSETCDR (insertion_point, Fcons (elt, XCDR (insertion_point))); } } @@ -3356,12 +3350,12 @@ syms_of_keymap (void) current_global_map = Qnil; staticpro (¤t_global_map); - exclude_keys = pure_list - (pure_cons (build_pure_c_string ("DEL"), build_pure_c_string ("\\d")), - pure_cons (build_pure_c_string ("TAB"), build_pure_c_string ("\\t")), - pure_cons (build_pure_c_string ("RET"), build_pure_c_string ("\\r")), - pure_cons (build_pure_c_string ("ESC"), build_pure_c_string ("\\e")), - pure_cons (build_pure_c_string ("SPC"), build_pure_c_string (" "))); + exclude_keys = list + (Fcons (build_string ("DEL"), build_string ("\\d")), + Fcons (build_string ("TAB"), build_string ("\\t")), + Fcons (build_string ("RET"), build_string ("\\r")), + Fcons (build_string ("ESC"), build_string ("\\e")), + Fcons (build_string ("SPC"), build_string (" "))); staticpro (&exclude_keys); DEFVAR_LISP ("minibuffer-local-map", Vminibuffer_local_map, @@ -3423,13 +3417,13 @@ that describe key bindings. That is why the default is nil. */); DEFSYM (Qmode_line, "mode-line"); staticpro (&Vmouse_events); - Vmouse_events = pure_list (Qmenu_bar, Qtab_bar, Qtool_bar, - Qtab_line, Qheader_line, Qmode_line, - intern_c_string ("mouse-1"), - intern_c_string ("mouse-2"), - intern_c_string ("mouse-3"), - intern_c_string ("mouse-4"), - intern_c_string ("mouse-5")); + Vmouse_events = list (Qmenu_bar, Qtab_bar, Qtool_bar, Qtab_line, + Qheader_line, Qmode_line, + intern_c_string ("mouse-1"), + intern_c_string ("mouse-2"), + intern_c_string ("mouse-3"), + intern_c_string ("mouse-4"), + intern_c_string ("mouse-5")); /* Keymap used for minibuffers when doing completion. */ /* Keymap used for minibuffers when doing completion and require a match. */ diff --git a/src/lisp.h b/src/lisp.h index 4df3c999d73..93469a5c63e 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4584,7 +4584,6 @@ build_string (const char *str) return make_string (str, strlen (str)); } -extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object); extern Lisp_Object make_vector (ptrdiff_t, Lisp_Object); extern struct Lisp_Vector *allocate_nil_vector (ptrdiff_t) ATTRIBUTE_RETURNS_NONNULL; diff --git a/src/lread.c b/src/lread.c index c25ffb3c4fe..a95abd687ac 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1673,7 +1673,7 @@ Return t if the file exists and loads successfully. */) } if (! NILP (Vpurify_flag)) - Vpreloaded_file_list = Fcons (Fpurecopy (file), Vpreloaded_file_list); + Vpreloaded_file_list = Fcons (file, Vpreloaded_file_list); if (NILP (nomessage) || force_load_messages) { @@ -4433,10 +4433,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms) if (uninterned_symbol) { Lisp_Object name - = (!NILP (Vpurify_flag) - ? make_pure_string (read_buffer, nchars, nbytes, multibyte) - : make_specified_string (read_buffer, nchars, nbytes, - multibyte)); + = make_specified_string (read_buffer, nchars, nbytes, multibyte); result = Fmake_symbol (name); } else @@ -4968,10 +4965,7 @@ intern_c_string_1 (const char *str, ptrdiff_t len) { Lisp_Object string; - if (NILP (Vpurify_flag)) - string = make_string (str, len); - else - string = make_pure_c_string (str, len); + string = make_string (str, len); tem = intern_driver (string, obarray, tem); } @@ -4994,7 +4988,7 @@ static void define_symbol (Lisp_Object sym, char const *str) { ptrdiff_t len = strlen (str); - Lisp_Object string = make_pure_c_string (str, len); + Lisp_Object string = make_string (str, len); init_symbol (sym, string); /* Qunbound is uninterned, so that it's not confused with any symbol @@ -5038,8 +5032,7 @@ it defaults to the value of `obarray'. */) xfree (longhand); } else - tem = intern_driver (NILP (Vpurify_flag) ? string : Fpurecopy (string), - obarray, tem); + tem = intern_driver (string, obarray, tem); } return tem; } @@ -5483,7 +5476,7 @@ defsubr (union Aligned_Lisp_Subr *aname) set_symbol_function (sym, tem); #ifdef HAVE_NATIVE_COMP eassert (NILP (Vcomp_abi_hash)); - Vcomp_subr_list = Fpurecopy (Fcons (tem, Vcomp_subr_list)); + Vcomp_subr_list = Fcons (tem, Vcomp_subr_list); #endif } @@ -5869,19 +5862,19 @@ This list includes suffixes for both compiled and source Emacs Lisp files. This list should not include the empty string. `load' and related functions try to append these suffixes, in order, to the specified file name if a suffix is allowed or required. */); - Vload_suffixes = list2 (build_pure_c_string (".elc"), - build_pure_c_string (".el")); + Vload_suffixes = list2 (build_string (".elc"), + build_string (".el")); #ifdef HAVE_MODULES - Vload_suffixes = Fcons (build_pure_c_string (MODULES_SUFFIX), Vload_suffixes); + Vload_suffixes = Fcons (build_string (MODULES_SUFFIX), Vload_suffixes); #ifdef MODULES_SECONDARY_SUFFIX Vload_suffixes = - Fcons (build_pure_c_string (MODULES_SECONDARY_SUFFIX), Vload_suffixes); + Fcons (build_string (MODULES_SECONDARY_SUFFIX), Vload_suffixes); #endif #endif DEFVAR_LISP ("module-file-suffix", Vmodule_file_suffix, doc: /* Suffix of loadable module file, or nil if modules are not supported. */); #ifdef HAVE_MODULES - Vmodule_file_suffix = build_pure_c_string (MODULES_SUFFIX); + Vmodule_file_suffix = build_string (MODULES_SUFFIX); #else Vmodule_file_suffix = Qnil; #endif @@ -5891,9 +5884,9 @@ to the specified file name if a suffix is allowed or required. */); #ifndef MSDOS Vdynamic_library_suffixes - = Fcons (build_pure_c_string (DYNAMIC_LIB_SECONDARY_SUFFIX), Qnil); + = Fcons (build_string (DYNAMIC_LIB_SECONDARY_SUFFIX), Qnil); Vdynamic_library_suffixes - = Fcons (build_pure_c_string (DYNAMIC_LIB_SUFFIX), + = Fcons (build_string (DYNAMIC_LIB_SUFFIX), Vdynamic_library_suffixes); #else Vdynamic_library_suffixes = Qnil; @@ -6045,8 +6038,7 @@ from the file, and matches them against this regular expression. When the regular expression matches, the file is considered to be safe to load. */); Vbytecomp_version_regexp - = build_pure_c_string - ("^;;;.\\(?:in Emacs version\\|bytecomp version FSF\\)"); + = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)"); DEFSYM (Qlexical_binding, "lexical-binding"); DEFVAR_LISP ("lexical-binding", Vlexical_binding, @@ -6116,7 +6108,7 @@ through `require'. */); #if !IEEE_FLOATING_POINT for (int negative = 0; negative < 2; negative++) { - not_a_number[negative] = build_pure_c_string (&"-0.0e+NaN"[!negative]); + not_a_number[negative] = build_string (&"-0.0e+NaN"[!negative]); staticpro (¬_a_number[negative]); } #endif diff --git a/src/pdumper.c b/src/pdumper.c index 88e8e810adc..1d45e37d67e 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -4153,8 +4153,6 @@ types. */) CALLN (Ffuncall, intern_c_string ("load--fixup-all-elns")); #endif - check_pure_size (); - /* Clear out any detritus in memory. */ do { diff --git a/src/pgtkfns.c b/src/pgtkfns.c index f0fd3000965..42a7609b066 100644 --- a/src/pgtkfns.c +++ b/src/pgtkfns.c @@ -3847,7 +3847,7 @@ syms_of_pgtkfns (void) GTK_MAJOR_VERSION, GTK_MINOR_VERSION, GTK_MICRO_VERSION); int len = strlen (ver); - Vgtk_version_string = make_pure_string (ver, len, len, false); + Vgtk_version_string = make_specified_string (ver, len, len, false); g_free (ver); } @@ -3861,7 +3861,7 @@ syms_of_pgtkfns (void) CAIRO_VERSION_MAJOR, CAIRO_VERSION_MINOR, CAIRO_VERSION_MICRO); int len = strlen (ver); - Vcairo_version_string = make_pure_string (ver, len, len, false); + Vcairo_version_string = make_specified_string (ver, len, len, false); g_free (ver); } diff --git a/src/pgtkterm.c b/src/pgtkterm.c index 079945126e0..246604ec18b 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -7422,7 +7422,7 @@ syms_of_pgtkterm (void) DEFSYM (Qlatin_1, "latin-1"); xg_default_icon_file - = build_pure_c_string ("icons/hicolor/scalable/apps/emacs.svg"); + = build_string ("icons/hicolor/scalable/apps/emacs.svg"); staticpro (&xg_default_icon_file); DEFSYM (Qx_gtk_map_stock, "x-gtk-map-stock"); diff --git a/src/process.c b/src/process.c index dcf08fd9b57..8075a2fe676 100644 --- a/src/process.c +++ b/src/process.c @@ -8987,7 +8987,7 @@ sentinel or a process filter function has an error. */); const struct socket_options *sopt; #define ADD_SUBFEATURE(key, val) \ - subfeatures = pure_cons (pure_cons (key, pure_cons (val, Qnil)), subfeatures) + subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures) ADD_SUBFEATURE (QCnowait, Qt); #ifdef DATAGRAM_SOCKETS @@ -9009,7 +9009,7 @@ sentinel or a process filter function has an error. */); ADD_SUBFEATURE (QCserver, Qt); for (sopt = socket_options; sopt->name; sopt++) - subfeatures = pure_cons (intern_c_string (sopt->name), subfeatures); + subfeatures = Fcons (intern_c_string (sopt->name), subfeatures); Fprovide (intern_c_string ("make-network-process"), subfeatures); } diff --git a/src/search.c b/src/search.c index 24b1ee6bd3f..668dfee34ec 100644 --- a/src/search.c +++ b/src/search.c @@ -3454,19 +3454,19 @@ syms_of_search (void) DEFSYM (Qinvalid_regexp, "invalid-regexp"); Fput (Qsearch_failed, Qerror_conditions, - pure_list (Qsearch_failed, Qerror)); + list (Qsearch_failed, Qerror)); Fput (Qsearch_failed, Qerror_message, - build_pure_c_string ("Search failed")); + build_string ("Search failed")); Fput (Quser_search_failed, Qerror_conditions, - pure_list (Quser_search_failed, Quser_error, Qsearch_failed, Qerror)); + list (Quser_search_failed, Quser_error, Qsearch_failed, Qerror)); Fput (Quser_search_failed, Qerror_message, - build_pure_c_string ("Search failed")); + build_string ("Search failed")); Fput (Qinvalid_regexp, Qerror_conditions, - pure_list (Qinvalid_regexp, Qerror)); + list (Qinvalid_regexp, Qerror)); Fput (Qinvalid_regexp, Qerror_message, - build_pure_c_string ("Invalid regexp")); + build_string ("Invalid regexp")); re_match_object = Qnil; staticpro (&re_match_object); diff --git a/src/sqlite.c b/src/sqlite.c index 88b02339863..7b43f949a31 100644 --- a/src/sqlite.c +++ b/src/sqlite.c @@ -899,15 +899,15 @@ syms_of_sqlite (void) DEFSYM (Qsqlite_error, "sqlite-error"); Fput (Qsqlite_error, Qerror_conditions, - Fpurecopy (list2 (Qsqlite_error, Qerror))); + list2 (Qsqlite_error, Qerror)); Fput (Qsqlite_error, Qerror_message, - build_pure_c_string ("Database error")); + build_string ("Database error")); DEFSYM (Qsqlite_locked_error, "sqlite-locked-error"); Fput (Qsqlite_locked_error, Qerror_conditions, - Fpurecopy (list3 (Qsqlite_locked_error, Qsqlite_error, Qerror))); + list3 (Qsqlite_locked_error, Qsqlite_error, Qerror)); Fput (Qsqlite_locked_error, Qerror_message, - build_pure_c_string ("Database locked")); + build_string ("Database locked")); DEFSYM (Qsqlitep, "sqlitep"); DEFSYM (Qfalse, "false"); diff --git a/src/syntax.c b/src/syntax.c index a4ad61328e6..88eb579d9f3 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -3739,9 +3739,9 @@ syms_of_syntax (void) DEFSYM (Qscan_error, "scan-error"); Fput (Qscan_error, Qerror_conditions, - pure_list (Qscan_error, Qerror)); + list (Qscan_error, Qerror)); Fput (Qscan_error, Qerror_message, - build_pure_c_string ("Scan error")); + build_string ("Scan error")); DEFVAR_BOOL ("parse-sexp-ignore-comments", parse_sexp_ignore_comments, doc: /* Non-nil means `forward-sexp', etc., should treat comments as whitespace. */); diff --git a/src/treesit.c b/src/treesit.c index 28c94f307c0..f9c5c935adc 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -4437,43 +4437,43 @@ applies to LANGUAGE-A will be redirected to LANGUAGE-B instead. */); Fmake_variable_buffer_local (Qtreesit_language_remap_alist); staticpro (&Vtreesit_str_libtree_sitter); - Vtreesit_str_libtree_sitter = build_pure_c_string ("libtree-sitter-"); + Vtreesit_str_libtree_sitter = build_string ("libtree-sitter-"); staticpro (&Vtreesit_str_tree_sitter); - Vtreesit_str_tree_sitter = build_pure_c_string ("tree-sitter-"); + Vtreesit_str_tree_sitter = build_string ("tree-sitter-"); #ifndef WINDOWSNT staticpro (&Vtreesit_str_dot_0); - Vtreesit_str_dot_0 = build_pure_c_string (".0"); + Vtreesit_str_dot_0 = build_string (".0"); #endif staticpro (&Vtreesit_str_dot); - Vtreesit_str_dot = build_pure_c_string ("."); + Vtreesit_str_dot = build_string ("."); staticpro (&Vtreesit_str_question_mark); - Vtreesit_str_question_mark = build_pure_c_string ("?"); + Vtreesit_str_question_mark = build_string ("?"); staticpro (&Vtreesit_str_star); - Vtreesit_str_star = build_pure_c_string ("*"); + Vtreesit_str_star = build_string ("*"); staticpro (&Vtreesit_str_plus); - Vtreesit_str_plus = build_pure_c_string ("+"); + Vtreesit_str_plus = build_string ("+"); staticpro (&Vtreesit_str_pound_equal); - Vtreesit_str_pound_equal = build_pure_c_string ("#equal"); + Vtreesit_str_pound_equal = build_string ("#equal"); staticpro (&Vtreesit_str_pound_match); - Vtreesit_str_pound_match = build_pure_c_string ("#match"); + Vtreesit_str_pound_match = build_string ("#match"); staticpro (&Vtreesit_str_pound_pred); - Vtreesit_str_pound_pred = build_pure_c_string ("#pred"); + Vtreesit_str_pound_pred = build_string ("#pred"); staticpro (&Vtreesit_str_open_bracket); - Vtreesit_str_open_bracket = build_pure_c_string ("["); + Vtreesit_str_open_bracket = build_string ("["); staticpro (&Vtreesit_str_close_bracket); - Vtreesit_str_close_bracket = build_pure_c_string ("]"); + Vtreesit_str_close_bracket = build_string ("]"); staticpro (&Vtreesit_str_open_paren); - Vtreesit_str_open_paren = build_pure_c_string ("("); + Vtreesit_str_open_paren = build_string ("("); staticpro (&Vtreesit_str_close_paren); - Vtreesit_str_close_paren = build_pure_c_string (")"); + Vtreesit_str_close_paren = build_string (")"); staticpro (&Vtreesit_str_space); - Vtreesit_str_space = build_pure_c_string (" "); + Vtreesit_str_space = build_string (" "); staticpro (&Vtreesit_str_equal); - Vtreesit_str_equal = build_pure_c_string ("equal"); + Vtreesit_str_equal = build_string ("equal"); staticpro (&Vtreesit_str_match); - Vtreesit_str_match = build_pure_c_string ("match"); + Vtreesit_str_match = build_string ("match"); staticpro (&Vtreesit_str_pred); - Vtreesit_str_pred = build_pure_c_string ("pred"); + Vtreesit_str_pred = build_string ("pred"); defsubr (&Streesit_language_available_p); defsubr (&Streesit_library_abi_version); diff --git a/src/w32fns.c b/src/w32fns.c index e2455b9271e..8f1b851a986 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -11066,9 +11066,9 @@ syms_of_w32fns (void) DEFSYM (Qjson, "json"); Fput (Qundefined_color, Qerror_conditions, - pure_list (Qundefined_color, Qerror)); + list (Qundefined_color, Qerror)); Fput (Qundefined_color, Qerror_message, - build_pure_c_string ("Undefined color")); + build_string ("Undefined color")); staticpro (&w32_grabbed_keys); w32_grabbed_keys = Qnil; diff --git a/src/xdisp.c b/src/xdisp.c index d5ec3e404d0..04f31519cb8 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -37670,7 +37670,7 @@ See also `overlay-arrow-string'. */); DEFVAR_LISP ("overlay-arrow-string", Voverlay_arrow_string, doc: /* String to display as an arrow in text-mode frames. See also `overlay-arrow-position'. */); - Voverlay_arrow_string = build_pure_c_string ("=>"); + Voverlay_arrow_string = build_string ("=>"); DEFVAR_LISP ("overlay-arrow-variable-list", Voverlay_arrow_variable_list, doc: /* List of variables (symbols) which hold markers for overlay arrows. @@ -37803,17 +37803,17 @@ as `mode-line-format' (which see), and is used only on frames for which no explicit name has been set \(see `modify-frame-parameters'). If the value is t, that means use `frame-title-format' for iconified frames. */); - /* Do not nest calls to pure_list. This works around a bug in + /* Do not nest calls to list. This works around a bug in Oracle Developer Studio 12.6. */ Lisp_Object icon_title_name_format - = pure_list (empty_unibyte_string, - build_pure_c_string ("%b - GNU Emacs at "), - intern_c_string ("system-name")); + = list (empty_unibyte_string, + build_string ("%b - GNU Emacs at "), + intern_c_string ("system-name")); Vicon_title_format = Vframe_title_format - = pure_list (intern_c_string ("multiple-frames"), - build_pure_c_string ("%b"), - icon_title_name_format); + = list (intern_c_string ("multiple-frames"), + build_string ("%b"), + icon_title_name_format); DEFVAR_LISP ("message-log-max", Vmessage_log_max, doc: /* Maximum number of lines to keep in the message log buffer. diff --git a/src/xfaces.c b/src/xfaces.c index f6264802fa4..7763fdd4953 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -7525,7 +7525,7 @@ only for this purpose. */); This stipple pattern is used on monochrome displays instead of shades of gray for a face background color. See `set-face-stipple' for possible values for this variable. */); - Vface_default_stipple = build_pure_c_string ("gray3"); + Vface_default_stipple = build_string ("gray3"); DEFVAR_LISP ("tty-defined-color-alist", Vtty_defined_color_alist, doc: /* An alist of defined terminal colors and their RGB values. diff --git a/src/xfns.c b/src/xfns.c index 3f0d8f3fcd0..941f37f3654 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -10257,9 +10257,9 @@ syms_of_xfns (void) DEFSYM (QXdndActionPrivate, "XdndActionPrivate"); Fput (Qundefined_color, Qerror_conditions, - pure_list (Qundefined_color, Qerror)); + list (Qundefined_color, Qerror)); Fput (Qundefined_color, Qerror_message, - build_pure_c_string ("Undefined color")); + build_string ("Undefined color")); DEFVAR_LISP ("x-pointer-shape", Vx_pointer_shape, doc: /* The shape of the pointer when over text. @@ -10486,7 +10486,7 @@ eliminated in future versions of Emacs. */); char gtk_version[sizeof ".." + 3 * INT_STRLEN_BOUND (int)]; int len = sprintf (gtk_version, "%d.%d.%d", GTK_MAJOR_VERSION, GTK_MINOR_VERSION, GTK_MICRO_VERSION); - Vgtk_version_string = make_pure_string (gtk_version, len, len, false); + Vgtk_version_string = make_specified_string (gtk_version, len, len, false); } #endif /* USE_GTK */ @@ -10500,7 +10500,8 @@ eliminated in future versions of Emacs. */); int len = sprintf (cairo_version, "%d.%d.%d", CAIRO_VERSION_MAJOR, CAIRO_VERSION_MINOR, CAIRO_VERSION_MICRO); - Vcairo_version_string = make_pure_string (cairo_version, len, len, false); + Vcairo_version_string = make_specified_string (cairo_version, len, len, + false); } #endif diff --git a/src/xftfont.c b/src/xftfont.c index 41941509bc2..489a343d4e8 100644 --- a/src/xftfont.c +++ b/src/xftfont.c @@ -810,7 +810,7 @@ do not actually have glyphs with colors that can cause Xft crashes. The font families in this list will not be ignored when `xft-ignore-color-fonts' is non-nil. */); - Vxft_color_font_whitelist = list1 (build_pure_c_string ("Source Code Pro")); + Vxft_color_font_whitelist = list1 (build_string ("Source Code Pro")); pdumper_do_now_and_after_load (syms_of_xftfont_for_pdumper); } diff --git a/src/xterm.c b/src/xterm.c index 0c20d38b0f7..f78b20e0d58 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -32590,7 +32590,7 @@ syms_of_xterm (void) DEFSYM (Qwheel_right, "wheel-right"); #ifdef USE_GTK - xg_default_icon_file = build_pure_c_string ("icons/hicolor/scalable/apps/emacs.svg"); + xg_default_icon_file = build_string ("icons/hicolor/scalable/apps/emacs.svg"); staticpro (&xg_default_icon_file); DEFSYM (Qx_gtk_map_stock, "x-gtk-map-stock"); commit f84ccff5a6275782a37534ed55b706db35f228ac Author: Pip Cet Date: Tue Aug 20 18:52:35 2024 +0000 Pure storage removal: Main part * src/alloc.c (pure, PUREBEG, purebeg, pure_size) (pure_bytes_used_before_overflow, pure_bytes_used_lisp) (pure_bytes_used_non_lisp): Remove definitions. (init_strings): Make empty strings impure. (cons_listn): Drop 'cons' argument. (pure_listn): Remove function. (init_vectors): Allocate zero vector manually to avoid freelist issues. (pure_alloc, check_pure_size, find_string_data_in_pure) (make_pure_string, make_pure_c_string, pure_cons, make_pure_float) (make_pure_bignum, make_pure_vector, purecopy_hash_table): Remove functions. (purecopy): Reduce to hash consing our argument. (init_alloc_once_for_pdumper): Adjust to lack of pure space. (pure-bytes-used): Adjust docstring to mark as obsolete. (purify-flag): Keep for hash consing, but adjust docstring. * src/bytecode.c: * src/comp.c: Don't include "puresize.h". * src/conf_post.h (SYSTEM_PURESIZE_EXTRA): Remove definition. * src/data.c (pure_write_error): Remove function. * src/deps.mk: Remove puresize.h dependency throughout. * src/emacs.c: * src/fns.c: * src/intervals.c: * src/keymap.c: Don't include "puresize.h". * src/lisp.h (struct Lisp_Hash_Table): Adjust comment. (pure_listn, pure_list, build_pure_c_string): Remove. * src/w32heap.c (FREEABLE_P): Don't do use 'dumped_data'. (malloc_before_dump, realloc_before_dump, free_before_dump): Remove functions. * src/w32heap.h: Adjust prototype. * lisp/loadup.el: * lisp/startup.el: Remove purespace code. diff --git a/lisp/loadup.el b/lisp/loadup.el index 8307152a2fa..1ba25d967b5 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -184,12 +184,6 @@ (file-error (load "ldefs-boot.el"))) -(let ((new (make-hash-table :test #'equal))) - ;; Now that loaddefs has populated definition-prefixes, purify its contents. - (maphash (lambda (k v) (puthash (purecopy k) (purecopy v) new)) - definition-prefixes) - (setq definition-prefixes new)) - (load "button") ;After loaddefs, because of define-minor-mode! (when (interpreted-function-p (symbol-function 'add-hook)) @@ -503,11 +497,6 @@ lost after dumping"))) ;; Avoid storing references to build directory in the binary. (setq custom-current-group-alist nil) -;; We keep the load-history data in PURE space. -;; Make sure that the spine of the list is not in pure space because it can -;; be destructively mutated in lread.c:build_load_history. -(setq load-history (mapcar #'purecopy load-history)) - (set-buffer-modified-p nil) (remove-hook 'after-load-functions (lambda (_) (garbage-collect))) @@ -659,8 +648,7 @@ directory got moved. This is set to be a pair in the form of: (dump-emacs-portable (expand-file-name output invocation-directory)) (dump-emacs output (if (eq system-type 'ms-dos) "temacs.exe" - "temacs")) - (message "%d pure bytes used" pure-bytes-used)) + "temacs"))) (setq success t)) (unless success (ignore-errors diff --git a/lisp/startup.el b/lisp/startup.el index e9618dc9f6a..5926d816cc4 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -355,7 +355,7 @@ looked for. Setting `init-file-user' does not prevent Emacs from loading `site-start.el'. The only way to do that is to use `--no-site-file'.") -(defcustom site-run-file (purecopy "site-start") +(defcustom site-run-file "site-start" "File containing site-wide run-time initializations. This file is loaded at run-time before `user-init-file'. It contains inits that need to be in place for the entire site, but which, due to @@ -430,10 +430,6 @@ from being initialized." (defvar pure-space-overflow nil "Non-nil if building Emacs overflowed pure space.") -(defvar pure-space-overflow-message (purecopy "\ -Warning Warning!!! Pure space overflow !!!Warning Warning -\(See the node Pure Storage in the Lisp manual for details.)\n")) - (defcustom tutorial-directory (file-name-as-directory (expand-file-name "tutorials" data-directory)) "Directory containing the Emacs TUTORIAL files." @@ -1693,11 +1689,11 @@ Changed settings will be marked as \"CHANGED outside of Customize\"." `((changed ((t :background ,color))))) (put 'cursor 'face-modified t)))) -(defcustom initial-scratch-message (purecopy "\ +(defcustom initial-scratch-message "\ ;; This buffer is for text that is not saved, and for Lisp evaluation. ;; To create a file, visit it with `\\[find-file]' and enter text in its buffer. -") +" "Initial documentation displayed in *scratch* buffer at startup. If this is nil, no message will be displayed." :type '(choice (text :tag "Message") @@ -2096,8 +2092,6 @@ splash screen in another window." (erase-buffer) (setq default-directory command-line-default-directory) (make-local-variable 'startup-screen-inhibit-startup-screen) - (if pure-space-overflow - (insert pure-space-overflow-message)) ;; Insert the permissions notice if the user has yet to grant Emacs ;; storage permissions. (when (fboundp 'android-before-splash-screen) @@ -2139,8 +2133,6 @@ splash screen in another window." (setq buffer-undo-list t) (let ((inhibit-read-only t)) (erase-buffer) - (if pure-space-overflow - (insert pure-space-overflow-message)) (fancy-splash-head) (dolist (text fancy-about-text) (apply #'fancy-splash-insert text) @@ -2206,8 +2198,6 @@ splash screen in another window." (setq default-directory command-line-default-directory) (setq-local tab-width 8) - (if pure-space-overflow - (insert pure-space-overflow-message)) ;; Insert the permissions notice if the user has yet to grant ;; Emacs storage permissions. (when (fboundp 'android-before-splash-screen) @@ -2529,17 +2519,6 @@ A fancy display is used on graphic displays, normal otherwise." (defun command-line-1 (args-left) "A subroutine of `command-line'." (display-startup-echo-area-message) - (when (and pure-space-overflow - (not noninteractive) - ;; If we were dumped with pdumper, we don't care about - ;; pure-space overflow. - (or (not (fboundp 'pdumper-stats)) - (null (pdumper-stats)))) - (display-warning - 'initialization - "Building Emacs overflowed pure space.\ - (See the node Pure Storage in the Lisp manual for details.)" - :warning)) ;; `displayable-buffers' is a list of buffers that may be displayed, ;; which includes files parsed from the command line arguments and diff --git a/src/alloc.c b/src/alloc.c index 642cccc97c6..a9df5ca885f 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -33,7 +33,6 @@ along with GNU Emacs. If not, see . */ #include "bignum.h" #include "dispextern.h" #include "intervals.h" -#include "puresize.h" #include "sysstdio.h" #include "systime.h" #include "character.h" @@ -380,33 +379,6 @@ static char *spare_memory[7]; #define SPARE_MEMORY (1 << 14) -/* Initialize it to a nonzero value to force it into data space - (rather than bss space). That way unexec will remap it into text - space (pure), on some systems. We have not implemented the - remapping on more recent systems because this is less important - nowadays than in the days of small memories and timesharing. */ - -EMACS_INT pure[(PURESIZE + sizeof (EMACS_INT) - 1) / sizeof (EMACS_INT)] = {1,}; -#define PUREBEG (char *) pure - -/* Pointer to the pure area, and its size. */ - -static char *purebeg; -static ptrdiff_t pure_size; - -/* Number of bytes of pure storage used before pure storage overflowed. - If this is non-zero, this implies that an overflow occurred. */ - -static ptrdiff_t pure_bytes_used_before_overflow; - -/* Index in pure at which next pure Lisp object will be allocated.. */ - -static ptrdiff_t pure_bytes_used_lisp; - -/* Number of bytes allocated for non-Lisp objects in pure storage. */ - -static ptrdiff_t pure_bytes_used_non_lisp; - /* If positive, garbage collection is inhibited. Otherwise, zero. */ intptr_t garbage_collection_inhibited; @@ -457,7 +429,6 @@ static struct Lisp_Vector *allocate_clear_vector (ptrdiff_t, bool); static void unchain_finalizer (struct Lisp_Finalizer *); static void mark_terminals (void); static void gc_sweep (void); -static Lisp_Object make_pure_vector (ptrdiff_t); static void mark_buffer (struct buffer *); #if !defined REL_ALLOC || defined SYSTEM_MALLOC @@ -578,15 +549,13 @@ Lisp_Object const *staticvec[NSTATICS]; int staticidx; -static void *pure_alloc (size_t, int); - -/* Return PTR rounded up to the next multiple of ALIGNMENT. */ - +#ifndef HAVE_ALIGNED_ALLOC static void * pointer_align (void *ptr, int alignment) { return (void *) ROUNDUP ((uintptr_t) ptr, alignment); } +#endif /* Extract the pointer hidden within O. */ @@ -1720,12 +1689,30 @@ static ptrdiff_t const STRING_BYTES_MAX = /* Initialize string allocation. Called from init_alloc_once. */ +static struct Lisp_String *allocate_string (void); +static void +allocate_string_data (struct Lisp_String *s, + EMACS_INT nchars, EMACS_INT nbytes, bool clearit, + bool immovable); + static void init_strings (void) { - empty_unibyte_string = make_pure_string ("", 0, 0, 0); + /* String allocation code will return one of 'empty_*ibyte_string' + when asked to construct a new 0-length string, so in order to build + those special cases, we have to do it "by hand". */ + struct Lisp_String *ems = allocate_string (); + struct Lisp_String *eus = allocate_string (); + ems->u.s.intervals = NULL; + eus->u.s.intervals = NULL; + allocate_string_data (ems, 0, 0, false, false); + allocate_string_data (eus, 0, 0, false, false); + /* We can't use 'STRING_SET_UNIBYTE' because this one includes a hack + * to redirect its arg to 'empty_unibyte_string' when nbytes == 0. */ + eus->u.s.size_byte = -1; + XSETSTRING (empty_multibyte_string, ems); + XSETSTRING (empty_unibyte_string, eus); staticpro (&empty_unibyte_string); - empty_multibyte_string = make_pure_string ("", 0, 0, 1); staticpro (&empty_multibyte_string); } @@ -2924,17 +2911,16 @@ list5 (Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, Lisp_Object arg4, } /* Make a list of COUNT Lisp_Objects, where ARG is the first one. - Use CONS to construct the pairs. AP has any remaining args. */ + AP has any remaining args. */ static Lisp_Object -cons_listn (ptrdiff_t count, Lisp_Object arg, - Lisp_Object (*cons) (Lisp_Object, Lisp_Object), va_list ap) +cons_listn (ptrdiff_t count, Lisp_Object arg, va_list ap) { eassume (0 < count); - Lisp_Object val = cons (arg, Qnil); + Lisp_Object val = Fcons (arg, Qnil); Lisp_Object tail = val; for (ptrdiff_t i = 1; i < count; i++) { - Lisp_Object elem = cons (va_arg (ap, Lisp_Object), Qnil); + Lisp_Object elem = Fcons (va_arg (ap, Lisp_Object), Qnil); XSETCDR (tail, elem); tail = elem; } @@ -2947,18 +2933,7 @@ listn (ptrdiff_t count, Lisp_Object arg1, ...) { va_list ap; va_start (ap, arg1); - Lisp_Object val = cons_listn (count, arg1, Fcons, ap); - va_end (ap); - return val; -} - -/* Make a pure list of COUNT Lisp_Objects, where ARG1 is the first one. */ -Lisp_Object -pure_listn (ptrdiff_t count, Lisp_Object arg1, ...) -{ - va_list ap; - va_start (ap, arg1); - Lisp_Object val = cons_listn (count, arg1, pure_cons, ap); + Lisp_Object val = cons_listn (count, arg1, ap); va_end (ap); return val; } @@ -3139,7 +3114,7 @@ static ptrdiff_t last_inserted_vector_free_idx = VECTOR_FREE_LIST_ARRAY_SIZE; static struct large_vector *large_vectors; -/* The only vector with 0 slots, allocated from pure space. */ +/* The only vector with 0 slots. */ Lisp_Object zero_vector; @@ -3191,14 +3166,8 @@ allocate_vector_block (void) return block; } -/* Called once to initialize vector allocation. */ - -static void -init_vectors (void) -{ - zero_vector = make_pure_vector (0); - staticpro (&zero_vector); -} +static struct Lisp_Vector * +allocate_vector_from_block (ptrdiff_t nbytes); /* Memory footprint in bytes of a pseudovector other than a bool-vector. */ static ptrdiff_t @@ -3211,6 +3180,31 @@ pseudovector_nbytes (const union vectorlike_header *hdr) return vroundup (header_size + word_size * nwords); } +/* Called once to initialize vector allocation. */ + +static void +init_vectors (void) +{ + /* The normal vector allocation code refuses to allocate a 0-length vector + because we use the first field of vectors internally when they're on + the free list, so we can't put a zero-length vector on the free list. + This is not a problem for 'zero_vector' since it's always reachable. + An alternative approach would be to allocate zero_vector outside of the + normal heap, e.g. as a static object, and then to "hide" it from the GC, + for example by marking it by hand at the beginning of the GC and unmarking + it by hand at the end. */ + struct vector_block *block = allocate_vector_block (); + struct Lisp_Vector *zv = (struct Lisp_Vector *)block->data; + zv->header.size = 0; + ssize_t nbytes = pseudovector_nbytes (&zv->header); + ssize_t restbytes = VECTOR_BLOCK_BYTES - nbytes; + eassert (restbytes % roundup_size == 0); + setup_on_free_list (ADVANCE (zv, nbytes), restbytes); + + zero_vector = make_lisp_ptr (zv, Lisp_Vectorlike); + staticpro (&zero_vector); +} + /* Allocate vector from a vector block. */ static struct Lisp_Vector * @@ -5657,320 +5651,8 @@ hash_table_free_bytes (void *p, ptrdiff_t nbytes) } -/*********************************************************************** - Pure Storage Management - ***********************************************************************/ - -/* Allocate room for SIZE bytes from pure Lisp storage and return a - pointer to it. TYPE is the Lisp type for which the memory is - allocated. TYPE < 0 means it's not used for a Lisp object, - and that the result should have an alignment of -TYPE. - - The bytes are initially zero. - - If pure space is exhausted, allocate space from the heap. This is - merely an expedient to let Emacs warn that pure space was exhausted - and that Emacs should be rebuilt with a larger pure space. */ - -static void * -pure_alloc (size_t size, int type) -{ - void *result; - static bool pure_overflow_warned = false; - - again: - if (type >= 0) - { - /* Allocate space for a Lisp object from the beginning of the free - space with taking account of alignment. */ - result = pointer_align (purebeg + pure_bytes_used_lisp, LISP_ALIGNMENT); - pure_bytes_used_lisp = ((char *)result - (char *)purebeg) + size; - } - else - { - /* Allocate space for a non-Lisp object from the end of the free - space. */ - ptrdiff_t unaligned_non_lisp = pure_bytes_used_non_lisp + size; - char *unaligned = purebeg + pure_size - unaligned_non_lisp; - int decr = (intptr_t) unaligned & (-1 - type); - pure_bytes_used_non_lisp = unaligned_non_lisp + decr; - result = unaligned - decr; - } - pure_bytes_used = pure_bytes_used_lisp + pure_bytes_used_non_lisp; - - if (pure_bytes_used <= pure_size) - return result; - - if (!pure_overflow_warned) - { - message ("Pure Lisp storage overflowed"); - pure_overflow_warned = true; - } - - /* Don't allocate a large amount here, - because it might get mmap'd and then its address - might not be usable. */ - int small_amount = 10000; - eassert (size <= small_amount - LISP_ALIGNMENT); - purebeg = xzalloc (small_amount); - pure_size = small_amount; - pure_bytes_used_before_overflow += pure_bytes_used - size; - pure_bytes_used = 0; - pure_bytes_used_lisp = pure_bytes_used_non_lisp = 0; - - /* Can't GC if pure storage overflowed because we can't determine - if something is a pure object or not. */ - garbage_collection_inhibited++; - goto again; -} - -/* Print a warning if PURESIZE is too small. */ - -void -check_pure_size (void) -{ - if (pure_bytes_used_before_overflow) - message (("emacs:0:Pure Lisp storage overflow (approx. %jd" - " bytes needed)"), - pure_bytes_used + pure_bytes_used_before_overflow); -} - -/* Find the byte sequence {DATA[0], ..., DATA[NBYTES-1], '\0'} from - the non-Lisp data pool of the pure storage, and return its start - address. Return NULL if not found. */ - -static char * -find_string_data_in_pure (const char *data, ptrdiff_t nbytes) -{ - int i; - ptrdiff_t skip, bm_skip[256], last_char_skip, infinity, start, start_max; - const unsigned char *p; - char *non_lisp_beg; - - if (pure_bytes_used_non_lisp <= nbytes) - return NULL; - - /* The Android GCC generates code like: - - 0xa539e755 <+52>: lea 0x430(%esp),%esi -=> 0xa539e75c <+59>: movdqa %xmm0,0x0(%ebp) - 0xa539e761 <+64>: add $0x10,%ebp - - but data is not aligned appropriately, so a GP fault results. */ - -#if defined __i386__ \ - && defined HAVE_ANDROID \ - && !defined ANDROID_STUBIFY \ - && !defined (__clang__) - if ((intptr_t) data & 15) - return NULL; -#endif - - /* Set up the Boyer-Moore table. */ - skip = nbytes + 1; - for (i = 0; i < 256; i++) - bm_skip[i] = skip; - - p = (const unsigned char *) data; - while (--skip > 0) - bm_skip[*p++] = skip; - - last_char_skip = bm_skip['\0']; - - non_lisp_beg = purebeg + pure_size - pure_bytes_used_non_lisp; - start_max = pure_bytes_used_non_lisp - (nbytes + 1); - - /* See the comments in the function `boyer_moore' (search.c) for the - use of `infinity'. */ - infinity = pure_bytes_used_non_lisp + 1; - bm_skip['\0'] = infinity; - - p = (const unsigned char *) non_lisp_beg + nbytes; - start = 0; - do - { - /* Check the last character (== '\0'). */ - do - { - start += bm_skip[*(p + start)]; - } - while (start <= start_max); - - if (start < infinity) - /* Couldn't find the last character. */ - return NULL; - - /* No less than `infinity' means we could find the last - character at `p[start - infinity]'. */ - start -= infinity; - - /* Check the remaining characters. */ - if (memcmp (data, non_lisp_beg + start, nbytes) == 0) - /* Found. */ - return non_lisp_beg + start; - - start += last_char_skip; - } - while (start <= start_max); - - return NULL; -} - - -/* Return a string allocated in pure space. DATA is a buffer holding - NCHARS characters, and NBYTES bytes of string data. MULTIBYTE - means make the result string multibyte. - - Must get an error if pure storage is full, since if it cannot hold - a large string it may be able to hold conses that point to that - string; then the string is not protected from gc. */ - -Lisp_Object -make_pure_string (const char *data, - ptrdiff_t nchars, ptrdiff_t nbytes, bool multibyte) -{ - Lisp_Object string; - struct Lisp_String *s = pure_alloc (sizeof *s, Lisp_String); - s->u.s.data = (unsigned char *) find_string_data_in_pure (data, nbytes); - if (s->u.s.data == NULL) - { - s->u.s.data = pure_alloc (nbytes + 1, -1); - memcpy (s->u.s.data, data, nbytes); - s->u.s.data[nbytes] = '\0'; - } - s->u.s.size = nchars; - s->u.s.size_byte = multibyte ? nbytes : -1; - s->u.s.intervals = NULL; - XSETSTRING (string, s); - return string; -} - -/* Return a string allocated in pure space. Do not - allocate the string data, just point to DATA. */ - -Lisp_Object -make_pure_c_string (const char *data, ptrdiff_t nchars) -{ - Lisp_Object string; - struct Lisp_String *s = pure_alloc (sizeof *s, Lisp_String); - s->u.s.size = nchars; - s->u.s.size_byte = -2; - s->u.s.data = (unsigned char *) data; - s->u.s.intervals = NULL; - XSETSTRING (string, s); - return string; -} - static Lisp_Object purecopy (Lisp_Object obj); -/* Return a cons allocated from pure space. Give it pure copies - of CAR as car and CDR as cdr. */ - -Lisp_Object -pure_cons (Lisp_Object car, Lisp_Object cdr) -{ - Lisp_Object new; - struct Lisp_Cons *p = pure_alloc (sizeof *p, Lisp_Cons); - XSETCONS (new, p); - XSETCAR (new, purecopy (car)); - XSETCDR (new, purecopy (cdr)); - return new; -} - - -/* Value is a float object with value NUM allocated from pure space. */ - -static Lisp_Object -make_pure_float (double num) -{ - Lisp_Object new; - struct Lisp_Float *p = pure_alloc (sizeof *p, Lisp_Float); - XSETFLOAT (new, p); - XFLOAT_INIT (new, num); - return new; -} - -/* Value is a bignum object with value VALUE allocated from pure - space. */ - -static Lisp_Object -make_pure_bignum (Lisp_Object value) -{ - mpz_t const *n = xbignum_val (value); - size_t i, nlimbs = mpz_size (*n); - size_t nbytes = nlimbs * sizeof (mp_limb_t); - mp_limb_t *pure_limbs; - mp_size_t new_size; - - struct Lisp_Bignum *b = pure_alloc (sizeof *b, Lisp_Vectorlike); - XSETPVECTYPESIZE (b, PVEC_BIGNUM, 0, VECSIZE (struct Lisp_Bignum)); - - int limb_alignment = alignof (mp_limb_t); - pure_limbs = pure_alloc (nbytes, - limb_alignment); - for (i = 0; i < nlimbs; ++i) - pure_limbs[i] = mpz_getlimbn (*n, i); - - new_size = nlimbs; - if (mpz_sgn (*n) < 0) - new_size = -new_size; - - mpz_roinit_n (b->value, pure_limbs, new_size); - - return make_lisp_ptr (b, Lisp_Vectorlike); -} - -/* Return a vector with room for LEN Lisp_Objects allocated from - pure space. */ - -static Lisp_Object -make_pure_vector (ptrdiff_t len) -{ - Lisp_Object new; - size_t size = header_size + len * word_size; - struct Lisp_Vector *p = pure_alloc (size, Lisp_Vectorlike); - XSETVECTOR (new, p); - XVECTOR (new)->header.size = len; - return new; -} - -/* Copy all contents and parameters of TABLE to a new table allocated - from pure space, return the purified table. */ -static struct Lisp_Hash_Table * -purecopy_hash_table (struct Lisp_Hash_Table *table) -{ - eassert (table->weakness == Weak_None); - eassert (table->purecopy); - - struct Lisp_Hash_Table *pure = pure_alloc (sizeof *pure, Lisp_Vectorlike); - *pure = *table; - pure->mutable = false; - - if (table->table_size > 0) - { - ptrdiff_t hash_bytes = table->table_size * sizeof *table->hash; - pure->hash = pure_alloc (hash_bytes, -(int)sizeof *table->hash); - memcpy (pure->hash, table->hash, hash_bytes); - - ptrdiff_t next_bytes = table->table_size * sizeof *table->next; - pure->next = pure_alloc (next_bytes, -(int)sizeof *table->next); - memcpy (pure->next, table->next, next_bytes); - - ptrdiff_t nvalues = table->table_size * 2; - ptrdiff_t kv_bytes = nvalues * sizeof *table->key_and_value; - pure->key_and_value = pure_alloc (kv_bytes, - -(int)sizeof *table->key_and_value); - for (ptrdiff_t i = 0; i < nvalues; i++) - pure->key_and_value[i] = purecopy (table->key_and_value[i]); - - ptrdiff_t index_bytes = hash_table_index_size (table) - * sizeof *table->index; - pure->index = pure_alloc (index_bytes, -(int)sizeof *table->index); - memcpy (pure->index, table->index, index_bytes); - } - - return pure; -} - DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0, doc: /* Make a copy of object OBJ in pure storage. Recursively copies contents of vectors and cons cells. @@ -5996,89 +5678,17 @@ static struct pinned_object static Lisp_Object purecopy (Lisp_Object obj) { - if (FIXNUMP (obj) - || (! SYMBOLP (obj) && PURE_P (XPNTR (obj))) - || SUBRP (obj)) - return obj; /* Already pure. */ - - if (STRINGP (obj) && XSTRING (obj)->u.s.intervals) - message_with_string ("Dropping text-properties while making string `%s' pure", - obj, true); + if (FIXNUMP (obj) || SUBRP (obj)) + return obj; /* No need to hash. */ if (HASH_TABLE_P (Vpurify_flag)) /* Hash consing. */ { Lisp_Object tmp = Fgethash (obj, Vpurify_flag, Qnil); if (!NILP (tmp)) return tmp; + Fputhash (obj, obj, Vpurify_flag); } - if (CONSP (obj)) - obj = pure_cons (XCAR (obj), XCDR (obj)); - else if (FLOATP (obj)) - obj = make_pure_float (XFLOAT_DATA (obj)); - else if (STRINGP (obj)) - obj = make_pure_string (SSDATA (obj), SCHARS (obj), - SBYTES (obj), - STRING_MULTIBYTE (obj)); - else if (HASH_TABLE_P (obj)) - { - struct Lisp_Hash_Table *table = XHASH_TABLE (obj); - /* Do not purify hash tables which haven't been defined with - :purecopy as non-nil or are weak - they aren't guaranteed to - not change. */ - if (table->weakness != Weak_None || !table->purecopy) - { - /* Instead, add the hash table to the list of pinned objects, - so that it will be marked during GC. */ - struct pinned_object *o = xmalloc (sizeof *o); - o->object = obj; - o->next = pinned_objects; - pinned_objects = o; - return obj; /* Don't hash cons it. */ - } - - obj = make_lisp_hash_table (purecopy_hash_table (table)); - } - else if (CLOSUREP (obj) || VECTORP (obj) || RECORDP (obj)) - { - struct Lisp_Vector *objp = XVECTOR (obj); - ptrdiff_t nbytes = vector_nbytes (objp); - struct Lisp_Vector *vec = pure_alloc (nbytes, Lisp_Vectorlike); - register ptrdiff_t i; - ptrdiff_t size = ASIZE (obj); - if (size & PSEUDOVECTOR_FLAG) - size &= PSEUDOVECTOR_SIZE_MASK; - memcpy (vec, objp, nbytes); - for (i = 0; i < size; i++) - vec->contents[i] = purecopy (vec->contents[i]); - /* Byte code strings must be pinned. */ - if (CLOSUREP (obj) && size >= 2 && STRINGP (vec->contents[1]) - && !STRING_MULTIBYTE (vec->contents[1])) - pin_string (vec->contents[1]); - XSETVECTOR (obj, vec); - } - else if (BARE_SYMBOL_P (obj)) - { - if (!XBARE_SYMBOL (obj)->u.s.pinned && !c_symbol_p (XBARE_SYMBOL (obj))) - { /* We can't purify them, but they appear in many pure objects. - Mark them as `pinned' so we know to mark them at every GC cycle. */ - XBARE_SYMBOL (obj)->u.s.pinned = true; - symbol_block_pinned = symbol_block; - } - /* Don't hash-cons it. */ - return obj; - } - else if (BIGNUMP (obj)) - obj = make_pure_bignum (obj); - else - { - AUTO_STRING (fmt, "Don't know how to purify: %S"); - Fsignal (Qerror, list1 (CALLN (Fformat, fmt, obj))); - } - - if (HASH_TABLE_P (Vpurify_flag)) /* Hash consing. */ - Fputhash (obj, obj, Vpurify_flag); - return obj; } @@ -8093,8 +7703,6 @@ init_alloc_once (void) static void init_alloc_once_for_pdumper (void) { - purebeg = PUREBEG; - pure_size = PURESIZE; mem_init (); #ifdef DOUG_LEA_MALLOC @@ -8148,7 +7756,7 @@ If this portion is smaller than `gc-cons-threshold', this is ignored. */); Vgc_cons_percentage = make_float (0.1); DEFVAR_INT ("pure-bytes-used", pure_bytes_used, - doc: /* Number of bytes of shareable Lisp data allocated so far. */); + doc: /* No longer used. */); DEFVAR_INT ("cons-cells-consed", cons_cells_consed, doc: /* Number of cons cells that have been consed so far. */); @@ -8174,9 +7782,13 @@ If this portion is smaller than `gc-cons-threshold', this is ignored. */); DEFVAR_LISP ("purify-flag", Vpurify_flag, doc: /* Non-nil means loading Lisp code in order to dump an executable. -This means that certain objects should be allocated in shared (pure) space. -It can also be set to a hash-table, in which case this table is used to -do hash-consing of the objects allocated to pure space. */); +This used to mean that certain objects should be allocated in shared (pure) +space. It can also be set to a hash-table, in which case this table is used +to do hash-consing of the objects allocated to pure space. +The hash-consing still applies, but objects are not allocated in pure +storage any more. +This flag is still used in a few places not to decide where objects are +allocated but to know if we're in the preload phase of Emacs's build. */); DEFVAR_BOOL ("garbage-collection-messages", garbage_collection_messages, doc: /* Non-nil means display messages at start and end of garbage collection. */); diff --git a/src/bytecode.c b/src/bytecode.c index 48a29c22d55..f719b036d14 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -27,7 +27,6 @@ along with GNU Emacs. If not, see . */ #include "keyboard.h" #include "syntax.h" #include "window.h" -#include "puresize.h" /* Define BYTE_CODE_SAFE true to enable some minor sanity checking, useful for debugging the byte compiler. It defaults to false. */ diff --git a/src/comp.c b/src/comp.c index cee2859c2eb..e89385de1d6 100644 --- a/src/comp.c +++ b/src/comp.c @@ -31,7 +31,6 @@ along with GNU Emacs. If not, see . */ #include #include -#include "puresize.h" #include "window.h" #include "dynlib.h" #include "buffer.h" diff --git a/src/conf_post.h b/src/conf_post.h index 94d9342f154..3963fb9b878 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -157,41 +157,8 @@ You lose; /* Emacs for DOS must be compiled with DJGPP */ /* DATA_START is needed by vm-limit.c and unexcoff.c. */ #define DATA_START (&etext + 1) - -/* Define one of these for easier conditionals. */ -#ifdef HAVE_X_WINDOWS -/* We need a little extra space, see ../../lisp/loadup.el and the - commentary below, in the non-X branch. The 140KB number was - measured on GNU/Linux and on MS-Windows. */ -#define SYSTEM_PURESIZE_EXTRA (-170000+140000) -#else -/* We need a little extra space, see ../../lisp/loadup.el. - As of 20091024, DOS-specific files use up 62KB of pure space. But - overall, we end up wasting 130KB of pure space, because - BASE_PURESIZE starts at 1.47MB, while we need only 1.3MB (including - non-DOS specific files and load history; the latter is about 55K, - but depends on the depth of the top-level Emacs directory in the - directory tree). Given the unknown policy of different DPMI - hosts regarding loading of untouched pages, I'm not going to risk - enlarging Emacs footprint by another 100+ KBytes. */ -#define SYSTEM_PURESIZE_EXTRA (-170000+90000) -#endif #endif /* MSDOS */ -/* macOS / GNUstep need a bit more pure memory. Of the existing knobs, - SYSTEM_PURESIZE_EXTRA seems like the least likely to cause problems. */ -#ifdef HAVE_NS -#if defined NS_IMPL_GNUSTEP -# define SYSTEM_PURESIZE_EXTRA 30000 -#elif defined DARWIN_OS -# define SYSTEM_PURESIZE_EXTRA 200000 -#endif -#endif - -#ifdef CYGWIN -#define SYSTEM_PURESIZE_EXTRA 50000 -#endif - #if defined HAVE_NTGUI && !defined DebPrint # ifdef EMACSDEBUG extern void _DebPrint (const char *fmt, ...); diff --git a/src/data.c b/src/data.c index 66cf34c1e60..95c1d857964 100644 --- a/src/data.c +++ b/src/data.c @@ -27,7 +27,6 @@ along with GNU Emacs. If not, see . */ #include "lisp.h" #include "bignum.h" -#include "puresize.h" #include "character.h" #include "buffer.h" #include "keyboard.h" @@ -135,12 +134,6 @@ wrong_type_argument (Lisp_Object predicate, Lisp_Object value) xsignal2 (Qwrong_type_argument, predicate, value); } -void -pure_write_error (Lisp_Object obj) -{ - xsignal2 (Qerror, build_string ("Attempt to modify read-only object"), obj); -} - void args_out_of_range (Lisp_Object a1, Lisp_Object a2) { diff --git a/src/deps.mk b/src/deps.mk index 65536729014..decb6670473 100644 --- a/src/deps.mk +++ b/src/deps.mk @@ -132,10 +132,10 @@ insdel.o: insdel.c window.h buffer.h $(INTERVALS_H) blockinput.h character.h \ keyboard.o: keyboard.c termchar.h termhooks.h termopts.h buffer.h character.h \ commands.h frame.h window.h macros.h disptab.h keyboard.h syssignal.h \ systime.h syntax.h $(INTERVALS_H) blockinput.h atimer.h composite.h \ - xterm.h puresize.h msdos.h keymap.h w32term.h nsterm.h nsgui.h coding.h \ + xterm.h msdos.h keymap.h w32term.h nsterm.h nsgui.h coding.h \ process.h ../lib/unistd.h gnutls.h lisp.h globals.h $(config_h) keymap.o: keymap.c buffer.h commands.h keyboard.h termhooks.h blockinput.h \ - atimer.h systime.h puresize.h character.h charset.h $(INTERVALS_H) \ + atimer.h systime.h character.h charset.h $(INTERVALS_H) \ keymap.h window.h coding.h frame.h lisp.h globals.h $(config_h) lastfile.o: lastfile.c $(config_h) macros.o: macros.c window.h buffer.h commands.h macros.h keyboard.h msdos.h \ @@ -267,12 +267,12 @@ xsettings.o: xterm.h xsettings.h lisp.h frame.h termhooks.h $(config_h) \ atimer.h termopts.h globals.h ## The files of Lisp proper. -alloc.o: alloc.c process.h frame.h window.h buffer.h puresize.h syssignal.h \ +alloc.o: alloc.c process.h frame.h window.h buffer.h syssignal.h \ keyboard.h blockinput.h atimer.h systime.h character.h lisp.h $(config_h) \ $(INTERVALS_H) termhooks.h gnutls.h coding.h ../lib/unistd.h globals.h bytecode.o: bytecode.c buffer.h syntax.h character.h window.h dispextern.h \ lisp.h globals.h $(config_h) msdos.h -data.o: data.c buffer.h puresize.h character.h syssignal.h keyboard.h frame.h \ +data.o: data.c buffer.h character.h syssignal.h keyboard.h frame.h \ termhooks.h systime.h coding.h composite.h dispextern.h font.h ccl.h \ lisp.h globals.h $(config_h) msdos.h eval.o: eval.c commands.h keyboard.h blockinput.h atimer.h systime.h frame.h \ @@ -295,7 +295,7 @@ lread.o: lread.c commands.h keyboard.h buffer.h epaths.h character.h \ composite.o: composite.c composite.h buffer.h character.h coding.h font.h \ ccl.h frame.h termhooks.h $(INTERVALS_H) window.h \ lisp.h globals.h $(config_h) -intervals.o: intervals.c buffer.h $(INTERVALS_H) keyboard.h puresize.h \ +intervals.o: intervals.c buffer.h $(INTERVALS_H) keyboard.h \ keymap.h lisp.h globals.h $(config_h) systime.h coding.h textprop.o: textprop.c buffer.h window.h $(INTERVALS_H) \ lisp.h globals.h $(config_h) diff --git a/src/emacs.c b/src/emacs.c index eba103bd807..496a107d49d 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -113,7 +113,6 @@ along with GNU Emacs. If not, see . */ #include "syntax.h" #include "sysselect.h" #include "systime.h" -#include "puresize.h" #include "getpagesize.h" #include "gnutls.h" diff --git a/src/fns.c b/src/fns.c index ef6922c137b..cf337dc0808 100644 --- a/src/fns.c +++ b/src/fns.c @@ -36,7 +36,6 @@ along with GNU Emacs. If not, see . */ #include "buffer.h" #include "intervals.h" #include "window.h" -#include "puresize.h" #include "gnutls.h" #ifdef HAVE_TREE_SITTER diff --git a/src/intervals.c b/src/intervals.c index c7a1f81e4ee..cebb77a3614 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -44,7 +44,6 @@ along with GNU Emacs. If not, see . */ #include "lisp.h" #include "intervals.h" #include "buffer.h" -#include "puresize.h" #include "keymap.h" /* Test for membership, allowing for t (actually any non-cons) to mean the diff --git a/src/keymap.c b/src/keymap.c index 7249d8252f9..7f464ed9159 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -50,7 +50,6 @@ along with GNU Emacs. If not, see . */ #include "keyboard.h" #include "termhooks.h" #include "blockinput.h" -#include "puresize.h" #include "intervals.h" #include "keymap.h" #include "window.h" diff --git a/src/lisp.h b/src/lisp.h index f795cf72da2..4df3c999d73 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2628,8 +2628,8 @@ struct Lisp_Hash_Table bool_bf purecopy : 1; /* True if the table is mutable. Ordinarily tables are mutable, but - pure tables are not, and while a table is being mutated it is - immutable for recursive attempts to mutate it. */ + some tables are not: while a table is being mutated it is immutable + for recursive attempts to mutate it. */ bool_bf mutable : 1; /* Next weak hash table if this is a weak hash table. The head of @@ -4436,7 +4436,6 @@ extern void parse_str_as_multibyte (const unsigned char *, ptrdiff_t, /* Defined in alloc.c. */ extern intptr_t garbage_collection_inhibited; extern void *my_heap_start (void); -extern void check_pure_size (void); unsigned char *resize_string_data (Lisp_Object, ptrdiff_t, int, int); extern void malloc_warning (const char *); extern AVOID memory_full (size_t); @@ -4499,11 +4498,8 @@ extern Lisp_Object list4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); extern Lisp_Object list5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); extern Lisp_Object listn (ptrdiff_t, Lisp_Object, ...); -extern Lisp_Object pure_listn (ptrdiff_t, Lisp_Object, ...); #define list(...) \ listn (ARRAYELTS (((Lisp_Object []) {__VA_ARGS__})), __VA_ARGS__) -#define pure_list(...) \ - pure_listn (ARRAYELTS (((Lisp_Object []) {__VA_ARGS__})), __VA_ARGS__) enum gc_root_type { @@ -4577,18 +4573,8 @@ extern Lisp_Object make_uninit_multibyte_string (EMACS_INT, EMACS_INT); extern Lisp_Object make_string_from_bytes (const char *, ptrdiff_t, ptrdiff_t); extern Lisp_Object make_specified_string (const char *, ptrdiff_t, ptrdiff_t, bool); -extern Lisp_Object make_pure_string (const char *, ptrdiff_t, ptrdiff_t, bool); -extern Lisp_Object make_pure_c_string (const char *, ptrdiff_t); extern void pin_string (Lisp_Object string); -/* Make a string allocated in pure space, use STR as string data. */ - -INLINE Lisp_Object -build_pure_c_string (const char *str) -{ - return make_pure_c_string (str, strlen (str)); -} - /* Make a string from the data at STR, treating it as multibyte if the data warrants. */ diff --git a/src/w32heap.c b/src/w32heap.c index f850fe1cf19..6a063e5d7f1 100644 --- a/src/w32heap.c +++ b/src/w32heap.c @@ -135,6 +135,12 @@ static struct static DWORD blocks_number = 0; static unsigned char *bc_limit; +/* Handle for the private heap: + - inside the dumped_data[] array before dump with unexec, + - outside of it after dump, or always if pdumper is used. +*/ +HANDLE heap = NULL; + /* We redirect the standard allocation functions. */ malloc_fn the_malloc_fn; realloc_fn the_realloc_fn; @@ -237,9 +243,7 @@ init_heap (void) /* FREEABLE_P checks if the block can be safely freed. */ #define FREEABLE_P(addr) \ - ((DWORD_PTR)(unsigned char *)(addr) > 0 \ - && ((unsigned char *)(addr) < dumped_data \ - || (unsigned char *)(addr) >= dumped_data + DUMPED_HEAP_SIZE)) + ((DWORD_PTR)(unsigned char *)(addr) > 0) void * malloc_after_dump (size_t size) @@ -258,65 +262,6 @@ malloc_after_dump (size_t size) return p; } -/* FIXME: The *_before_dump functions should be removed when pdumper - becomes the only dumping method. */ -void * -malloc_before_dump (size_t size) -{ - void *p; - - /* Before dumping. The private heap can handle only requests for - less than MaxBlockSize. */ - if (size < MaxBlockSize) - { - /* Use the private heap if possible. */ - p = heap_alloc (size); - } - else - { - /* Find the first big chunk that can hold the requested size. */ - int i = 0; - - for (i = 0; i < blocks_number; i++) - { - if (blocks[i].occupied == 0 && blocks[i].size >= size) - break; - } - if (i < blocks_number) - { - /* If found, use it. */ - p = blocks[i].address; - blocks[i].occupied = TRUE; - } - else - { - /* Allocate a new big chunk from the end of the dumped_data - array. */ - if (blocks_number >= MAX_BLOCKS) - { - fprintf (stderr, - "malloc_before_dump: no more big chunks available.\nEnlarge MAX_BLOCKS!\n"); - exit (-1); - } - bc_limit -= size; - bc_limit = (unsigned char *)ROUND_DOWN (bc_limit, 0x10); - p = bc_limit; - blocks[blocks_number].address = p; - blocks[blocks_number].size = size; - blocks[blocks_number].occupied = TRUE; - blocks_number++; - /* Check that areas do not overlap. */ - if (bc_limit < dumped_data + committed) - { - fprintf (stderr, - "malloc_before_dump: memory exhausted.\nEnlarge dumped_data[]!\n"); - exit (-1); - } - } - } - return p; -} - /* Re-allocate the previously allocated block in ptr, making the new block SIZE bytes long. */ void * @@ -349,39 +294,6 @@ realloc_after_dump (void *ptr, size_t size) return p; } -void * -realloc_before_dump (void *ptr, size_t size) -{ - void *p; - - /* Before dumping. */ - if (dumped_data < (unsigned char *)ptr - && (unsigned char *)ptr < bc_limit && size <= MaxBlockSize) - { - p = heap_realloc (ptr, size); - } - else - { - /* In this case, either the new block is too large for the heap, - or the old block was already too large. In both cases, - malloc_before_dump() and free_before_dump() will take care of - reallocation. */ - p = malloc_before_dump (size); - /* If SIZE is below MaxBlockSize, malloc_before_dump will try to - allocate it in the fixed heap. If that fails, we could have - kept the block in its original place, above bc_limit, instead - of failing the call as below. But this doesn't seem to be - worth the added complexity, as loadup allocates only a very - small number of large blocks, and never reallocates them. */ - if (p && ptr) - { - CopyMemory (p, ptr, size); - free_before_dump (ptr); - } - } - return p; -} - /* Free a block allocated by `malloc', `realloc' or `calloc'. */ void free_after_dump (void *ptr) @@ -394,39 +306,6 @@ free_after_dump (void *ptr) } } -void -free_before_dump (void *ptr) -{ - if (!ptr) - return; - - /* Before dumping. */ - if (dumped_data < (unsigned char *)ptr - && (unsigned char *)ptr < bc_limit) - { - /* Free the block if it is allocated in the private heap. */ - HeapFree (heap, 0, ptr); - } - else - { - /* Look for the big chunk. */ - int i; - - for (i = 0; i < blocks_number; i++) - { - if (blocks[i].address == ptr) - { - /* Reset block occupation if found. */ - blocks[i].occupied = 0; - break; - } - /* What if the block is not found? We should trigger an - error here. */ - eassert (i < blocks_number); - } - } -} - /* On Windows 9X, HeapAlloc may return pointers that are not aligned on 8-byte boundary, alignment which is required by the Lisp memory management. To circumvent this problem, manually enforce alignment diff --git a/src/w32heap.h b/src/w32heap.h index 901c9b5a41e..01ec13c7122 100644 --- a/src/w32heap.h +++ b/src/w32heap.h @@ -42,7 +42,7 @@ extern void report_temacs_memory_usage (void); extern void *sbrk (ptrdiff_t size); /* Initialize heap structures for sbrk on startup. */ -extern void init_heap (bool); +extern void init_heap (void); /* ----------------------------------------------------------------- */ /* Useful routines for manipulating memory-mapped files. */ commit d359858b5d02e60c1d46c26750e5510c2606916a Author: Pip Cet Date: Tue Aug 20 18:52:04 2024 +0000 Pure storage removal: Delete puresize.h * puresize.h: Delete file. diff --git a/src/puresize.h b/src/puresize.h deleted file mode 100644 index d7d8f0b4eec..00000000000 --- a/src/puresize.h +++ /dev/null @@ -1,115 +0,0 @@ -/* How much read-only Lisp storage a dumped Emacs needs. - Copyright (C) 1993, 2001-2024 Free Software Foundation, Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or (at -your option) any later version. - -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see . */ - -#ifndef EMACS_PURESIZE_H -#define EMACS_PURESIZE_H - -#include "lisp.h" - -INLINE_HEADER_BEGIN - -/* Define PURESIZE, the number of bytes of pure Lisp code to leave space for. - - At one point, this was defined in config.h, meaning that changing - PURESIZE would make Make recompile all of Emacs. But only a few - files actually use PURESIZE, so we split it out to its own .h file. - - Make sure to include this file after config.h, since that tells us - whether we are running X windows, which tells us how much pure - storage to allocate. */ - -/* First define a measure of the amount of data we have. */ - -/* A system configuration file may set this to request a certain extra - amount of storage. This is a lot more update-robust that defining - BASE_PURESIZE or even PURESIZE directly. */ -#ifndef SYSTEM_PURESIZE_EXTRA -#define SYSTEM_PURESIZE_EXTRA 0 -#endif - -#ifndef SITELOAD_PURESIZE_EXTRA -#define SITELOAD_PURESIZE_EXTRA 0 -#endif - -#ifndef BASE_PURESIZE -#define BASE_PURESIZE (3100000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA) -#endif - -/* Increase BASE_PURESIZE by a ratio depending on the machine's word size. */ -#ifndef PURESIZE_RATIO -#if EMACS_INT_MAX >> 31 != 0 -#if PTRDIFF_MAX >> 31 != 0 -#define PURESIZE_RATIO 10 / 6 /* Don't surround with `()'. */ -#else -#define PURESIZE_RATIO 8 / 6 /* Don't surround with `()'. */ -#endif -#else -#define PURESIZE_RATIO 1 -#endif -#endif - -#ifdef ENABLE_CHECKING -/* ENABLE_CHECKING somehow increases the purespace used, probably because - it tends to cause some macro arguments to be evaluated twice. This is - a bug, but it's difficult to track it down. */ -#define PURESIZE_CHECKING_RATIO 12 / 10 /* Don't surround with `()'. */ -#else -#define PURESIZE_CHECKING_RATIO 1 -#endif - -/* This is the actual size in bytes to allocate. */ -#ifndef PURESIZE -#define PURESIZE (BASE_PURESIZE * PURESIZE_RATIO * PURESIZE_CHECKING_RATIO) -#endif - -extern AVOID pure_write_error (Lisp_Object); - -extern EMACS_INT pure[]; - -/* The puresize_h_* macros are private to this include file. */ - -/* True if PTR is pure. */ - -#define puresize_h_PURE_P(ptr) \ - ((uintptr_t) (ptr) - (uintptr_t) pure <= PURESIZE) - -INLINE bool -PURE_P (void *ptr) -{ - return puresize_h_PURE_P (ptr); -} - -/* Signal an error if OBJ is pure. PTR is OBJ untagged. */ - -#define puresize_h_CHECK_IMPURE(obj, ptr) \ - (PURE_P (ptr) ? pure_write_error (obj) : (void) 0) - -INLINE void -CHECK_IMPURE (Lisp_Object obj, void *ptr) -{ - puresize_h_CHECK_IMPURE (obj, ptr); -} - -#if DEFINE_KEY_OPS_AS_MACROS -# define PURE_P(ptr) puresize_h_PURE_P (ptr) -# define CHECK_IMPURE(obj, ptr) puresize_h_CHECK_IMPURE (obj, ptr) -#endif - -INLINE_HEADER_END - -#endif /* EMACS_PURESIZE_H */ commit aab5a2fe4c4164019b8b5bf09cce835b2aa8549c Author: Pip Cet Date: Tue Aug 20 18:48:42 2024 +0000 Unexec removal: Adjust and simplify W32-specific code * src/emacs.c (main): Unconditionally call 'init_heap' without an argument. Adjust comment. * src/w32heap.c (dumped_data, DUMPED_HEAP_SIZE): Remove definitions. (heap): Remove variable. (dumped_data_commit): Remove function. (init_heap): Drop unexec-specific code. diff --git a/src/emacs.c b/src/emacs.c index 8e606604d6b..eba103bd807 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1334,26 +1334,8 @@ main (int argc, char **argv) #ifdef WINDOWSNT /* Grab our malloc arena space now, before anything important - happens. This relies on the static heap being needed only in - temacs and only if we are going to dump with unexec. */ - bool use_dynamic_heap = true; - if (temacs) - { - char *temacs_str = NULL, *p; - for (p = argv[0]; (p = strstr (p, "temacs")) != NULL; p++) - temacs_str = p; - if (temacs_str != NULL - && (temacs_str == argv[0] || IS_DIRECTORY_SEP (temacs_str[-1]))) - { - /* Note that gflags are set at this point only if we have been - called with the --temacs=METHOD option. We assume here that - temacs is always called that way, otherwise the functions - that rely on gflags, like will_dump_with_pdumper_p below, - will not do their job. */ - use_dynamic_heap = will_dump_with_pdumper_p (); - } - } - init_heap (use_dynamic_heap); + happens. */ + init_heap (); initial_cmdline = GetCommandLine (); #endif #if defined WINDOWSNT || defined HAVE_NTGUI @@ -1881,8 +1863,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem && !defined DOUG_LEA_MALLOC /* Do not make gmalloc thread-safe when creating bootstrap-emacs, as that causes an infinite recursive loop with FreeBSD. See - Bug#14569. The part of this bug involving Cygwin is no longer - relevant, now that Cygwin defines HYBRID_MALLOC. */ + Bug#14569. */ if (!noninteractive || !will_dump_p ()) malloc_enable_thread (); #endif diff --git a/src/w32heap.c b/src/w32heap.c index c5777622c56..f850fe1cf19 100644 --- a/src/w32heap.c +++ b/src/w32heap.c @@ -28,15 +28,6 @@ Memory allocation scheme for w32/w64: - Buffers are mmap'ed using a very simple emulation of mmap/munmap - - During the temacs phase, if unexec is to be used: - * we use a private heap declared to be stored into the `dumped_data' - * unfortunately, this heap cannot be made growable, so the size of - blocks it can allocate is limited to (0x80000 - pagesize) - * the blocks that are larger than this are allocated from the end - of the `dumped_data' array; there are not so many of them. - We use a very simple first-fit scheme to reuse those blocks. - * we check that the private heap does not cross the area used - by the bigger chunks. - During the emacs phase, or always if pdumper is used: * we create a private heap for new memory blocks * we make sure that we never free a block that has been dumped. @@ -95,40 +86,6 @@ typedef struct _RTL_HEAP_PARAMETERS { SIZE_T Reserved[ 2 ]; } RTL_HEAP_PARAMETERS, *PRTL_HEAP_PARAMETERS; -/* We reserve space for dumping emacs lisp byte-code inside a static - array. By storing it in an array, the generic mechanism in - unexecw32.c will be able to dump it without the need to add a - special segment to the executable. In order to be able to do this - without losing too much space, we need to create a Windows heap at - the specific address of the static array. The RtlCreateHeap - available inside the NT kernel since XP will do this. It allows the - creation of a non-growable heap at a specific address. So before - dumping, we create a non-growable heap at the address of the - dumped_data[] array. After dumping, we reuse memory allocated - there without being able to free it (but most of it is not meant to - be freed anyway), and we use a new private heap for all new - allocations. */ - -/* FIXME: Most of the space reserved for dumped_data[] is only used by - the 1st bootstrap-emacs.exe built while bootstrapping. Once the - preloaded Lisp files are byte-compiled, the next loadup uses less - than half of the size stated below. It would be nice to find a way - to build only the first bootstrap-emacs.exe with the large size, - and reset that to a lower value afterwards. */ -#ifndef HAVE_UNEXEC -/* We don't use dumped_data[], so define to a small size that won't - matter. */ -# define DUMPED_HEAP_SIZE 10 -#else -# if defined _WIN64 || defined WIDE_EMACS_INT -# define DUMPED_HEAP_SIZE (28*1024*1024) -# else -# define DUMPED_HEAP_SIZE (24*1024*1024) -# endif -#endif - -static unsigned char dumped_data[DUMPED_HEAP_SIZE]; - /* Info for keeping track of our dynamic heap used after dumping. */ unsigned char *data_region_base = NULL; unsigned char *data_region_end = NULL; @@ -178,12 +135,6 @@ static struct static DWORD blocks_number = 0; static unsigned char *bc_limit; -/* Handle for the private heap: - - inside the dumped_data[] array before dump with unexec, - - outside of it after dump, or always if pdumper is used. -*/ -HANDLE heap = NULL; - /* We redirect the standard allocation functions. */ malloc_fn the_malloc_fn; realloc_fn the_realloc_fn; @@ -213,30 +164,6 @@ heap_realloc (void *ptr, size_t size) It would be if the memory was shared. https://stackoverflow.com/questions/307060/what-is-the-purpose-of-allocating-pages-in-the-pagefile-with-createfilemapping */ -/* This is the function to commit memory when the heap allocator - claims for new memory. Before dumping with unexec, we allocate - space from the fixed size dumped_data[] array. -*/ -static NTSTATUS NTAPI -dumped_data_commit (PVOID Base, PVOID *CommitAddress, PSIZE_T CommitSize) -{ - /* This is used before dumping. - - The private heap is stored at dumped_data[] address. - We commit contiguous areas of the dumped_data array - as requests arrive. */ - *CommitAddress = data_region_base + committed; - committed += *CommitSize; - /* Check that the private heap area does not overlap the big chunks area. */ - if (((unsigned char *)(*CommitAddress)) + *CommitSize >= bc_limit) - { - fprintf (stderr, - "dumped_data_commit: memory exhausted.\nEnlarge dumped_data[]!\n"); - exit (-1); - } - return 0; -} - /* Heap creation. */ /* We want to turn on Low Fragmentation Heap for XP and older systems. @@ -250,99 +177,51 @@ typedef WINBASEAPI BOOL (WINAPI * HeapSetInformation_Proc)(HANDLE,HEAP_INFORMATI #endif void -init_heap (bool use_dynamic_heap) +init_heap (void) { - /* FIXME: Remove the condition, the 'else' branch below, and all the - related definitions and code, including dumped_data[], when unexec - support is removed from Emacs. */ - if (use_dynamic_heap) - { - /* After dumping, use a new private heap. We explicitly enable - the low fragmentation heap (LFH) here, for the sake of pre - Vista versions. Note: this will harmlessly fail on Vista and - later, where the low-fragmentation heap is enabled by - default. It will also fail on pre-Vista versions when Emacs - is run under a debugger; set _NO_DEBUG_HEAP=1 in the - environment before starting GDB to get low fragmentation heap - on XP and older systems, for the price of losing "certain - heap debug options"; for the details see - https://msdn.microsoft.com/en-us/library/windows/desktop/aa366705%28v=vs.85%29.aspx. */ - data_region_end = data_region_base; - - /* Create the private heap. */ - heap = HeapCreate (0, 0, 0); + /* After dumping, use a new private heap. We explicitly enable + the low fragmentation heap (LFH) here, for the sake of pre + Vista versions. Note: this will harmlessly fail on Vista and + later, where the low-fragmentation heap is enabled by + default. It will also fail on pre-Vista versions when Emacs + is run under a debugger; set _NO_DEBUG_HEAP=1 in the + environment before starting GDB to get low fragmentation heap + on XP and older systems, for the price of losing "certain + heap debug options"; for the details see + https://msdn.microsoft.com/en-us/library/windows/desktop/aa366705%28v=vs.85%29.aspx. */ + data_region_end = data_region_base; + + /* Create the private heap. */ + heap = HeapCreate (0, 0, 0); #ifndef MINGW_W64 - unsigned long enable_lfh = 2; - /* Set the low-fragmentation heap for OS before Vista. */ - HMODULE hm_kernel32dll = LoadLibrary ("kernel32.dll"); - HeapSetInformation_Proc s_pfn_Heap_Set_Information = - (HeapSetInformation_Proc) get_proc_addr (hm_kernel32dll, - "HeapSetInformation"); - if (s_pfn_Heap_Set_Information != NULL) - { - if (s_pfn_Heap_Set_Information ((PVOID) heap, - HeapCompatibilityInformation, - &enable_lfh, sizeof(enable_lfh)) == 0) - DebPrint (("Enabling Low Fragmentation Heap failed: error %ld\n", - GetLastError ())); - } + unsigned long enable_lfh = 2; + /* Set the low-fragmentation heap for OS before Vista. */ + HMODULE hm_kernel32dll = LoadLibrary ("kernel32.dll"); + HeapSetInformation_Proc s_pfn_Heap_Set_Information = + (HeapSetInformation_Proc) get_proc_addr (hm_kernel32dll, + "HeapSetInformation"); + if (s_pfn_Heap_Set_Information != NULL) + { + if (s_pfn_Heap_Set_Information ((PVOID) heap, + HeapCompatibilityInformation, + &enable_lfh, sizeof(enable_lfh)) == 0) + DebPrint (("Enabling Low Fragmentation Heap failed: error %ld\n", + GetLastError ())); + } #endif - if (os_subtype == OS_SUBTYPE_9X) - { - the_malloc_fn = malloc_after_dump_9x; - the_realloc_fn = realloc_after_dump_9x; - the_free_fn = free_after_dump_9x; - } - else - { - the_malloc_fn = malloc_after_dump; - the_realloc_fn = realloc_after_dump; - the_free_fn = free_after_dump; - } + if (os_subtype == OS_SUBTYPE_9X) + { + the_malloc_fn = malloc_after_dump_9x; + the_realloc_fn = realloc_after_dump_9x; + the_free_fn = free_after_dump_9x; } - else /* Before dumping with unexec: use static heap. */ + else { - /* Find the RtlCreateHeap function. Headers for this function - are provided with the w32 DDK, but the function is available - in ntdll.dll since XP. */ - HMODULE hm_ntdll = LoadLibrary ("ntdll.dll"); - RtlCreateHeap_Proc s_pfn_Rtl_Create_Heap - = (RtlCreateHeap_Proc) get_proc_addr (hm_ntdll, "RtlCreateHeap"); - /* Specific parameters for the private heap. */ - RTL_HEAP_PARAMETERS params; - ZeroMemory (¶ms, sizeof(params)); - params.Length = sizeof(RTL_HEAP_PARAMETERS); - - data_region_base = (unsigned char *)ROUND_UP (dumped_data, 0x1000); - data_region_end = bc_limit = dumped_data + DUMPED_HEAP_SIZE; - - params.InitialCommit = committed = 0x1000; - params.InitialReserve = sizeof(dumped_data); - /* Use our own routine to commit memory from the dumped_data - array. */ - params.CommitRoutine = &dumped_data_commit; - - /* Create the private heap. */ - if (s_pfn_Rtl_Create_Heap == NULL) - { - fprintf (stderr, "Cannot build Emacs without RtlCreateHeap being available; exiting.\n"); - exit (-1); - } - heap = s_pfn_Rtl_Create_Heap (0, data_region_base, 0, 0, NULL, ¶ms); - - if (os_subtype == OS_SUBTYPE_9X) - { - fprintf (stderr, "Cannot dump Emacs on Windows 9X; exiting.\n"); - exit (-1); - } - else - { - the_malloc_fn = malloc_before_dump; - the_realloc_fn = realloc_before_dump; - the_free_fn = free_before_dump; - } + the_malloc_fn = malloc_after_dump; + the_realloc_fn = realloc_after_dump; + the_free_fn = free_after_dump; } /* Update system version information to match current system. */ commit b2bc337a5f8d84978029873ce8e51b8d3d53121a Author: Pip Cet Date: Tue Aug 20 18:40:29 2024 +0000 Unexec removal: Remove HYBRID_MALLOC support * src/gmalloc.c (gdefault_morecore): Remove HYBRID_MALLOC code. (allocated_via_gmalloc, hybrid_malloc, hybrid_calloc, hybrid_free_1) (hybrid_free, hybrid_aligned_alloc, hybrid_realloc): Remove functions. * msdos/sed1v2.inp: * msdos/sedlibmk.inp: * src/alloc.c (GC_MALLOC_CHECK, USE_ALIGNED_ALLOC) (refill_memory_reserve, aligned_alloc): * src/emacs.c (main): * src/lastfile.c (my_edata): * src/lisp.h: * src/ralloc.c: * src/sysdep.c (get_current_dir_name_or_unreachable): * src/xdisp.c (decode_mode_spec): Remove HYBRID_MALLOC conditions. * configure.ac (hybrid_malloc, HYBRID_MALLOC): Remove variables and dependent code. * src/conf_post.h (hybrid_malloc, hybrid_calloc, hybrid_free) (hybrid_aligned_alloc, hybrid_realloc): Remove conditional prototypes. * src/Makefile.in (HYBRID_MALLOC): Remove variable. (base_obj): Remove sheap.o (LIBEGNU_ARCHIVE): * lib/Makefile.in (libgnu_a_OBJECTS): Remove libegnu.a support. diff --git a/configure.ac b/configure.ac index 4808c4fa9c1..425e9cc4663 100644 --- a/configure.ac +++ b/configure.ac @@ -3213,14 +3213,12 @@ AC_CACHE_CHECK( fi]) doug_lea_malloc=$emacs_cv_var_doug_lea_malloc -hybrid_malloc= system_malloc=yes dnl This must be before the test of $ac_cv_func_sbrk below. AC_CHECK_FUNCS_ONCE([sbrk]) GMALLOC_OBJ= -HYBRID_MALLOC= if test "${system_malloc}" = "yes"; then AC_DEFINE([SYSTEM_MALLOC], [1], [Define to 1 to use the system memory allocator, even if it is not @@ -3229,14 +3227,6 @@ if test "${system_malloc}" = "yes"; then GNU_MALLOC_reason=" (The GNU allocators don't work with this system configuration.)" VMLIMIT_OBJ= -elif test "$hybrid_malloc" = yes; then - AC_DEFINE([HYBRID_MALLOC], [1], - [Define to use gmalloc before dumping and the system malloc after.]) - HYBRID_MALLOC=1 - GNU_MALLOC=no - GNU_MALLOC_reason=" (only before dumping)" - GMALLOC_OBJ=gmalloc.o - VMLIMIT_OBJ= else test "$doug_lea_malloc" != "yes" && GMALLOC_OBJ=gmalloc.o VMLIMIT_OBJ=vm-limit.o @@ -3255,11 +3245,10 @@ else of the main data segment.]) fi fi -AC_SUBST([HYBRID_MALLOC]) AC_SUBST([GMALLOC_OBJ]) AC_SUBST([VMLIMIT_OBJ]) -if test "$doug_lea_malloc" = "yes" && test "$hybrid_malloc" != yes; then +if test "$doug_lea_malloc" = "yes"; then if test "$GNU_MALLOC" = yes ; then GNU_MALLOC_reason=" (Using Doug Lea's new malloc from the GNU C Library.)" @@ -3321,8 +3310,7 @@ if test "$ac_cv_header_pthread_h" && test "$opsys" != "mingw32"; then status += pthread_create (&th, 0, 0, 0); status += pthread_sigmask (SIG_BLOCK, &new_mask, &old_mask); status += pthread_kill (th, 0); - #if ! (defined SYSTEM_MALLOC || defined HYBRID_MALLOC \ - || defined DOUG_LEA_MALLOC) + #if ! (defined SYSTEM_MALLOC || defined DOUG_LEA_MALLOC) /* Test for pthread_atfork only if gmalloc uses it, as older-style hosts like MirBSD 10 lack it. */ status += pthread_atfork (noop, noop, noop); diff --git a/lib/Makefile.in b/lib/Makefile.in index a87b7b1f31b..e3d42bd68f5 100644 --- a/lib/Makefile.in +++ b/lib/Makefile.in @@ -94,9 +94,8 @@ not_emacs_OBJECTS = regex.o malloc/%.o free.o libgnu_a_OBJECTS = fingerprint.o $(gl_LIBOBJS) \ $(patsubst %.c,%.o,$(filter %.c,$(libgnu_a_SOURCES))) for_emacs_OBJECTS = $(filter-out $(not_emacs_OBJECTS),$(libgnu_a_OBJECTS)) -libegnu_a_OBJECTS = $(patsubst %.o,e-%.o,$(for_emacs_OBJECTS)) -$(libegnu_a_OBJECTS) $(libgnu_a_OBJECTS): $(BUILT_SOURCES) +$(libgnu_a_OBJECTS): $(BUILT_SOURCES) .SUFFIXES: .c .c.o: @@ -104,18 +103,13 @@ $(libegnu_a_OBJECTS) $(libgnu_a_OBJECTS): $(BUILT_SOURCES) e-%.o: %.c $(AM_V_CC)$(CC) -c $(CPPFLAGS) $(ALL_CFLAGS) -Demacs -o $@ $< -all: libgnu.a $(if $(HYBRID_MALLOC),libegnu.a) +all: libgnu.a libgnu.a: $(libgnu_a_OBJECTS) $(AM_V_AR)rm -f $@ $(AM_V_at)$(AR) $(ARFLAGS) $@ $(libgnu_a_OBJECTS) $(AM_V_at)$(RANLIB) $@ -libegnu.a: $(libegnu_a_OBJECTS) - $(AM_V_AR)rm -f $@ - $(AM_V_at)$(AR) $(ARFLAGS) $@ $(libegnu_a_OBJECTS) - $(AM_V_at)$(RANLIB) $@ - ETAGS = ../lib-src/etags$(EXEEXT) $(ETAGS): $(MAKE) -C $(dir $@) $(notdir $@) diff --git a/msdos/sed1v2.inp b/msdos/sed1v2.inp index da056067548..a84cee32927 100644 --- a/msdos/sed1v2.inp +++ b/msdos/sed1v2.inp @@ -163,7 +163,6 @@ s/ *@WEBP_LIBS@// /^XRANDR_CFLAGS *=/s/@XRANDR_CFLAGS@// /^XINERAMA_LIBS *=/s/@XINERAMA_LIBS@// /^XINERAMA_CFLAGS *=/s/@XINERAMA_CFLAGS@// -/^HYBRID_MALLOC *=/s/@HYBRID_MALLOC@// /^GMALLOC_OBJ *=/s/@GMALLOC_OBJ@/gmalloc.o/ /^VMLIMIT_OBJ *=/s/@VMLIMIT_OBJ@/vm-limit.o/ /^FIRSTFILE_OBJ *=/s/@FIRSTFILE_OBJ@// diff --git a/msdos/sedlibmk.inp b/msdos/sedlibmk.inp index 624983798c4..7fb71fcf21a 100644 --- a/msdos/sedlibmk.inp +++ b/msdos/sedlibmk.inp @@ -153,7 +153,6 @@ s/@PACKAGE@/emacs/ /^C_SWITCH_X_SITE *=/s/@C_SWITCH_X_SITE@// /^PROFILING_CFLAGS *=/s/@PROFILING_CFLAGS@// /^GNULIB_WARN_CFLAGS *=/s/@GNULIB_WARN_CFLAGS@// -/^HYBRID_MALLOC *=/s/@HYBRID_MALLOC@// /^WARN_CFLAGS *=/s/@WARN_CFLAGS@// /^WERROR_CFLAGS *=/s/@WERROR_CFLAGS@// /^ANDROID_BUILD_CFLAGS *=/s/@ANDROID_BUILD_CFLAGS@// diff --git a/src/Makefile.in b/src/Makefile.in index c35fb3a1bc4..03c2c8d6e0a 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -306,8 +306,6 @@ XSHAPE_CFLAGS = @XSHAPE_CFLAGS@ ## widget.o if USE_X_TOOLKIT, otherwise empty. WIDGET_OBJ=@WIDGET_OBJ@ -HYBRID_MALLOC = @HYBRID_MALLOC@ - ## cygw32.o if CYGWIN, otherwise empty. CYGWIN_OBJ=@CYGWIN_OBJ@ @@ -477,7 +475,6 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \ profiler.o decompress.o \ thread.o systhread.o sqlite.o treesit.o \ itree.o json.o \ - $(if $(HYBRID_MALLOC),sheap.o) \ $(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) \ $(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ) \ $(HAIKU_OBJ) $(PGTK_OBJ) $(ANDROID_OBJ) @@ -718,7 +715,7 @@ globals.h: gl-stamp; @true $(ALLOBJS): globals.h -LIBEGNU_ARCHIVE = $(lib)/lib$(if $(HYBRID_MALLOC),e)gnu.a +LIBEGNU_ARCHIVE = $(lib)/libgnu.a $(LIBEGNU_ARCHIVE): $(config_h) $(MAKE) -C $(dir $@) all diff --git a/src/alloc.c b/src/alloc.c index eb2e9fae783..642cccc97c6 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -127,7 +127,7 @@ along with GNU Emacs. If not, see . */ marked objects. */ #if (defined SYSTEM_MALLOC || defined DOUG_LEA_MALLOC \ - || defined HYBRID_MALLOC || GC_CHECK_MARKED_OBJECTS) + || GC_CHECK_MARKED_OBJECTS) #undef GC_MALLOC_CHECK #endif @@ -460,7 +460,7 @@ static void gc_sweep (void); static Lisp_Object make_pure_vector (ptrdiff_t); static void mark_buffer (struct buffer *); -#if !defined REL_ALLOC || defined SYSTEM_MALLOC || defined HYBRID_MALLOC +#if !defined REL_ALLOC || defined SYSTEM_MALLOC static void refill_memory_reserve (void); #endif static void compact_small_strings (void); @@ -644,7 +644,7 @@ struct Lisp_Finalizer doomed_finalizers; Malloc ************************************************************************/ -#if defined SIGDANGER || (!defined SYSTEM_MALLOC && !defined HYBRID_MALLOC) +#if defined SIGDANGER || (!defined SYSTEM_MALLOC) /* Function malloc calls this if it finds we are near exhausting storage. */ @@ -1066,19 +1066,14 @@ lisp_free (void *block) # define BLOCK_ALIGN (1 << 15) static_assert (POWER_OF_2 (BLOCK_ALIGN)); -/* Use aligned_alloc if it or a simple substitute is available. - Aligned allocation is incompatible with unexmacosx.c, so don't use - it on Darwin if HAVE_UNEXEC. */ - -#if ! (defined DARWIN_OS && defined HAVE_UNEXEC) -# if (defined HAVE_ALIGNED_ALLOC \ - || (defined HYBRID_MALLOC \ - ? defined HAVE_POSIX_MEMALIGN \ - : !defined SYSTEM_MALLOC && !defined DOUG_LEA_MALLOC)) -# define USE_ALIGNED_ALLOC 1 -# elif !defined HYBRID_MALLOC && defined HAVE_POSIX_MEMALIGN -# define USE_ALIGNED_ALLOC 1 -# define aligned_alloc my_aligned_alloc /* Avoid collision with lisp.h. */ +/* Use aligned_alloc if it or a simple substitute is available. */ + +#if (defined HAVE_ALIGNED_ALLOC \ + || (!defined SYSTEM_MALLOC && !defined DOUG_LEA_MALLOC)) +# define USE_ALIGNED_ALLOC 1 +#elif defined HAVE_POSIX_MEMALIGN +# define USE_ALIGNED_ALLOC 1 +# define aligned_alloc my_aligned_alloc /* Avoid collision with lisp.h. */ static void * aligned_alloc (size_t alignment, size_t size) { @@ -1095,7 +1090,6 @@ aligned_alloc (size_t alignment, size_t size) void *p; return posix_memalign (&p, alignment, size) == 0 ? p : 0; } -# endif #endif /* Padding to leave at the end of a malloc'd block. This is to give @@ -4433,7 +4427,7 @@ memory_full (size_t nbytes) void refill_memory_reserve (void) { -#if !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC +#if !defined SYSTEM_MALLOC if (spare_memory[0] == 0) spare_memory[0] = malloc (SPARE_MEMORY); if (spare_memory[1] == 0) diff --git a/src/conf_post.h b/src/conf_post.h index 8d523c62eee..94d9342f154 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -93,31 +93,6 @@ typedef bool bool_bf; # define ADDRESS_SANITIZER false #endif -/* If HYBRID_MALLOC is defined (e.g., on Cygwin), emacs will use - gmalloc before dumping and the system malloc after dumping. - hybrid_malloc and friends, defined in gmalloc.c, are wrappers that - accomplish this. */ -#ifdef HYBRID_MALLOC -#ifdef emacs -#undef malloc -#define malloc hybrid_malloc -#undef realloc -#define realloc hybrid_realloc -#undef aligned_alloc -#define aligned_alloc hybrid_aligned_alloc -#undef calloc -#define calloc hybrid_calloc -#undef free -#define free hybrid_free - -extern void *hybrid_malloc (size_t); -extern void *hybrid_calloc (size_t, size_t); -extern void hybrid_free (void *); -extern void *hybrid_aligned_alloc (size_t, size_t); -extern void *hybrid_realloc (void *, size_t); -#endif /* emacs */ -#endif /* HYBRID_MALLOC */ - /* We have to go this route, rather than the old hpux9 approach of renaming the functions via macros. The system's stdlib.h has fully prototyped declarations, which yields a conflicting definition of diff --git a/src/emacs.c b/src/emacs.c index 4e6f286d888..8e606604d6b 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -110,7 +110,6 @@ along with GNU Emacs. If not, see . */ #include "composite.h" #include "dispextern.h" #include "regex-emacs.h" -#include "sheap.h" #include "syntax.h" #include "sysselect.h" #include "systime.h" @@ -1565,7 +1564,7 @@ main (int argc, char **argv) emacs_backtrace (-1); -#if !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC +#if !defined SYSTEM_MALLOC /* Arrange to get warning messages as memory fills up. */ memory_warnings (0, malloc_warning); @@ -1573,7 +1572,7 @@ main (int argc, char **argv) Also call realloc and free for consistency. */ free (realloc (malloc (4), 4)); -#endif /* not SYSTEM_MALLOC and not HYBRID_MALLOC */ +#endif /* not SYSTEM_MALLOC */ #ifdef MSDOS set_binary_mode (STDIN_FILENO, O_BINARY); @@ -1879,7 +1878,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem } #if defined HAVE_PTHREAD && !defined SYSTEM_MALLOC \ - && !defined DOUG_LEA_MALLOC && !defined HYBRID_MALLOC + && !defined DOUG_LEA_MALLOC /* Do not make gmalloc thread-safe when creating bootstrap-emacs, as that causes an infinite recursive loop with FreeBSD. See Bug#14569. The part of this bug involving Cygwin is no longer diff --git a/src/gmalloc.c b/src/gmalloc.c index 1faf6506167..8377cb7bf94 100644 --- a/src/gmalloc.c +++ b/src/gmalloc.c @@ -21,7 +21,7 @@ License along with this library. If not, see . #include -#if defined HAVE_PTHREAD && !defined HYBRID_MALLOC +#if defined HAVE_PTHREAD #define USE_PTHREAD #endif @@ -57,13 +57,6 @@ extern void *(*__morecore) (ptrdiff_t); extern void (*__MALLOC_HOOK_VOLATILE __malloc_initialize_hook) (void); #endif /* !defined HAVE_MALLOC_H || glibc >= 2.24 */ -/* If HYBRID_MALLOC is defined, then temacs will use malloc, - realloc... as defined in this file (and renamed gmalloc, - grealloc... via the macros that follow). The dumped emacs, - however, will use the system malloc, realloc.... In other source - files, malloc, realloc... are renamed hybrid_malloc, - hybrid_realloc... via macros in conf_post.h. hybrid_malloc and - friends are wrapper functions defined later in this file. */ #undef malloc #undef realloc #undef calloc @@ -76,19 +69,11 @@ extern void (*__MALLOC_HOOK_VOLATILE __malloc_initialize_hook) (void); #define free gfree #define malloc_info gmalloc_info -#ifdef HYBRID_MALLOC -# include "sheap.h" -#endif - #ifdef __cplusplus extern "C" { #endif -#ifdef HYBRID_MALLOC -#define extern static -#endif - /* Allocate SIZE bytes of memory. */ extern void *malloc (size_t size) ATTRIBUTE_MALLOC_SIZE ((1)); /* Re-allocate the previously allocated block @@ -326,8 +311,6 @@ void (*__MALLOC_HOOK_VOLATILE __malloc_initialize_hook) (void); void (*__MALLOC_HOOK_VOLATILE __after_morecore_hook) (void); void *(*__morecore) (ptrdiff_t); -#ifndef HYBRID_MALLOC - /* Pointer to the base of the first block. */ char *_heapbase; @@ -349,11 +332,9 @@ size_t _bytes_free; /* Are you experienced? */ int __malloc_initialized; -#endif /* HYBRID_MALLOC */ - /* Number of extra blocks to get each time we ask for more core. This reduces the frequency of calling `(*__morecore)'. */ -#if defined DOUG_LEA_MALLOC || defined HYBRID_MALLOC || defined SYSTEM_MALLOC +#if defined DOUG_LEA_MALLOC || defined SYSTEM_MALLOC static #endif size_t __malloc_extra_blocks; @@ -916,7 +897,7 @@ malloc (size_t size) return (hook ? hook : _malloc_internal) (size); } -#if !(defined (_LIBC) || defined (HYBRID_MALLOC)) +#if !(defined (_LIBC)) /* On some ANSI C systems, some libc functions call _malloc, _free and _realloc. Make them use the GNU functions. */ @@ -967,11 +948,8 @@ License along with this library. If not, see . /* Debugging hook for free. */ static void (*__MALLOC_HOOK_VOLATILE gfree_hook) (void *); -#ifndef HYBRID_MALLOC - /* List of blocks allocated by aligned_alloc. */ struct alignlist *_aligned_blocks = NULL; -#endif /* Return memory to the heap. Like `_free_internal' but don't lock mutex. */ @@ -1242,7 +1220,6 @@ free (void *ptr) _free_internal (ptr); } -#ifndef HYBRID_MALLOC /* Define the `cfree' alias for `free'. */ #ifdef weak_alias weak_alias (free, cfree) @@ -1253,7 +1230,6 @@ cfree (void *ptr) free (ptr); } #endif -#endif /* Change the size of a block allocated by `malloc'. Copyright 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. Written May 1989 by Mike Haertel. @@ -1496,12 +1472,6 @@ extern void *__sbrk (ptrdiff_t increment); static void * gdefault_morecore (ptrdiff_t increment) { -#ifdef HYBRID_MALLOC - if (!definitely_will_not_unexec_p ()) - { - return bss_sbrk (increment); - } -#endif #ifdef HAVE_SBRK void *result = (void *) __sbrk (increment); if (result != (void *) -1) @@ -1611,7 +1581,6 @@ aligned_alloc (size_t alignment, size_t size) } /* Note that memalign and posix_memalign are not used in Emacs. */ -#ifndef HYBRID_MALLOC /* An obsolete alias for aligned_alloc, for any old libraries that use this alias. */ @@ -1621,8 +1590,6 @@ memalign (size_t alignment, size_t size) return aligned_alloc (alignment, size); } -/* If HYBRID_MALLOC is defined, we may want to use the system - posix_memalign below. */ int posix_memalign (void **memptr, size_t alignment, size_t size) { @@ -1641,7 +1608,6 @@ posix_memalign (void **memptr, size_t alignment, size_t size) return 0; } -#endif /* Allocate memory on a page boundary. Copyright (C) 1991, 92, 93, 94, 96 Free Software Foundation, Inc. @@ -1662,18 +1628,16 @@ License along with this library. If not, see . The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ -#ifndef HYBRID_MALLOC - -# ifndef HAVE_MALLOC_H +#ifndef HAVE_MALLOC_H /* Allocate SIZE bytes on a page boundary. */ extern void *valloc (size_t); -# endif +#endif -# if defined _SC_PAGESIZE || !defined HAVE_GETPAGESIZE -# include "getpagesize.h" -# elif !defined getpagesize +#if defined _SC_PAGESIZE || !defined HAVE_GETPAGESIZE +# include "getpagesize.h" +#elif !defined getpagesize extern int getpagesize (void); -# endif +#endif static size_t pagesize; @@ -1685,7 +1649,6 @@ valloc (size_t size) return aligned_alloc (pagesize, size); } -#endif /* HYBRID_MALLOC */ #undef malloc #undef realloc @@ -1693,116 +1656,6 @@ valloc (size_t size) #undef aligned_alloc #undef free -#ifdef HYBRID_MALLOC - -/* Assuming PTR was allocated via the hybrid malloc, return true if - PTR was allocated via gmalloc, not the system malloc. Also, return - true if _heaplimit is zero; this can happen temporarily when - gmalloc calls itself for internal use, and in that case PTR is - already known to be allocated via gmalloc. */ - -static bool -allocated_via_gmalloc (void *ptr) -{ - if (!__malloc_initialized) - return false; - size_t block = BLOCK (ptr); - size_t blockmax = _heaplimit - 1; - return block <= blockmax && _heapinfo[block].busy.type != 0; -} - -/* See the comments near the beginning of this file for explanations - of the following functions. */ - -void * -hybrid_malloc (size_t size) -{ - if (definitely_will_not_unexec_p ()) - return malloc (size); - return gmalloc (size); -} - -void * -hybrid_calloc (size_t nmemb, size_t size) -{ - if (definitely_will_not_unexec_p ()) - return calloc (nmemb, size); - return gcalloc (nmemb, size); -} - -static void -hybrid_free_1 (void *ptr) -{ - if (allocated_via_gmalloc (ptr)) - gfree (ptr); - else - free (ptr); -} - -void -hybrid_free (void *ptr) -{ - /* Stolen from Gnulib, to make sure we preserve errno. */ -#if defined __GNUC__ && !defined __clang__ - int err[2]; - err[0] = errno; - err[1] = errno; - errno = 0; - hybrid_free_1 (ptr); - errno = err[errno == 0]; -#else - int err = errno; - hybrid_free_1 (ptr); - errno = err; -#endif -} - -#if defined HAVE_ALIGNED_ALLOC || defined HAVE_POSIX_MEMALIGN -void * -hybrid_aligned_alloc (size_t alignment, size_t size) -{ - if (!definitely_will_not_unexec_p ()) - return galigned_alloc (alignment, size); - /* The following is copied from alloc.c */ -#ifdef HAVE_ALIGNED_ALLOC - return aligned_alloc (alignment, size); -#else /* HAVE_POSIX_MEMALIGN */ - void *p; - return posix_memalign (&p, alignment, size) == 0 ? p : 0; -#endif -} -#endif - -void * -hybrid_realloc (void *ptr, size_t size) -{ - void *result; - int type; - size_t block, oldsize; - - if (!ptr) - return hybrid_malloc (size); - if (!allocated_via_gmalloc (ptr)) - return realloc (ptr, size); - if (!definitely_will_not_unexec_p ()) - return grealloc (ptr, size); - - /* The dumped emacs is trying to realloc storage allocated before - dumping via gmalloc. Allocate new space and copy the data. Do - not bother with gfree (ptr), as that would just waste time. */ - block = BLOCK (ptr); - type = _heapinfo[block].busy.type; - oldsize = - type < 0 ? _heapinfo[block].busy.info.size * BLOCKSIZE - : (size_t) 1 << type; - result = malloc (size); - if (result) - return memcpy (result, ptr, min (oldsize, size)); - return result; -} - -#else /* ! HYBRID_MALLOC */ - void * malloc (size_t size) { @@ -1833,8 +1686,6 @@ realloc (void *ptr, size_t size) return grealloc (ptr, size); } -#endif /* HYBRID_MALLOC */ - #ifdef GC_MCHECK /* Standard debugging hooks for `malloc'. diff --git a/src/lastfile.c b/src/lastfile.c index c6baad4ac01..9f2b2a04958 100644 --- a/src/lastfile.c +++ b/src/lastfile.c @@ -38,7 +38,7 @@ along with GNU Emacs. If not, see . */ #include "lisp.h" -#if ((!defined SYSTEM_MALLOC && !defined HYBRID_MALLOC) \ +#if (!defined SYSTEM_MALLOC \ || defined WINDOWSNT || defined CYGWIN || defined DARWIN_OS) char my_edata[] = "End of Emacs initialized data"; #endif diff --git a/src/lisp.h b/src/lisp.h index a7b84b25b81..f795cf72da2 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4444,7 +4444,7 @@ extern AVOID buffer_memory_full (ptrdiff_t); extern bool survives_gc_p (Lisp_Object); extern void mark_object (Lisp_Object); extern void mark_objects (Lisp_Object *, ptrdiff_t); -#if defined REL_ALLOC && !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC +#if defined REL_ALLOC && !defined SYSTEM_MALLOC extern void refill_memory_reserve (void); #endif extern void mark_c_stack (char const *, char const *); @@ -4687,7 +4687,7 @@ void *hash_table_alloc_bytes (ptrdiff_t nbytes) ATTRIBUTE_MALLOC_SIZE ((1)); void hash_table_free_bytes (void *p, ptrdiff_t nbytes); /* Defined in gmalloc.c. */ -#if !defined DOUG_LEA_MALLOC && !defined HYBRID_MALLOC && !defined SYSTEM_MALLOC +#if !defined DOUG_LEA_MALLOC && !defined SYSTEM_MALLOC extern size_t __malloc_extra_blocks; #endif #if !HAVE_DECL_ALIGNED_ALLOC diff --git a/src/ralloc.c b/src/ralloc.c index 5724ae65d33..f7688561662 100644 --- a/src/ralloc.c +++ b/src/ralloc.c @@ -1162,7 +1162,7 @@ r_alloc_init (void) r_alloc_initialized = 1; page_size = PAGE; -#if !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC +#if !defined SYSTEM_MALLOC real_morecore = __morecore; __morecore = r_alloc_sbrk; @@ -1181,7 +1181,7 @@ r_alloc_init (void) mallopt (M_TOP_PAD, 64 * 4096); unblock_input (); #else -#if !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC +#if !defined SYSTEM_MALLOC /* Give GNU malloc's morecore some hysteresis so that we move all the relocatable blocks much less often. The number used to be 64, but alloc.c would override that with 32 in code that was @@ -1194,7 +1194,7 @@ r_alloc_init (void) #endif #endif -#if !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC +#if !defined SYSTEM_MALLOC first_heap->end = (void *) PAGE_ROUNDUP (first_heap->start); /* The extra call to real_morecore guarantees that the end of the diff --git a/src/sysdep.c b/src/sysdep.c index e0ec74d8364..93e3e1bd5bf 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -287,11 +287,7 @@ get_current_dir_name_or_unreachable (void) #endif # if HAVE_GET_CURRENT_DIR_NAME && !BROKEN_GET_CURRENT_DIR_NAME -# ifdef HYBRID_MALLOC - bool use_libc = will_dump_with_unexec_p (); -# else bool use_libc = true; -# endif if (use_libc) { /* For an unreachable directory, this returns a string that starts diff --git a/src/xdisp.c b/src/xdisp.c index 7b0e2644078..d5ec3e404d0 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -28751,7 +28751,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, } case 'e': -#if !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC +#if !defined SYSTEM_MALLOC { if (NILP (Vmemory_full)) return ""; commit 15e2b14f03796467fab8e8086d293a5813afaa5b Author: Pip Cet Date: Tue Aug 20 18:31:05 2024 +0000 Unexec removal: Main part * configure.ac: Remove unexec-specific parts. (EMACS_CONFIG_FEATURES): Always report that we do not have the UNEXEC feature. (AC_ECHO): No longer display a line about the unexec feature. * lisp/loadup.el: * lisp/startup.el: Remove unexec-specific code. * src/Makefile.in (base_obj): Drop 'UNEXEC_OBJ'. * src/alloc.c (staticvec): Never initialize this variable. (BLOCK_ALIGN): Always allow large blocks. (mmap_lisp_allowed_p): Remove unexec-specific code. * src/buffer.c (init_buffer): * src/conf_post.h (ADDRESS_SANITIZER): * src/emacs.c (load_pdump, main): Remove unexec-specific code. (Fdump_emacs): Remove function. (syms_of_emacs): Remove 'Fdump_emacs'. * src/lastfile.c: Remove unexec-specific code. * src/lisp.h (gflags): Remove unexec-specific flags. (will_dump_p, will_bootstrap_p, will_dump_with_unexec_p) (dumped_with_unexec_p, definitely_will_not_unexec_p): Remove or adjust predicates. (SUBR_SECTION_ATTRIBUTE): Remove unexec-specific definition. * src/pdumper.c (Fdump_emacs_portable): Remove unexec-specific warning. * src/process.c (init_process_emacs): Remove !unexec condition * src/sysdep.c (maybe_disable_address_randomization): Adjust comment. (init_signals): * src/timefns.c (init_timefns): Remove unexec-specific code. * src/w32heap.c (report_temacs_memory_usage): Remove function. * src/w32heap.h: Adjust comment. * src/w32image.c (globals_of_w32image): Remove unexec-specific code. diff --git a/configure.ac b/configure.ac index 1c7545ef984..4808c4fa9c1 100644 --- a/configure.ac +++ b/configure.ac @@ -444,28 +444,13 @@ this option's value should be 'yes' or 'no'.]) ;; ], [with_pdumper=auto]) -AC_ARG_WITH([unexec], - AS_HELP_STRING( - [--with-unexec=VALUE], - [enable unexec support unconditionally - ('yes', 'no', or 'auto': default 'auto')]), - [ case "${withval}" in - yes|no|auto) val=$withval ;; - *) AC_MSG_ERROR( - ['--with-unexec=$withval' is invalid; -this option's value should be 'yes' or 'no'.]) ;; - esac - with_unexec=$val - ], - [with_unexec=auto]) - AC_ARG_WITH([dumping],[AS_HELP_STRING([--with-dumping=VALUE], [kind of dumping to use for initial Emacs build -(VALUE one of: pdumper, unexec, none; default pdumper)])], +(VALUE one of: pdumper, none; default pdumper)])], [ case "${withval}" in - pdumper|unexec|none) val=$withval ;; + pdumper|none) val=$withval ;; *) AC_MSG_ERROR(['--with-dumping=$withval is invalid; -this option's value should be 'pdumper', 'unexec', or 'none'.]) +this option's value should be 'pdumper' or 'none'.]) ;; esac with_dumping=$val @@ -480,22 +465,10 @@ if test "$with_pdumper" = "auto"; then fi fi -if test "$with_unexec" = "auto"; then - if test "$with_dumping" = "unexec"; then - with_unexec=yes - else - with_unexec=no - fi -fi - if test "$with_dumping" = "pdumper" && test "$with_pdumper" = "no"; then AC_MSG_ERROR(['--with-dumping=pdumper' requires pdumper support]) fi -if test "$with_dumping" = "unexec" && test "$with_unexec" = "no"; then - AC_MSG_ERROR(['--with-dumping=unexec' requires unexec support]) -fi - if test "$with_pdumper" = "yes"; then AC_DEFINE([HAVE_PDUMPER], [1], [Define to build with portable dumper support]) @@ -2072,10 +2045,6 @@ AC_PATH_PROG([GZIP_PROG], [gzip]) test $with_compress_install != yes && test -n "$GZIP_PROG" && \ GZIP_PROG=" # $GZIP_PROG # (disabled by configure --without-compress-install)" -if test "$with_dumping" = "unexec" && test "$opsys" = "nacl"; then - AC_MSG_ERROR([nacl is not compatible with --with-dumping=unexec]) -fi - AC_CACHE_CHECK([for 'find' args to delete a file], [emacs_cv_find_delete], [if touch conftest.tmp && find conftest.tmp -delete 2>/dev/null && @@ -2088,48 +2057,6 @@ AC_SUBST([FIND_DELETE]) PAXCTL_dumped= PAXCTL_notdumped= -if test $with_unexec = yes && test $opsys = gnu-linux; then - if test "${SETFATTR+set}" != set; then - AC_CACHE_CHECK([for setfattr], - [emacs_cv_prog_setfattr], - [touch conftest.tmp - if (setfattr -n user.pax.flags conftest.tmp) >/dev/null 2>&1; then - emacs_cv_prog_setfattr=yes - else - emacs_cv_prog_setfattr=no - fi]) - if test "$emacs_cv_prog_setfattr" = yes; then - PAXCTL_notdumped='$(SETFATTR) -n user.pax.flags -v er' - SETFATTR=setfattr - else - SETFATTR= - fi - fi - case $opsys,$PAXCTL_notdumped,$emacs_uname_r in - gnu-linux,,* | netbsd,,[0-7].*) - AC_PATH_PROG([PAXCTL], [paxctl], [], - [$PATH$PATH_SEPARATOR/sbin$PATH_SEPARATOR/usr/sbin]) - if test -n "$PAXCTL"; then - if test "$opsys" = netbsd; then - PAXCTL_dumped='$(PAXCTL) +a' - PAXCTL_notdumped=$PAXCTL_dumped - else - AC_MSG_CHECKING([whether binaries have a PT_PAX_FLAGS header]) - AC_LINK_IFELSE([AC_LANG_PROGRAM([], [])], - [if $PAXCTL -v conftest$EXEEXT >/dev/null 2>&1; then - AC_MSG_RESULT([yes]) - else - AC_MSG_RESULT([no]) - PAXCTL= - fi]) - if test -n "$PAXCTL"; then - PAXCTL_dumped='$(PAXCTL) -zex' - PAXCTL_notdumped='$(PAXCTL) -r' - fi - fi - fi;; - esac -fi AC_SUBST([PAXCTL_dumped]) AC_SUBST([PAXCTL_notdumped]) AC_SUBST([SETFATTR]) @@ -2196,37 +2123,6 @@ else ac_link="$ac_link $NON_GCC_LINK_TEST_OPTIONS" fi -dnl On some platforms using GNU ld, linking temacs needs -znocombreloc. -dnl Although this has something to do with dumping, the details are unknown. -dnl If the flag is used but not needed, -dnl Emacs should still work (albeit a bit more slowly), -dnl so use the flag everywhere that it is supported. -dnl When testing whether the flag works, treat GCC specially -dnl since it just gives a non-fatal 'unrecognized option' -dnl if not built to support GNU ld. -if test "$GCC" = yes; then - LDFLAGS_NOCOMBRELOC="-Wl,-znocombreloc" -else - LDFLAGS_NOCOMBRELOC="-znocombreloc" -fi - -AC_CACHE_CHECK([for -znocombreloc], [emacs_cv_znocombreloc], - [if test $with_unexec = no; then - emacs_cv_znocombreloc='not needed' - else - save_LDFLAGS=$LDFLAGS - LDFLAGS="$LDFLAGS $LDFLAGS_NOCOMBRELOC" - AC_LINK_IFELSE([AC_LANG_PROGRAM([], [])], - [emacs_cv_znocombreloc=yes], [emacs_cv_znocombreloc=no]) - LDFLAGS=$save_LDFLAGS - fi]) - -case $emacs_cv_znocombreloc in - no*) - LDFLAGS_NOCOMBRELOC= ;; -esac - - AC_CACHE_CHECK([whether addresses are sanitized], [emacs_cv_sanitize_address], [AC_COMPILE_IFELSE( @@ -2242,48 +2138,8 @@ AC_CACHE_CHECK([whether addresses are sanitized], [emacs_cv_sanitize_address=yes], [emacs_cv_sanitize_address=no])]) -if test $with_unexec = yes; then - AC_DEFINE([HAVE_UNEXEC], [1], [Define if Emacs supports unexec.]) - if test "$emacs_cv_sanitize_address" = yes; then - AC_MSG_WARN([[Addresses are sanitized; suggest --without-unexec]]) - fi -fi - - -UNEXEC_OBJ= -test $with_unexec = yes && -case "$opsys" in - # MSDOS uses unexcoff.o - aix4-2) - UNEXEC_OBJ=unexaix.o - ;; - cygwin) - UNEXEC_OBJ=unexcw.o - ;; - darwin) - UNEXEC_OBJ=unexmacosx.o - ;; - hpux10-20 | hpux11) - UNEXEC_OBJ=unexhp9k800.o - ;; - mingw32) - UNEXEC_OBJ=unexw32.o - ;; - solaris) - # Use the Solaris dldump() function, called from unexsol.c, to dump - # emacs, instead of the generic ELF dump code found in unexelf.c. - # The resulting binary has a complete symbol table, and is better - # for debugging and other observability tools (debuggers, pstack, etc). - UNEXEC_OBJ=unexsol.o - ;; - *) - UNEXEC_OBJ=unexelf.o - ;; -esac -AC_SUBST([UNEXEC_OBJ]) - LD_SWITCH_SYSTEM= -test "$with_unexec" = no || case "$opsys" in +case "$opsys" in freebsd|dragonfly) ## Let 'ld' find image libs and similar things in /usr/local/lib. ## The system compiler, GCC, has apparently been modified to not @@ -2331,22 +2187,6 @@ esac C_SWITCH_MACHINE= -test $with_unexec = yes && -case $canonical in - alpha*) - ## With ELF, make sure that all common symbols get allocated to in the - ## data section. Otherwise, the dump of temacs may miss variables in - ## the shared library that have been initialized. For example, with - ## GNU libc, __malloc_initialized would normally be resolved to the - ## shared library's .bss section, which is fatal. - if test "x$GCC" = "xyes"; then - C_SWITCH_MACHINE="-fno-common" - else - AC_MSG_ERROR([Non-GCC compilers are not supported.]) - fi - ;; -esac - AC_CACHE_CHECK([for flags to work around GCC bug 58416], [emacs_cv_gcc_bug_58416_CFLAGS], [emacs_cv_gcc_bug_58416_CFLAGS='none needed' @@ -3379,21 +3219,6 @@ system_malloc=yes dnl This must be before the test of $ac_cv_func_sbrk below. AC_CHECK_FUNCS_ONCE([sbrk]) -test $with_unexec = yes && -case "$opsys" in - ## darwin ld insists on the use of malloc routines in the System framework. - darwin | mingw32 | nacl | solaris) ;; - cygwin | qnxnto | freebsd) - hybrid_malloc=yes - system_malloc= ;; - *) test "$ac_cv_func_sbrk" = yes && system_malloc=$emacs_cv_sanitize_address;; -esac - -if test "${system_malloc}" != yes && test "${doug_lea_malloc}" != yes \ - && test "${UNEXEC_OBJ}" = unexelf.o; then - hybrid_malloc=yes -fi - GMALLOC_OBJ= HYBRID_MALLOC= if test "${system_malloc}" = "yes"; then @@ -5268,15 +5093,9 @@ if test "${with_native_compilation}" = "default"; then # Check if libgccjit really works. AC_RUN_IFELSE([libgccjit_smoke_test], [], [libgccjit_broken]) fi - if test "$with_unexec" = yes; then - with_native_compilation=no - fi fi if test "${with_native_compilation}" != "no"; then - if test "$with_unexec" = yes; then - AC_MSG_ERROR(['--with-native-compilation' is not compatible with unexec]) - fi if test "${HAVE_ZLIB}" = no; then AC_MSG_ERROR(['--with-native-compilation' requires zlib]) fi @@ -6085,19 +5904,6 @@ dnl No need to check for posix_memalign if aligned_alloc works. AC_CHECK_FUNCS([aligned_alloc posix_memalign], [break]) AC_CHECK_DECLS([aligned_alloc], [], [], [[#include ]]) -case $with_unexec,$canonical in - yes,alpha*) - AC_CHECK_DECL([__ELF__], [], - [AC_MSG_ERROR([Non-ELF systems are not supported on this platform.])]);; -esac - -if test "$with_unexec" = yes && test "$opsys" = "haiku"; then - dnl A serious attempt was actually made to port unexec to Haiku. - dnl Something in libstdc++ seems to prevent it from working. - AC_MSG_ERROR([Haiku is not supported by the legacy unexec dumper. -Please use the portable dumper instead.]) -fi - # Dump loading. Android lacks posix_madvise. AC_CHECK_FUNCS([posix_madvise madvise]) @@ -7543,9 +7349,6 @@ case "$opsys" in ## about 14 to about 34. Setting it high gets us plenty of slop and ## only costs about 1.5K of wasted binary space. headerpad_extra=1000 - if test "$with_unexec" = yes; then - LD_SWITCH_SYSTEM_TEMACS="-fno-pie $LD_SWITCH_SYSTEM_TEMACS -Xlinker -headerpad -Xlinker $headerpad_extra" - fi ## This is here because src/Makefile.in did some extra fiddling around ## with LD_SWITCH_SYSTEM. It seems cleaner to put this in @@ -7571,49 +7374,11 @@ case "$opsys" in x86_64-*-*) LD_SWITCH_SYSTEM_TEMACS="-Wl,-stack,0x00800000 -Wl,-heap,0x00100000 -Wl,-image-base,0x400000000 -Wl,-entry,__start -Wl,-Map,./temacs.map" ;; *) LD_SWITCH_SYSTEM_TEMACS="-Wl,-stack,0x00800000 -Wl,-heap,0x00100000 -Wl,-image-base,0x01000000 -Wl,-entry,__start -Wl,-Map,./temacs.map" ;; esac - ## If they want unexec, disable Windows ASLR for the Emacs binary - if test "$with_dumping" = "unexec"; then - case "$canonical" in - x86_64-*-*) LD_SWITCH_SYSTEM_TEMACS="$LD_SWITCH_SYSTEM_TEMACS -Wl,-disable-dynamicbase -Wl,-disable-high-entropy-va -Wl,-default-image-base-low" ;; - *) LD_SWITCH_SYSTEM_TEMACS="$LD_SWITCH_SYSTEM_TEMACS -Wl,-disable-dynamicbase" ;; - esac - fi ;; *) LD_SWITCH_SYSTEM_TEMACS= ;; esac -# -no-pie or -nopie fixes a temacs segfault on Gentoo, OpenBSD, -# Ubuntu, and other systems with "hardened" GCC configurations for -# some reason (Bug#18784). We don't know why this works, but not -# segfaulting is better than segfaulting. Use ac_c_werror_flag=yes -# when trying the option, otherwise clang keeps warning that it does -# not understand it, and pre-4.6 GCC has a similar problem -# (Bug#20338). Prefer -no-pie to -nopie, as -no-pie is the -# spelling used by GCC 6.1.0 and later (Bug#24682). -AC_CACHE_CHECK( - [for $CC option to disable position independent executables], - [emacs_cv_prog_cc_no_pie], - [if test $with_unexec = no; then - emacs_cv_prog_cc_no_pie='not needed' - else - emacs_save_c_werror_flag=$ac_c_werror_flag - emacs_save_LDFLAGS=$LDFLAGS - ac_c_werror_flag=yes - for emacs_cv_prog_cc_no_pie in -no-pie -nopie no; do - test $emacs_cv_prog_cc_no_pie = no && break - LDFLAGS="$emacs_save_LDFLAGS $emacs_cv_prog_cc_no_pie" - AC_LINK_IFELSE([AC_LANG_PROGRAM([], [])], [break]) - done - ac_c_werror_flag=$emacs_save_c_werror_flag - LDFLAGS=$emacs_save_LDFLAGS - fi]) -case $emacs_cv_prog_cc_no_pie in - -*) - LD_SWITCH_SYSTEM_TEMACS="$LD_SWITCH_SYSTEM_TEMACS $emacs_cv_prog_cc_no_pie" - ;; -esac - if test x$ac_enable_profiling != x ; then case $opsys in *freebsd | gnu-linux) ;; @@ -7756,7 +7521,7 @@ for opt in ACL BE_APP CAIRO DBUS FREETYPE GCONF GIF GLIB GMP GNUTLS GPM GSETTING case $opt in PDUMPER) val=${with_pdumper} ;; - UNEXEC) val=${with_unexec} ;; + UNEXEC) val=no ;; GLIB) val=${emacs_cv_links_glib} ;; NOTIFY|ACL) eval val=\${${opt}_SUMMARY} ;; TOOLKIT_SCROLL_BARS|X_TOOLKIT) eval val=\${USE_$opt} ;; @@ -7832,7 +7597,6 @@ AS_ECHO([" Does Emacs use -lXaw3d? ${HAVE_XAW3D Does Emacs support Xwidgets? ${HAVE_XWIDGETS} Does Emacs have threading support in lisp? ${threads_enabled} Does Emacs support the portable dumper? ${with_pdumper} - Does Emacs support legacy unexec dumping? ${with_unexec} Which dumping strategy does Emacs use? ${with_dumping} Does Emacs have native lisp compiler? ${HAVE_NATIVE_COMP} Does Emacs use version 2 of the X Input Extension? ${HAVE_XINPUT2} diff --git a/lisp/loadup.el b/lisp/loadup.el index 613833c4184..8307152a2fa 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -57,7 +57,7 @@ ;; Add subdirectories to the load-path for files that might get ;; autoloaded when bootstrapping or running Emacs normally. ;; This is because PATH_DUMPLOADSEARCH is just "../lisp". -(if (or (member dump-mode '("bootstrap" "pbootstrap")) +(if (or (member dump-mode '("pbootstrap")) ;; FIXME this is irritatingly fragile. (and (stringp (nth 4 command-line-args)) (string-match "^unidata-gen\\(\\.elc?\\)?$" @@ -635,8 +635,6 @@ directory got moved. This is set to be a pair in the form of: (error nil)))))) (if dump-mode (let ((output (cond ((equal dump-mode "pdump") "emacs.pdmp") - ((equal dump-mode "dump") "emacs") - ((equal dump-mode "bootstrap") "emacs") ((equal dump-mode "pbootstrap") "bootstrap-emacs.pdmp") (t (error "Unrecognized dump mode %s" dump-mode))))) (when (and (featurep 'native-compile) @@ -680,7 +678,7 @@ directory got moved. This is set to be a pair in the form of: (eq system-type 'android)) ;; Don't bother adding another name if we're just ;; building bootstrap-emacs. - (member dump-mode '("pbootstrap" "bootstrap")))) + (member dump-mode '("pbootstrap")))) (let ((name (format "emacs-%s.%d" emacs-version emacs-build-number)) (exe (if (eq system-type 'windows-nt) ".exe" ""))) (while (string-match "[^-+_.a-zA-Z0-9]+" name) diff --git a/lisp/startup.el b/lisp/startup.el index 3436409a35e..e9618dc9f6a 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1104,7 +1104,7 @@ init-file, or to a default value if loading is not possible." ;; Else, perhaps the user init file was compiled (when (and (equal (file-name-extension user-init-file) "eln") ;; The next test is for builds without native - ;; compilation support or builds with unexec. + ;; compilation support. (boundp 'comp-eln-to-el-h)) (if-let* ((source (gethash (file-name-nondirectory user-init-file) @@ -2523,7 +2523,7 @@ A fancy display is used on graphic displays, normal otherwise." (defalias 'about-emacs #'display-about-screen) (defalias 'display-splash-screen #'display-startup-screen) -;; This avoids byte-compiler warning in the unexec build. +;; This avoids byte-compiler warning in non-pdumper builds. (declare-function pdumper-stats "pdumper.c" ()) (defun command-line-1 (args-left) diff --git a/src/Makefile.in b/src/Makefile.in index c278924ef94..c35fb3a1bc4 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -386,8 +386,6 @@ RUN_TEMACS = ./temacs # Whether builds should contain details. '--no-build-details' or empty. BUILD_DETAILS = @BUILD_DETAILS@ -UNEXEC_OBJ = @UNEXEC_OBJ@ - HAIKU_OBJ = @HAIKU_OBJ@ HAIKU_CXX_OBJ = @HAIKU_CXX_OBJ@ HAIKU_LIBS = @HAIKU_LIBS@ @@ -471,9 +469,9 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \ cmds.o casetab.o casefiddle.o indent.o search.o regex-emacs.o undo.o \ alloc.o pdumper.o data.o doc.o editfns.o callint.o \ eval.o floatfns.o fns.o sort.o font.o print.o lread.o $(MODULES_OBJ) \ - syntax.o $(UNEXEC_OBJ) bytecode.o comp.o $(DYNLIB_OBJ) \ - process.o gnutls.o callproc.o \ - region-cache.o sound.o timefns.o atimer.o \ + syntax.o bytecode.o comp.o $(DYNLIB_OBJ) \ + process.o gnutls.o callproc.o \ + region-cache.o sound.o timefns.o atimer.o \ doprnt.o intervals.o textprop.o composite.o xml.o lcms.o $(NOTIFY_OBJ) \ $(XWIDGETS_OBJ) \ profiler.o decompress.o \ diff --git a/src/alloc.c b/src/alloc.c index 4fab0d54248..eb2e9fae783 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -266,7 +266,7 @@ voidfuncptr __MALLOC_HOOK_VOLATILE __malloc_initialize_hook EXTERNALLY_VISIBLE #endif -#if defined DOUG_LEA_MALLOC || defined HAVE_UNEXEC +#if defined DOUG_LEA_MALLOC /* Allocator-related actions to do just before and after unexec. */ @@ -570,15 +570,9 @@ static void mem_delete (struct mem_node *); static void mem_delete_fixup (struct mem_node *); static struct mem_node *mem_find (void *); -/* Addresses of staticpro'd variables. Initialize it to a nonzero - value if we might unexec; otherwise some compilers put it into - BSS. */ +/* Addresses of staticpro'd variables. */ -Lisp_Object const *staticvec[NSTATICS] -#ifdef HAVE_UNEXEC -= {&Vpurify_flag} -#endif - ; +Lisp_Object const *staticvec[NSTATICS]; /* Index of next unused slot in staticvec. */ @@ -631,10 +625,8 @@ mmap_lisp_allowed_p (void) { /* If we can't store all memory addresses in our lisp objects, it's risky to let the heap use mmap and give us addresses from all - over our address space. We also can't use mmap for lisp objects - if we might dump: unexec doesn't preserve the contents of mmapped - regions. */ - return pointers_fit_in_lispobj_p () && !will_dump_with_unexec_p (); + over our address space. */ + return pointers_fit_in_lispobj_p (); } #endif @@ -1071,11 +1063,7 @@ lisp_free (void *block) BLOCK_BYTES and guarantees they are aligned on a BLOCK_ALIGN boundary. */ /* Byte alignment of storage blocks. */ -#ifdef HAVE_UNEXEC -# define BLOCK_ALIGN (1 << 10) -#else /* !HAVE_UNEXEC */ # define BLOCK_ALIGN (1 << 15) -#endif static_assert (POWER_OF_2 (BLOCK_ALIGN)); /* Use aligned_alloc if it or a simple substitute is available. diff --git a/src/buffer.c b/src/buffer.c index 2955ee6399b..663a47ec72f 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -4892,47 +4892,6 @@ init_buffer (void) { Lisp_Object temp; -#ifdef USE_MMAP_FOR_BUFFERS - if (dumped_with_unexec_p ()) - { - Lisp_Object tail, buffer; - -#ifndef WINDOWSNT - /* These must be reset in the dumped Emacs, to avoid stale - references to mmap'ed memory from before the dump. - - WINDOWSNT doesn't need this because it doesn't track mmap'ed - regions by hand (see w32heap.c, which uses system APIs for - that purpose), and thus doesn't use mmap_regions. */ - mmap_regions = NULL; - mmap_fd = -1; -#endif - - /* The dumped buffers reference addresses of buffer text - recorded by temacs, that cannot be used by the dumped Emacs. - We map new memory for their text here. - - Implementation notes: the buffers we carry from temacs are: - " prin1", "*scratch*", " *Minibuf-0*", "*Messages*", and - " *code-conversion-work*". They are created by - init_buffer_once and init_window_once (which are not called - in the dumped Emacs), and by the first call to coding.c - routines. Since FOR_EACH_LIVE_BUFFER only walks the buffers - in Vbuffer_alist, any buffer we carry from temacs that is - not in the alist (a.k.a. "magic invisible buffers") should - be handled here explicitly. */ - FOR_EACH_LIVE_BUFFER (tail, buffer) - { - struct buffer *b = XBUFFER (buffer); - b->text->beg = NULL; - enlarge_buffer_text (b, 0); - } - /* The " prin1" buffer is not in Vbuffer_alist. */ - XBUFFER (Vprin1_to_string_buffer)->text->beg = NULL; - enlarge_buffer_text (XBUFFER (Vprin1_to_string_buffer), 0); - } -#endif /* USE_MMAP_FOR_BUFFERS */ - AUTO_STRING (scratch, "*scratch*"); Fset_buffer (Fget_buffer_create (scratch, Qnil)); if (NILP (BVAR (&buffer_defaults, enable_multibyte_characters))) diff --git a/src/conf_post.h b/src/conf_post.h index f2353803074..8d523c62eee 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -93,30 +93,6 @@ typedef bool bool_bf; # define ADDRESS_SANITIZER false #endif -#ifdef emacs -/* We include stdlib.h here, because Gnulib's stdlib.h might redirect - 'free' to its replacement, and we want to avoid that in unexec - builds. Including it here will render its inclusion after config.h - a no-op. */ -# if (defined DARWIN_OS && defined HAVE_UNEXEC) || defined HYBRID_MALLOC -# include -# endif -#endif - -#if defined DARWIN_OS && defined emacs && defined HAVE_UNEXEC -# undef malloc -# define malloc unexec_malloc -# undef realloc -# define realloc unexec_realloc -# undef free -# define free unexec_free - -extern void *unexec_malloc (size_t); -extern void *unexec_realloc (void *, size_t); -extern void unexec_free (void *); - -#endif - /* If HYBRID_MALLOC is defined (e.g., on Cygwin), emacs will use gmalloc before dumping and the system malloc after dumping. hybrid_malloc and friends, defined in gmalloc.c, are wrappers that diff --git a/src/emacs.c b/src/emacs.c index bdd9eee10c4..4e6f286d888 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -196,11 +196,6 @@ bool running_asynch_code; bool display_arg; #endif -#if defined GNU_LINUX && defined HAVE_UNEXEC -/* The gap between BSS end and heap start as far as we can tell. */ -static uintmax_t heap_bss_diff; -#endif - /* To run as a background daemon under Cocoa or Windows, we must do a fork+exec, not a simple fork. @@ -912,14 +907,6 @@ load_pdump (int argc, char **argv, char *dump_file) #endif ; - /* TODO: maybe more thoroughly scrub process environment in order to - make this use case (loading a dump file in an unexeced emacs) - possible? Right now, we assume that things we don't touch are - zero-initialized, and in an unexeced Emacs, this assumption - doesn't hold. */ - if (initialized) - fatal ("cannot load dump file in unexeced Emacs"); - /* Look for an explicitly-specified dump file. */ const char *path_exec = PATH_EXEC; dump_file = NULL; @@ -1318,53 +1305,34 @@ main (int argc, char **argv) #endif /* Look for this argument first, before any heap allocation, so we - can set heap flags properly if we're going to unexec. */ + can set heap flags properly if we're going to dump. */ if (!initialized && temacs) { -#ifdef HAVE_UNEXEC - if (strcmp (temacs, "dump") == 0 || - strcmp (temacs, "bootstrap") == 0) - gflags.will_dump_with_unexec_ = true; -#endif #ifdef HAVE_PDUMPER if (strcmp (temacs, "pdump") == 0 || strcmp (temacs, "pbootstrap") == 0) gflags.will_dump_with_pdumper_ = true; -#endif -#if defined HAVE_PDUMPER || defined HAVE_UNEXEC if (strcmp (temacs, "bootstrap") == 0 || strcmp (temacs, "pbootstrap") == 0) gflags.will_bootstrap_ = true; gflags.will_dump_ = - will_dump_with_pdumper_p () || - will_dump_with_unexec_p (); + will_dump_with_pdumper_p (); if (will_dump_p ()) dump_mode = temacs; #endif if (!dump_mode) fatal ("Invalid temacs mode '%s'", temacs); } - else if (temacs) - { - fatal ("--temacs not supported for unexeced emacs"); - } else { eassert (!temacs); -#ifndef HAVE_UNEXEC eassert (!initialized); -#endif #ifdef HAVE_PDUMPER if (!initialized) attempt_load_pdump = true; #endif } -#ifdef HAVE_UNEXEC - if (!will_dump_with_unexec_p ()) - gflags.will_not_unexec_ = true; -#endif - #ifdef WINDOWSNT /* Grab our malloc arena space now, before anything important happens. This relies on the static heap being needed only in @@ -1427,25 +1395,12 @@ main (int argc, char **argv) argc = maybe_disable_address_randomization (argc, argv); -#if defined GNU_LINUX && defined HAVE_UNEXEC - if (!initialized) - { - char *heap_start = my_heap_start (); - heap_bss_diff = heap_start - max (my_endbss, my_endbss_static); - } -#endif #ifdef RUN_TIME_REMAP if (initialized) run_time_remap (argv[0]); #endif -/* If using unexmacosx.c (set by s/darwin.h), we must do this. */ -#if defined DARWIN_OS && defined HAVE_UNEXEC - if (!initialized) - unexec_init_emacs_zone (); -#endif - init_standard_fds (); atexit (close_output_streams); @@ -1627,10 +1582,7 @@ main (int argc, char **argv) #endif /* MSDOS */ /* Set locale, so that initial error messages are localized properly. - However, skip this if LC_ALL is "C", as it's not needed in that case. - Skipping helps if dumping with unexec, to ensure that the dumped - Emacs does not have its system locale tables initialized, as that - might cause screwups when the dumped Emacs starts up. */ + However, skip this if LC_ALL is "C", as it's not needed in that case. */ char *lc_all = getenv ("LC_ALL"); if (! (lc_all && strcmp (lc_all, "C") == 0)) { @@ -3155,117 +3107,6 @@ shut_down_emacs (int sig, Lisp_Object stuff) } - -#ifdef HAVE_UNEXEC - -#include "unexec.h" - -DEFUN ("dump-emacs", Fdump_emacs, Sdump_emacs, 2, 2, 0, - doc: /* Dump current state of Emacs into executable file FILENAME. -Take symbols from SYMFILE (presumably the file you executed to run Emacs). -This is used in the file `loadup.el' when building Emacs. - -You must run Emacs in batch mode in order to dump it. */) - (Lisp_Object filename, Lisp_Object symfile) -{ - Lisp_Object tem; - Lisp_Object symbol; - specpdl_ref count = SPECPDL_INDEX (); - - check_pure_size (); - - if (! noninteractive) - error ("Dumping Emacs works only in batch mode"); - - if (dumped_with_unexec_p ()) - error ("Emacs can be dumped using unexec only once"); - - if (definitely_will_not_unexec_p ()) - error ("This Emacs instance was not started in temacs mode"); - -# if defined GNU_LINUX && defined HAVE_UNEXEC - - /* Warn if the gap between BSS end and heap start is larger than this. */ -# define MAX_HEAP_BSS_DIFF (1024 * 1024) - - if (heap_bss_diff > MAX_HEAP_BSS_DIFF) - fprintf (stderr, - ("**************************************************\n" - "Warning: Your system has a gap between BSS and the\n" - "heap (%"PRIuMAX" bytes). This usually means that exec-shield\n" - "or something similar is in effect. The dump may\n" - "fail because of this. See the section about\n" - "exec-shield in etc/PROBLEMS for more information.\n" - "**************************************************\n"), - heap_bss_diff); -# endif - - /* Bind `command-line-processed' to nil before dumping, - so that the dumped Emacs will process its command line - and set up to work with X windows if appropriate. */ - symbol = Qcommand_line_processed; - specbind (symbol, Qnil); - - CHECK_STRING (filename); - filename = Fexpand_file_name (filename, Qnil); - filename = ENCODE_FILE (filename); - if (!NILP (symfile)) - { - CHECK_STRING (symfile); - if (SCHARS (symfile)) - { - symfile = Fexpand_file_name (symfile, Qnil); - symfile = ENCODE_FILE (symfile); - } - } - - tem = Vpurify_flag; - Vpurify_flag = Qnil; - -# ifdef HYBRID_MALLOC - { - static char const fmt[] = "%d of %d static heap bytes used"; - char buf[sizeof fmt + 2 * (INT_STRLEN_BOUND (int) - 2)]; - int max_usage = max_bss_sbrk_ptr - bss_sbrk_buffer; - sprintf (buf, fmt, max_usage, STATIC_HEAP_SIZE); - /* Don't log messages, because at this point buffers cannot be created. */ - message1_nolog (buf); - } -# endif - - fflush (stdout); - /* Tell malloc where start of impure now is. */ - /* Also arrange for warnings when nearly out of space. */ -# if !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC && !defined WINDOWSNT - /* On Windows, this was done before dumping, and that once suffices. - Meanwhile, my_edata is not valid on Windows. */ - memory_warnings (my_edata, malloc_warning); -# endif - - struct gflags old_gflags = gflags; - gflags.will_dump_ = false; - gflags.will_dump_with_unexec_ = false; - gflags.dumped_with_unexec_ = true; - - alloc_unexec_pre (); - - unexec (SSDATA (filename), !NILP (symfile) ? SSDATA (symfile) : 0); - - alloc_unexec_post (); - - gflags = old_gflags; - -# ifdef WINDOWSNT - Vlibrary_cache = Qnil; -# endif - - Vpurify_flag = tem; - - return unbind_to (count, Qnil); -} - -#endif - /* Recover from setlocale (LC_ALL, ""). */ void @@ -3565,10 +3406,6 @@ syms_of_emacs (void) DEFSYM (Qcommand_line_processed, "command-line-processed"); DEFSYM (Qsafe_magic, "safe-magic"); -#ifdef HAVE_UNEXEC - defsubr (&Sdump_emacs); -#endif - defsubr (&Skill_emacs); defsubr (&Sinvocation_name); diff --git a/src/lastfile.c b/src/lastfile.c index 48d3ac78634..c6baad4ac01 100644 --- a/src/lastfile.c +++ b/src/lastfile.c @@ -42,14 +42,3 @@ along with GNU Emacs. If not, see . */ || defined WINDOWSNT || defined CYGWIN || defined DARWIN_OS) char my_edata[] = "End of Emacs initialized data"; #endif - -#ifdef HAVE_UNEXEC - -/* Help unexec locate the end of the .bss area used by Emacs (which - isn't always a separate section in NT executables). */ -char my_endbss[1]; - -static char _my_endbss[1]; -char * my_endbss_static = _my_endbss; - -#endif diff --git a/src/lisp.h b/src/lisp.h index 832a1755c04..a7b84b25b81 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -640,20 +640,12 @@ extern struct gflags dump. */ bool dumped_with_pdumper_ : 1; #endif -#ifdef HAVE_UNEXEC - bool will_dump_with_unexec_ : 1; - /* Set in an Emacs process that has been restored from an unexec - dump. */ - bool dumped_with_unexec_ : 1; - /* We promise not to unexec: useful for hybrid malloc. */ - bool will_not_unexec_ : 1; -#endif } gflags; INLINE bool will_dump_p (void) { -#if HAVE_PDUMPER || defined HAVE_UNEXEC +#if HAVE_PDUMPER return gflags.will_dump_; #else return false; @@ -663,7 +655,7 @@ will_dump_p (void) INLINE bool will_bootstrap_p (void) { -#if HAVE_PDUMPER || defined HAVE_UNEXEC +#if HAVE_PDUMPER return gflags.will_bootstrap_; #else return false; @@ -690,39 +682,6 @@ dumped_with_pdumper_p (void) #endif } -INLINE bool -will_dump_with_unexec_p (void) -{ -#ifdef HAVE_UNEXEC - return gflags.will_dump_with_unexec_; -#else - return false; -#endif -} - -INLINE bool -dumped_with_unexec_p (void) -{ -#ifdef HAVE_UNEXEC - return gflags.dumped_with_unexec_; -#else - return false; -#endif -} - -/* This function is the opposite of will_dump_with_unexec_p(), except - that it returns false before main runs. It's important to use - gmalloc for any pre-main allocations if we're going to unexec. */ -INLINE bool -definitely_will_not_unexec_p (void) -{ -#ifdef HAVE_UNEXEC - return gflags.will_not_unexec_; -#else - return true; -#endif -} - /* Defined in floatfns.c. */ extern double extract_float (Lisp_Object); @@ -3443,14 +3402,10 @@ CHECK_SUBR (Lisp_Object x) /* If we're not dumping using the legacy dumper and we might be using the portable dumper, try to bunch all the subr structures together for more efficient dump loading. */ -#ifndef HAVE_UNEXEC -# ifdef DARWIN_OS -# define SUBR_SECTION_ATTRIBUTE ATTRIBUTE_SECTION ("__DATA,subrs") -# else -# define SUBR_SECTION_ATTRIBUTE ATTRIBUTE_SECTION (".subrs") -# endif +#ifdef DARWIN_OS +# define SUBR_SECTION_ATTRIBUTE ATTRIBUTE_SECTION ("__DATA,subrs") #else -# define SUBR_SECTION_ATTRIBUTE +# define SUBR_SECTION_ATTRIBUTE ATTRIBUTE_SECTION (".subrs") #endif /* Define a built-in function for calling from Lisp. @@ -4492,8 +4447,6 @@ extern void mark_objects (Lisp_Object *, ptrdiff_t); #if defined REL_ALLOC && !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC extern void refill_memory_reserve (void); #endif -extern void alloc_unexec_pre (void); -extern void alloc_unexec_post (void); extern void mark_c_stack (char const *, char const *); extern void flush_stack_call_func1 (void (*func) (void *arg), void *arg); extern void mark_memory (void const *start, void const *end); @@ -4927,14 +4880,6 @@ void do_debug_on_call (Lisp_Object code, specpdl_ref count); Lisp_Object funcall_general (Lisp_Object fun, ptrdiff_t numargs, Lisp_Object *args); -/* Defined in unexmacosx.c. */ -#if defined DARWIN_OS && defined HAVE_UNEXEC -extern void unexec_init_emacs_zone (void); -extern void *unexec_malloc (size_t); -extern void *unexec_realloc (void *, size_t); -extern void unexec_free (void *); -#endif - /* The definition of Lisp_Module_Function depends on emacs-module.h, so we don't define it here. It's defined in emacs-module.c. */ diff --git a/src/pdumper.c b/src/pdumper.c index c8baa311854..88e8e810adc 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -4143,12 +4143,6 @@ types. */) "contributing a patch to Emacs."); #endif - if (will_dump_with_unexec_p ()) - error ("This Emacs instance was started under the assumption " - "that it would be dumped with unexec, not the portable " - "dumper. Dumping with the portable dumper may produce " - "unexpected results."); - if (!main_thread_p (current_thread)) error ("This function can be called only in the main thread"); diff --git a/src/process.c b/src/process.c index b71ba3daf2d..dcf08fd9b57 100644 --- a/src/process.c +++ b/src/process.c @@ -8620,50 +8620,39 @@ init_process_emacs (int sockfd) inhibit_sentinels = 0; -#ifdef HAVE_UNEXEC - /* Clear child_signal_read_fd and child_signal_write_fd after dumping, - lest wait_reading_process_output should select on nonexistent file - descriptors which existed in the build process. */ - child_signal_read_fd = -1; - child_signal_write_fd = -1; -#endif /* HAVE_UNEXEC */ +#if defined HAVE_GLIB && !defined WINDOWSNT + /* Tickle Glib's child-handling code. Ask Glib to install a + watch source for Emacs itself which will initialize glib's + private SIGCHLD handler, allowing catch_child_signal to copy + it into lib_child_handler. This is a hacky workaround to get + glib's g_unix_signal_handler into lib_child_handler. + + In Glib 2.37.5 (2013), commit 2e471acf changed Glib to + always install a signal handler when g_child_watch_source_new + is called and not just the first time it's called, and to + reset signal handlers to SIG_DFL when it no longer has a + watcher on that signal. Arrange for Emacs's signal handler + to be reinstalled even if this happens. + + In Glib 2.73.2 (2022), commit f615eef4 changed Glib again, + to not install a signal handler if the system supports + pidfd_open and waitid (as in Linux kernel 5.3+). The hacky + workaround is not needed in this case. */ + GSource *source = g_child_watch_source_new (getpid ()); + catch_child_signal (); + g_source_unref (source); - if (!will_dump_with_unexec_p ()) + if (lib_child_handler != dummy_handler) { -#if defined HAVE_GLIB && !defined WINDOWSNT - /* Tickle Glib's child-handling code. Ask Glib to install a - watch source for Emacs itself which will initialize glib's - private SIGCHLD handler, allowing catch_child_signal to copy - it into lib_child_handler. This is a hacky workaround to get - glib's g_unix_signal_handler into lib_child_handler. - - In Glib 2.37.5 (2013), commit 2e471acf changed Glib to - always install a signal handler when g_child_watch_source_new - is called and not just the first time it's called, and to - reset signal handlers to SIG_DFL when it no longer has a - watcher on that signal. Arrange for Emacs's signal handler - to be reinstalled even if this happens. - - In Glib 2.73.2 (2022), commit f615eef4 changed Glib again, - to not install a signal handler if the system supports - pidfd_open and waitid (as in Linux kernel 5.3+). The hacky - workaround is not needed in this case. */ - GSource *source = g_child_watch_source_new (getpid ()); + /* The hacky workaround is needed on this platform. */ + signal_handler_t lib_child_handler_glib = lib_child_handler; catch_child_signal (); - g_source_unref (source); - - if (lib_child_handler != dummy_handler) - { - /* The hacky workaround is needed on this platform. */ - signal_handler_t lib_child_handler_glib = lib_child_handler; - catch_child_signal (); - eassert (lib_child_handler == dummy_handler); - lib_child_handler = lib_child_handler_glib; - } + eassert (lib_child_handler == dummy_handler); + lib_child_handler = lib_child_handler_glib; + } #else - catch_child_signal (); + catch_child_signal (); #endif - } #ifdef HAVE_SETRLIMIT /* Don't allocate more than FD_SETSIZE file descriptors for Emacs itself. */ diff --git a/src/sysdep.c b/src/sysdep.c index bb4892af4af..e0ec74d8364 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -165,9 +165,7 @@ maybe_disable_address_randomization (int argc, char **argv) if (argc < 2 || strcmp (argv[1], aslr_disabled_option) != 0) { - /* If dumping via unexec, ASLR must be disabled, as otherwise - data may be scattered and undumpable as a simple executable. - If pdumping, disabling ASLR lessens differences in the .pdmp file. */ + /* If pdumping, disabling ASLR lessens differences in the .pdmp file. */ bool disable_aslr = will_dump_p (); # ifdef __PPC64__ disable_aslr = true; @@ -2036,12 +2034,6 @@ init_signals (void) main_thread_id = pthread_self (); #endif - /* Don't alter signal handlers if dumping with unexec. On some - machines, changing signal handlers sets static data that would make - signals fail to work right when the dumped Emacs is run. */ - if (will_dump_with_unexec_p ()) - return; - sigfillset (&process_fatal_action.sa_mask); process_fatal_action.sa_handler = deliver_fatal_signal; process_fatal_action.sa_flags = emacs_sigaction_flags (); diff --git a/src/timefns.c b/src/timefns.c index f16a34d651b..520a48f2b9b 100644 --- a/src/timefns.c +++ b/src/timefns.c @@ -318,37 +318,8 @@ tzlookup (Lisp_Object zone, bool settz) void init_timefns (void) { -#ifdef HAVE_UNEXEC - /* A valid but unlikely setting for the TZ environment variable. - It is OK (though a bit slower) if the user chooses this value. */ - static char dump_tz_string[] = "TZ=UtC0"; - - /* When just dumping out, set the time zone to a known unlikely value - and skip the rest of this function. */ - if (will_dump_with_unexec_p ()) - { - xputenv (dump_tz_string); - tzset (); - return; - } -#endif - char *tz = getenv ("TZ"); -#ifdef HAVE_UNEXEC - /* If the execution TZ happens to be the same as the dump TZ, - change it to some other value and then change it back, - to force the underlying implementation to reload the TZ info. - This is needed on implementations that load TZ info from files, - since the TZ file contents may differ between dump and execution. */ - if (tz && strcmp (tz, &dump_tz_string[tzeqlen]) == 0) - { - ++*tz; - tzset (); - --*tz; - } -#endif - /* Set the time zone rule now, so that the call to putenv is done before multiple threads are active. */ tzlookup (tz ? build_string (tz) : Qwall, true); diff --git a/src/w32heap.c b/src/w32heap.c index 601686f5331..c5777622c56 100644 --- a/src/w32heap.c +++ b/src/w32heap.c @@ -617,31 +617,6 @@ sys_calloc (size_t number, size_t size) return ptr; } -#if defined HAVE_UNEXEC && defined ENABLE_CHECKING -void -report_temacs_memory_usage (void) -{ - DWORD blocks_used = 0; - size_t large_mem_used = 0; - int i; - - for (i = 0; i < blocks_number; i++) - if (blocks[i].occupied) - { - blocks_used++; - large_mem_used += blocks[i].size; - } - - /* Emulate 'message', which writes to stderr in non-interactive - sessions. */ - fprintf (stderr, - "Dump memory usage: Heap: %" PRIu64 " Large blocks(%lu/%lu): %" PRIu64 "/%" PRIu64 "\n", - (unsigned long long)committed, blocks_used, blocks_number, - (unsigned long long)large_mem_used, - (unsigned long long)(dumped_data + DUMPED_HEAP_SIZE - bc_limit)); -} -#endif - /* Emulate getpagesize. */ int getpagesize (void) diff --git a/src/w32heap.h b/src/w32heap.h index 24b02fabbfc..901c9b5a41e 100644 --- a/src/w32heap.h +++ b/src/w32heap.h @@ -1,4 +1,4 @@ -/* Heap management routines (including unexec) for GNU Emacs on Windows NT. +/* Heap management routines for GNU Emacs on Windows NT. Copyright (C) 1994, 2001-2024 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/src/w32image.c b/src/w32image.c index da4d6843ba9..02700338715 100644 --- a/src/w32image.c +++ b/src/w32image.c @@ -634,6 +634,4 @@ syms_of_w32image (void) void globals_of_w32image (void) { - /* This is only needed in an unexec build. */ - memset (&last_encoder, 0, sizeof last_encoder); } commit 7ce34a3bcf5ed277ef37aa75e1ccbd858543b6cf Author: Pip Cet Date: Tue Aug 20 18:29:53 2024 +0000 Unexec removal: Remove obsolete files * src/sheap.c, src/sheap.h, src/unexec.h, src/unexaix.c, unexcoff.c: * src/unexcw.c, src/unexelf.c, src/unexhp9k800.c, src/unexmacosx.c: * src/unexsol.c, src/unexw32.c: Remove files. diff --git a/src/sheap.c b/src/sheap.c deleted file mode 100644 index bab70c4e343..00000000000 --- a/src/sheap.c +++ /dev/null @@ -1,79 +0,0 @@ -/* simulate `sbrk' with an array in .bss, for `unexec' support for Cygwin; - complete rewrite of xemacs Cygwin `unexec' code - - Copyright (C) 2004-2024 Free Software Foundation, Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or (at -your option) any later version. - -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see . */ - -#include - -#include "sheap.h" - -#include -#include "lisp.h" -#include -#include /* for exit */ - -static int debug_sheap; - -char bss_sbrk_buffer[STATIC_HEAP_SIZE]; -char *max_bss_sbrk_ptr; - -void * -bss_sbrk (ptrdiff_t request_size) -{ - static char *bss_sbrk_ptr; - - if (!bss_sbrk_ptr) - { - max_bss_sbrk_ptr = bss_sbrk_ptr = bss_sbrk_buffer; -#ifdef CYGWIN - /* Force space for fork to work. */ - sbrk (4096); -#endif - } - - int used = bss_sbrk_ptr - bss_sbrk_buffer; - - if (request_size < -used) - { - printf (("attempt to free too much: " - "avail %d used %d failed request %"pD"d\n"), - STATIC_HEAP_SIZE, used, request_size); - exit (-1); - return 0; - } - else if (STATIC_HEAP_SIZE - used < request_size) - { - printf ("static heap exhausted: avail %d used %d failed request %"pD"d\n", - STATIC_HEAP_SIZE, used, request_size); - exit (-1); - return 0; - } - - void *ret = bss_sbrk_ptr; - bss_sbrk_ptr += request_size; - if (max_bss_sbrk_ptr < bss_sbrk_ptr) - max_bss_sbrk_ptr = bss_sbrk_ptr; - if (debug_sheap) - { - if (request_size < 0) - printf ("freed size %"pD"d\n", request_size); - else - printf ("allocated %p size %"pD"d\n", ret, request_size); - } - return ret; -} diff --git a/src/sheap.h b/src/sheap.h deleted file mode 100644 index 92f7ba5e857..00000000000 --- a/src/sheap.h +++ /dev/null @@ -1,30 +0,0 @@ -/* Static heap allocation for GNU Emacs. - -Copyright 2016-2024 Free Software Foundation, Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or -(at your option) any later version. - -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see . */ - -#include -#include "lisp.h" - -/* Size of the static heap. Guess a value that is probably too large, - by up to a factor of four or so. Typically the unused part is not - paged in and so does not cost much. */ -enum { STATIC_HEAP_SIZE = sizeof (Lisp_Object) << 24 }; - -extern char bss_sbrk_buffer[STATIC_HEAP_SIZE]; -extern char *max_bss_sbrk_ptr; -extern void *bss_sbrk (ptrdiff_t); diff --git a/src/unexaix.c b/src/unexaix.c deleted file mode 100644 index f9bc39cf927..00000000000 --- a/src/unexaix.c +++ /dev/null @@ -1,611 +0,0 @@ -/* Dump an executable file. - Copyright (C) 1985-1988, 1999, 2001-2024 Free Software Foundation, - Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or (at -your option) any later version. - -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see . */ - -/* -In other words, you are welcome to use, share and improve this program. -You are forbidden to forbid anyone else to use, share and improve -what you give them. Help stamp out software-hoarding! */ - - -/* Originally based on the COFF unexec.c by Spencer W. Thomas. - * - * Subsequently hacked on by - * Bill Mann - * Andrew Vignaux - * Mike Sperber - * - * Synopsis: - * unexec (const char *new_name, const *old_name); - * - * Takes a snapshot of the program and makes an a.out format file in the - * file named by the string argument new_name. - * If a_name is non-NULL, the symbol table will be taken from the given file. - * On some machines, an existing a_name file is required. - * - */ - -#include -#include "unexec.h" -#include "lisp.h" - -#define PERROR(file) report_error (file, new) -#include -/* Define getpagesize () if the system does not. - Note that this may depend on symbols defined in a.out.h - */ -#include "getpagesize.h" - -#include -#include -#include -#include -#include -#include -#include - -extern char _data[]; -extern char _text[]; - -#include -#include -#include -#include - -static struct filehdr f_hdr; /* File header */ -static struct aouthdr f_ohdr; /* Optional file header (a.out) */ -static off_t bias; /* Bias to add for growth */ -static off_t lnnoptr; /* Pointer to line-number info within file */ - -static off_t text_scnptr; -static off_t data_scnptr; -#define ALIGN(val, pwr) (((val) + ((1L<<(pwr))-1)) & ~((1L<<(pwr))-1)) -static off_t load_scnptr; -static off_t orig_load_scnptr; -static off_t orig_data_scnptr; -static int unrelocate_symbols (int, int, const char *, const char *); - -#ifndef MAX_SECTIONS -#define MAX_SECTIONS 10 -#endif - -static int adjust_lnnoptrs (int, int, const char *); - -static int pagemask; - -#include "lisp.h" - -static _Noreturn void -report_error (const char *file, int fd) -{ - int err = errno; - if (fd) - emacs_close (fd); - report_file_errno ("Cannot unexec", build_string (file), err); -} - -#define ERROR0(msg) report_error_1 (new, msg) -#define ERROR1(msg,x) report_error_1 (new, msg, x) -#define ERROR2(msg,x,y) report_error_1 (new, msg, x, y) - -static _Noreturn void ATTRIBUTE_FORMAT_PRINTF (2, 3) -report_error_1 (int fd, const char *msg, ...) -{ - va_list ap; - emacs_close (fd); - va_start (ap, msg); - verror (msg, ap); - va_end (ap); -} - -static int make_hdr (int, int, const char *, const char *); -static void mark_x (const char *); -static int copy_text_and_data (int); -static int copy_sym (int, int, const char *, const char *); -static void write_segment (int, char *, char *); - -/* **************************************************************** - * unexec - * - * driving logic. - */ -void -unexec (const char *new_name, const char *a_name) -{ - int new = -1, a_out = -1; - - if (a_name && (a_out = emacs_open (a_name, O_RDONLY, 0)) < 0) - { - PERROR (a_name); - } - if ((new = emacs_open (new_name, O_WRONLY | O_CREAT | O_TRUNC, 0777)) < 0) - { - PERROR (new_name); - } - if (make_hdr (new, a_out, - a_name, new_name) < 0 - || copy_text_and_data (new) < 0 - || copy_sym (new, a_out, a_name, new_name) < 0 - || adjust_lnnoptrs (new, a_out, new_name) < 0 - || unrelocate_symbols (new, a_out, a_name, new_name) < 0) - { - emacs_close (new); - return; - } - - emacs_close (new); - if (a_out >= 0) - emacs_close (a_out); -} - -/* **************************************************************** - * make_hdr - * - * Make the header in the new a.out from the header in core. - * Modify the text and data sizes. - */ -static int -make_hdr (int new, int a_out, - const char *a_name, const char *new_name) -{ - int scns; - uintptr_t bss_start; - uintptr_t data_start; - - struct scnhdr section[MAX_SECTIONS]; - struct scnhdr * f_thdr; /* Text section header */ - struct scnhdr * f_dhdr; /* Data section header */ - struct scnhdr * f_bhdr; /* Bss section header */ - struct scnhdr * f_lhdr; /* Loader section header */ - struct scnhdr * f_tchdr; /* Typechk section header */ - struct scnhdr * f_dbhdr; /* Debug section header */ - struct scnhdr * f_xhdr; /* Except section header */ - - load_scnptr = orig_load_scnptr = lnnoptr = 0; - pagemask = getpagesize () - 1; - - /* Adjust text/data boundary. */ - data_start = (uintptr_t) _data; - - data_start = data_start & ~pagemask; /* (Down) to page boundary. */ - - bss_start = (uintptr_t) sbrk (0) + pagemask; - bss_start &= ~ pagemask; - - if (data_start > bss_start) /* Can't have negative data size. */ - { - ERROR2 (("unexec: data_start (0x%"PRIxPTR - ") can't be greater than bss_start (0x%"PRIxPTR")"), - data_start, bss_start); - } - - /* Salvage as much info from the existing file as possible */ - f_thdr = NULL; f_dhdr = NULL; f_bhdr = NULL; - f_lhdr = NULL; f_tchdr = NULL; f_dbhdr = NULL; f_xhdr = NULL; - if (a_out >= 0) - { - if (read (a_out, &f_hdr, sizeof (f_hdr)) != sizeof (f_hdr)) - { - PERROR (a_name); - } - if (f_hdr.f_opthdr > 0) - { - if (read (a_out, &f_ohdr, sizeof (f_ohdr)) != sizeof (f_ohdr)) - { - PERROR (a_name); - } - } - if (f_hdr.f_nscns > MAX_SECTIONS) - { - ERROR0 ("unexec: too many section headers -- increase MAX_SECTIONS"); - } - /* Loop through section headers */ - for (scns = 0; scns < f_hdr.f_nscns; scns++) { - struct scnhdr *s = §ion[scns]; - if (read (a_out, s, sizeof (*s)) != sizeof (*s)) - { - PERROR (a_name); - } - -#define CHECK_SCNHDR(ptr, name, flags) \ - if (strcmp (s->s_name, name) == 0) { \ - if (s->s_flags != flags) { \ - fprintf (stderr, "unexec: %lx flags where %x expected in %s section.\n", \ - (unsigned long)s->s_flags, flags, name); \ - } \ - if (ptr) { \ - fprintf (stderr, "unexec: duplicate section header for section %s.\n", \ - name); \ - } \ - ptr = s; \ - } - CHECK_SCNHDR (f_thdr, _TEXT, STYP_TEXT); - CHECK_SCNHDR (f_dhdr, _DATA, STYP_DATA); - CHECK_SCNHDR (f_bhdr, _BSS, STYP_BSS); - CHECK_SCNHDR (f_lhdr, _LOADER, STYP_LOADER); - CHECK_SCNHDR (f_dbhdr, _DEBUG, STYP_DEBUG); - CHECK_SCNHDR (f_tchdr, _TYPCHK, STYP_TYPCHK); - CHECK_SCNHDR (f_xhdr, _EXCEPT, STYP_EXCEPT); - } - - if (f_thdr == 0) - { - ERROR1 ("unexec: couldn't find \"%s\" section", _TEXT); - } - if (f_dhdr == 0) - { - ERROR1 ("unexec: couldn't find \"%s\" section", _DATA); - } - if (f_bhdr == 0) - { - ERROR1 ("unexec: couldn't find \"%s\" section", _BSS); - } - } - else - { - ERROR0 ("can't build a COFF file from scratch yet"); - } - orig_data_scnptr = f_dhdr->s_scnptr; - orig_load_scnptr = f_lhdr ? f_lhdr->s_scnptr : 0; - - /* Now we alter the contents of all the f_*hdr variables - to correspond to what we want to dump. */ - - /* Indicate that the reloc information is no longer valid for ld (bind); - we only update it enough to fake out the exec-time loader. */ - f_hdr.f_flags |= (F_RELFLG | F_EXEC); - - f_ohdr.dsize = bss_start - f_ohdr.data_start; - f_ohdr.bsize = 0; - - f_dhdr->s_size = f_ohdr.dsize; - f_bhdr->s_size = f_ohdr.bsize; - f_bhdr->s_paddr = f_ohdr.data_start + f_ohdr.dsize; - f_bhdr->s_vaddr = f_ohdr.data_start + f_ohdr.dsize; - - /* fix scnptr's */ - { - off_t ptr = section[0].s_scnptr; - - bias = -1; - for (scns = 0; scns < f_hdr.f_nscns; scns++) - { - struct scnhdr *s = §ion[scns]; - - if (s->s_flags & STYP_PAD) /* .pad sections omitted in AIX 4.1 */ - { - /* - * the text_start should probably be o_algntext but that doesn't - * seem to change - */ - if (f_ohdr.text_start != 0) /* && scns != 0 */ - { - s->s_size = 512 - (ptr % 512); - if (s->s_size == 512) - s->s_size = 0; - } - s->s_scnptr = ptr; - } - else if (s->s_flags & STYP_DATA) - s->s_scnptr = ptr; - else if (!(s->s_flags & (STYP_TEXT | STYP_BSS))) - { - if (bias == -1) /* if first section after bss */ - bias = ptr - s->s_scnptr; - - s->s_scnptr += bias; - ptr = s->s_scnptr; - } - - ptr = ptr + s->s_size; - } - } - - /* fix other pointers */ - for (scns = 0; scns < f_hdr.f_nscns; scns++) - { - struct scnhdr *s = §ion[scns]; - - if (s->s_relptr != 0) - { - s->s_relptr += bias; - } - if (s->s_lnnoptr != 0) - { - if (lnnoptr == 0) lnnoptr = s->s_lnnoptr; - s->s_lnnoptr += bias; - } - } - - if (f_hdr.f_symptr > 0L) - { - f_hdr.f_symptr += bias; - } - - text_scnptr = f_thdr->s_scnptr; - data_scnptr = f_dhdr->s_scnptr; - load_scnptr = f_lhdr ? f_lhdr->s_scnptr : 0; - - if (write (new, &f_hdr, sizeof (f_hdr)) != sizeof (f_hdr)) - { - PERROR (new_name); - } - - if (f_hdr.f_opthdr > 0) - { - if (write (new, &f_ohdr, sizeof (f_ohdr)) != sizeof (f_ohdr)) - { - PERROR (new_name); - } - } - - for (scns = 0; scns < f_hdr.f_nscns; scns++) { - struct scnhdr *s = §ion[scns]; - if (write (new, s, sizeof (*s)) != sizeof (*s)) - { - PERROR (new_name); - } - } - - return (0); -} - -/* **************************************************************** - - * - * Copy the text and data segments from memory to the new a.out - */ -static int -copy_text_and_data (int new) -{ - char *end; - char *ptr; - - lseek (new, text_scnptr, SEEK_SET); - ptr = _text; - end = ptr + f_ohdr.tsize; - write_segment (new, ptr, end); - - lseek (new, data_scnptr, SEEK_SET); - ptr = (char *) (ptrdiff_t) f_ohdr.data_start; - end = ptr + f_ohdr.dsize; - write_segment (new, ptr, end); - - return 0; -} - -#define UnexBlockSz (1<<12) /* read/write block size */ -static void -write_segment (int new, char *ptr, char *end) -{ - int i, nwrite, ret; - char zeros[UnexBlockSz]; - - for (i = 0; ptr < end;) - { - /* distance to next block. */ - nwrite = (((ptrdiff_t) ptr + UnexBlockSz) & -UnexBlockSz) - (ptrdiff_t) ptr; - /* But not beyond specified end. */ - if (nwrite > end - ptr) nwrite = end - ptr; - ret = write (new, ptr, nwrite); - /* If write gets a page fault, it means we reached - a gap between the old text segment and the old data segment. - This gap has probably been remapped into part of the text segment. - So write zeros for it. */ - if (ret == -1 && errno == EFAULT) - { - memset (zeros, 0, nwrite); - write (new, zeros, nwrite); - } - else if (nwrite != ret) - { - int write_errno = errno; - char buf[1000]; - void *addr = ptr; - sprintf (buf, - "unexec write failure: addr %p, fileno %d, size 0x%x, wrote 0x%x, errno %d", - addr, new, nwrite, ret, errno); - errno = write_errno; - PERROR (buf); - } - i += nwrite; - ptr += nwrite; - } -} - -/* **************************************************************** - * copy_sym - * - * Copy the relocation information and symbol table from the a.out to the new - */ -static int -copy_sym (int new, int a_out, const char *a_name, const char *new_name) -{ - char page[UnexBlockSz]; - int n; - - if (a_out < 0) - return 0; - - if (orig_load_scnptr == 0L) - return 0; - - if (lnnoptr && lnnoptr < orig_load_scnptr) /* if there is line number info */ - lseek (a_out, lnnoptr, SEEK_SET); /* start copying from there */ - else - lseek (a_out, orig_load_scnptr, SEEK_SET); /* Position a.out to symtab. */ - - while ((n = read (a_out, page, sizeof page)) > 0) - { - if (write (new, page, n) != n) - { - PERROR (new_name); - } - } - if (n < 0) - { - PERROR (a_name); - } - return 0; -} - -static int -adjust_lnnoptrs (int writedesc, int readdesc, const char *new_name) -{ - int nsyms; - int naux; - int new; - struct syment symentry; - union auxent auxentry; - - if (!lnnoptr || !f_hdr.f_symptr) - return 0; - - if ((new = emacs_open (new_name, O_RDWR, 0)) < 0) - { - PERROR (new_name); - return -1; - } - - lseek (new, f_hdr.f_symptr, SEEK_SET); - for (nsyms = 0; nsyms < f_hdr.f_nsyms; nsyms++) - { - read (new, &symentry, SYMESZ); - if (symentry.n_sclass == C_BINCL || symentry.n_sclass == C_EINCL) - { - symentry.n_value += bias; - lseek (new, -SYMESZ, SEEK_CUR); - write (new, &symentry, SYMESZ); - } - - for (naux = symentry.n_numaux; naux-- != 0; ) - { - read (new, &auxentry, AUXESZ); - nsyms++; - if (naux != 0 /* skip csect auxentry (last entry) */ - && (symentry.n_sclass == C_EXT || symentry.n_sclass == C_HIDEXT)) - { - auxentry.x_sym.x_fcnary.x_fcn.x_lnnoptr += bias; - lseek (new, -AUXESZ, SEEK_CUR); - write (new, &auxentry, AUXESZ); - } - } - } - emacs_close (new); - - return 0; -} - -static int -unrelocate_symbols (int new, int a_out, - const char *a_name, const char *new_name) -{ - int i; - LDHDR ldhdr; - LDREL ldrel; - off_t t_reloc = (intptr_t) _text - f_ohdr.text_start; -#ifndef ALIGN_DATA_RELOC - off_t d_reloc = (intptr_t) _data - f_ohdr.data_start; -#else - /* This worked (and was needed) before AIX 4.2. - I have no idea why. -- Mike */ - off_t d_reloc = (intptr_t) _data - ALIGN (f_ohdr.data_start, 2); -#endif - int * p; - - if (load_scnptr == 0) - return 0; - - lseek (a_out, orig_load_scnptr, SEEK_SET); - if (read (a_out, &ldhdr, sizeof (ldhdr)) != sizeof (ldhdr)) - { - PERROR (new_name); - } - -#define SYMNDX_TEXT 0 -#define SYMNDX_DATA 1 -#define SYMNDX_BSS 2 - - for (i = 0; i < ldhdr.l_nreloc; i++) - { - lseek (a_out, - orig_load_scnptr + LDHDRSZ + LDSYMSZ*ldhdr.l_nsyms + LDRELSZ*i, - SEEK_SET); - - if (read (a_out, &ldrel, LDRELSZ) != LDRELSZ) - { - PERROR (a_name); - } - - /* move the BSS loader symbols to the DATA segment */ - if (ldrel.l_symndx == SYMNDX_BSS) - { - ldrel.l_symndx = SYMNDX_DATA; - - lseek (new, - load_scnptr + LDHDRSZ + LDSYMSZ*ldhdr.l_nsyms + LDRELSZ*i, - SEEK_SET); - - if (write (new, &ldrel, LDRELSZ) != LDRELSZ) - { - PERROR (new_name); - } - } - - if (ldrel.l_rsecnm == f_ohdr.o_sndata) - { - int orig_int; - - lseek (a_out, - orig_data_scnptr + (ldrel.l_vaddr - f_ohdr.data_start), - SEEK_SET); - - if (read (a_out, (void *) &orig_int, sizeof (orig_int)) - != sizeof (orig_int)) - { - PERROR (a_name); - } - - p = (int *) (intptr_t) (ldrel.l_vaddr + d_reloc); - - switch (ldrel.l_symndx) { - case SYMNDX_TEXT: - orig_int = * p - t_reloc; - break; - - case SYMNDX_DATA: - case SYMNDX_BSS: - orig_int = * p - d_reloc; - break; - } - - if (orig_int != * p) - { - lseek (new, - data_scnptr + (ldrel.l_vaddr - f_ohdr.data_start), - SEEK_SET); - if (write (new, (void *) &orig_int, sizeof (orig_int)) - != sizeof (orig_int)) - { - PERROR (new_name); - } - } - } - } - return 0; -} diff --git a/src/unexcoff.c b/src/unexcoff.c deleted file mode 100644 index 4a981da4a04..00000000000 --- a/src/unexcoff.c +++ /dev/null @@ -1,540 +0,0 @@ -/* Copyright (C) 1985-1988, 1992-1994, 2001-2024 Free Software - * Foundation, Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or (at -your option) any later version. - -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see . */ - - -/* - * unexcoff.c - Convert a running program into an a.out or COFF file. - * - * ================================================================== - * Note: This file is currently used only by the MSDOS (a.k.a. DJGPP) - * build of Emacs. If you are not interested in the MSDOS build, you - * are looking at the wrong version of unexec! - * ================================================================== - * - * Author: Spencer W. Thomas - * Computer Science Dept. - * University of Utah - * Date: Tue Mar 2 1982 - * Originally under the name unexec.c. - * Modified heavily since then. - * - * Synopsis: - * unexec (const char *new_name, const char *old_name); - * - * Takes a snapshot of the program and makes an a.out format file in the - * file named by the string argument new_name. - * If a_name is non-NULL, the symbol table will be taken from the given file. - * On some machines, an existing a_name file is required. - * - * If you make improvements I'd like to get them too. - * harpo!utah-cs!thomas, thomas@Utah-20 - * - */ - -/* Modified to support SysVr3 shared libraries by James Van Artsdalen - * of Dell Computer Corporation. james@bigtex.cactus.org. - */ - -#include -#include "unexec.h" -#include "lisp.h" - -#define PERROR(file) report_error (file, new) - -#ifdef HAVE_UNEXEC /* all rest of file! */ - -#ifdef HAVE_COFF_H -#include -#ifdef MSDOS -#include /* for O_RDONLY, O_RDWR */ -#include /* for _crt0_startup_flags and its bits */ -#include -static int save_djgpp_startup_flags; -#include -static struct __atexit *save_atexit_ptr; -#define filehdr external_filehdr -#define scnhdr external_scnhdr -#define syment external_syment -#define auxent external_auxent -#define n_numaux e_numaux -#define n_type e_type -struct aouthdr -{ - unsigned short magic; /* type of file */ - unsigned short vstamp; /* version stamp */ - unsigned long tsize; /* text size in bytes, padded to FW bdry*/ - unsigned long dsize; /* initialized data " " */ - unsigned long bsize; /* uninitialized data " " */ - unsigned long entry; /* entry pt. */ - unsigned long text_start;/* base of text used for this file */ - unsigned long data_start;/* base of data used for this file */ -}; -#endif /* MSDOS */ -#else /* not HAVE_COFF_H */ -#include -#endif /* not HAVE_COFF_H */ - -/* Define getpagesize if the system does not. - Note that this may depend on symbols defined in a.out.h. */ -#include "getpagesize.h" - -#ifndef makedev /* Try to detect types.h already loaded */ -#include -#endif /* makedev */ -#include - -#include - -extern int etext; - -static long block_copy_start; /* Old executable start point */ -static struct filehdr f_hdr; /* File header */ -static struct aouthdr f_ohdr; /* Optional file header (a.out) */ -long bias; /* Bias to add for growth */ -long lnnoptr; /* Pointer to line-number info within file */ -#define SYMS_START block_copy_start - -static long text_scnptr; -static long data_scnptr; - -static long coff_offset; - -static int pagemask; - -/* Correct an int which is the bit pattern of a pointer to a byte - into an int which is the number of a byte. - This is a no-op on ordinary machines, but not on all. */ - -#define ADDR_CORRECT(x) ((char *) (x) - (char *) 0) - -#include "lisp.h" - -static void -report_error (const char *file, int fd) -{ - int err = errno; - if (fd) - emacs_close (fd); - report_file_errno ("Cannot unexec", build_string (file), err); -} - -#define ERROR0(msg) report_error_1 (new, msg, 0, 0); return -1 -#define ERROR1(msg,x) report_error_1 (new, msg, x, 0); return -1 -#define ERROR2(msg,x,y) report_error_1 (new, msg, x, y); return -1 - -static void -report_error_1 (int fd, const char *msg, int a1, int a2) -{ - emacs_close (fd); - error (msg, a1, a2); -} - -static int make_hdr (int, int, const char *, const char *); -static int copy_text_and_data (int, int); -static int copy_sym (int, int, const char *, const char *); -static void mark_x (const char *); - -/* **************************************************************** - * make_hdr - * - * Make the header in the new a.out from the header in core. - * Modify the text and data sizes. - */ -static int -make_hdr (int new, int a_out, - const char *a_name, const char *new_name) -{ - auto struct scnhdr f_thdr; /* Text section header */ - auto struct scnhdr f_dhdr; /* Data section header */ - auto struct scnhdr f_bhdr; /* Bss section header */ - auto struct scnhdr scntemp; /* Temporary section header */ - register int scns; - unsigned int bss_start; - unsigned int data_start; - - pagemask = getpagesize () - 1; - - /* Adjust text/data boundary. */ - data_start = (int) DATA_START; - data_start = ADDR_CORRECT (data_start); - data_start = data_start & ~pagemask; /* (Down) to page boundary. */ - - bss_start = ADDR_CORRECT (sbrk (0)) + pagemask; - bss_start &= ~ pagemask; - - if (data_start > bss_start) /* Can't have negative data size. */ - { - ERROR2 ("unexec: data_start (%u) can't be greater than bss_start (%u)", - data_start, bss_start); - } - - coff_offset = 0L; /* stays zero, except in DJGPP */ - - /* Salvage as much info from the existing file as possible */ - if (a_out >= 0) - { -#ifdef MSDOS - /* Support the coff-go32-exe format with a prepended stub, since - this is what GCC 2.8.0 and later generates by default in DJGPP. */ - unsigned short mz_header[3]; - - if (read (a_out, &mz_header, sizeof (mz_header)) != sizeof (mz_header)) - { - PERROR (a_name); - } - if (mz_header[0] == 0x5a4d || mz_header[0] == 0x4d5a) /* "MZ" or "ZM" */ - { - coff_offset = (long)mz_header[2] * 512L; - if (mz_header[1]) - coff_offset += (long)mz_header[1] - 512L; - lseek (a_out, coff_offset, 0); - } - else - lseek (a_out, 0L, 0); -#endif /* MSDOS */ - if (read (a_out, &f_hdr, sizeof (f_hdr)) != sizeof (f_hdr)) - { - PERROR (a_name); - } - block_copy_start += sizeof (f_hdr); - if (f_hdr.f_opthdr > 0) - { - if (read (a_out, &f_ohdr, sizeof (f_ohdr)) != sizeof (f_ohdr)) - { - PERROR (a_name); - } - block_copy_start += sizeof (f_ohdr); - } - /* Loop through section headers, copying them in */ - lseek (a_out, coff_offset + sizeof (f_hdr) + f_hdr.f_opthdr, 0); - for (scns = f_hdr.f_nscns; scns > 0; scns--) { - if (read (a_out, &scntemp, sizeof (scntemp)) != sizeof (scntemp)) - { - PERROR (a_name); - } - if (scntemp.s_scnptr > 0L) - { - if (block_copy_start < scntemp.s_scnptr + scntemp.s_size) - block_copy_start = scntemp.s_scnptr + scntemp.s_size; - } - if (strcmp (scntemp.s_name, ".text") == 0) - { - f_thdr = scntemp; - } - else if (strcmp (scntemp.s_name, ".data") == 0) - { - f_dhdr = scntemp; - } - else if (strcmp (scntemp.s_name, ".bss") == 0) - { - f_bhdr = scntemp; - } - } - } - else - { - ERROR0 ("can't build a COFF file from scratch yet"); - } - - /* Now we alter the contents of all the f_*hdr variables - to correspond to what we want to dump. */ - - f_hdr.f_flags |= (F_RELFLG | F_EXEC); - f_ohdr.dsize = bss_start - f_ohdr.data_start; - f_ohdr.bsize = 0; - f_thdr.s_size = f_ohdr.tsize; - f_thdr.s_scnptr = sizeof (f_hdr) + sizeof (f_ohdr); - f_thdr.s_scnptr += (f_hdr.f_nscns) * (sizeof (f_thdr)); - lnnoptr = f_thdr.s_lnnoptr; - text_scnptr = f_thdr.s_scnptr; - f_dhdr.s_paddr = f_ohdr.data_start; - f_dhdr.s_vaddr = f_ohdr.data_start; - f_dhdr.s_size = f_ohdr.dsize; - f_dhdr.s_scnptr = f_thdr.s_scnptr + f_thdr.s_size; - data_scnptr = f_dhdr.s_scnptr; - f_bhdr.s_paddr = f_ohdr.data_start + f_ohdr.dsize; - f_bhdr.s_vaddr = f_ohdr.data_start + f_ohdr.dsize; - f_bhdr.s_size = f_ohdr.bsize; - f_bhdr.s_scnptr = 0L; - bias = f_dhdr.s_scnptr + f_dhdr.s_size - block_copy_start; - - if (f_hdr.f_symptr > 0L) - { - f_hdr.f_symptr += bias; - } - - if (f_thdr.s_lnnoptr > 0L) - { - f_thdr.s_lnnoptr += bias; - } - - if (write (new, &f_hdr, sizeof (f_hdr)) != sizeof (f_hdr)) - { - PERROR (new_name); - } - - if (write (new, &f_ohdr, sizeof (f_ohdr)) != sizeof (f_ohdr)) - { - PERROR (new_name); - } - - if (write (new, &f_thdr, sizeof (f_thdr)) != sizeof (f_thdr)) - { - PERROR (new_name); - } - - if (write (new, &f_dhdr, sizeof (f_dhdr)) != sizeof (f_dhdr)) - { - PERROR (new_name); - } - - if (write (new, &f_bhdr, sizeof (f_bhdr)) != sizeof (f_bhdr)) - { - PERROR (new_name); - } - - return (0); - -} - -void -write_segment (int new, const char *ptr, const char *end) -{ - register int i, nwrite, ret; - /* This is the normal amount to write at once. - It is the size of block that NFS uses. */ - int writesize = 1 << 13; - int pagesize = getpagesize (); - char zeros[1 << 13]; - - memset (zeros, 0, sizeof (zeros)); - - for (i = 0; ptr < end;) - { - /* Distance to next multiple of writesize. */ - nwrite = (((int) ptr + writesize) & -writesize) - (int) ptr; - /* But not beyond specified end. */ - if (nwrite > end - ptr) nwrite = end - ptr; - ret = write (new, ptr, nwrite); - /* If write gets a page fault, it means we reached - a gap between the old text segment and the old data segment. - This gap has probably been remapped into part of the text segment. - So write zeros for it. */ - if (ret == -1 && errno == EFAULT) - { - /* Write only a page of zeros at once, - so that we don't overshoot the start - of the valid memory in the old data segment. */ - if (nwrite > pagesize) - nwrite = pagesize; - write (new, zeros, nwrite); - } - i += nwrite; - ptr += nwrite; - } -} -/* **************************************************************** - * copy_text_and_data - * - * Copy the text and data segments from memory to the new a.out - */ -static int -copy_text_and_data (int new, int a_out) -{ - register char *end; - register char *ptr; - -#ifdef MSDOS - /* Dump the original table of exception handlers, not the one - where our exception hooks are registered. */ - __djgpp_exception_toggle (); - - /* Switch off startup flags that might have been set at runtime - and which might change the way that dumped Emacs works. */ - save_djgpp_startup_flags = _crt0_startup_flags; - _crt0_startup_flags &= ~(_CRT0_FLAG_NO_LFN | _CRT0_FLAG_NEARPTR); - - /* Zero out the 'atexit' chain in the dumped executable, to avoid - calling the atexit functions twice. (emacs.c:main installs an - atexit function.) */ - save_atexit_ptr = __atexit_ptr; - __atexit_ptr = NULL; -#endif - - lseek (new, (long) text_scnptr, 0); - ptr = (char *) f_ohdr.text_start; - end = ptr + f_ohdr.tsize; - write_segment (new, ptr, end); - - lseek (new, (long) data_scnptr, 0); - ptr = (char *) f_ohdr.data_start; - end = ptr + f_ohdr.dsize; - write_segment (new, ptr, end); - -#ifdef MSDOS - /* Restore our exception hooks. */ - __djgpp_exception_toggle (); - - /* Restore the startup flags. */ - _crt0_startup_flags = save_djgpp_startup_flags; - - /* Restore the atexit chain. */ - __atexit_ptr = save_atexit_ptr; -#endif - - - return 0; -} - -/* **************************************************************** - * copy_sym - * - * Copy the relocation information and symbol table from the a.out to the new - */ -static int -copy_sym (int new, int a_out, const char *a_name, const char *new_name) -{ - char page[1024]; - int n; - - if (a_out < 0) - return 0; - - if (SYMS_START == 0L) - return 0; - - if (lnnoptr) /* if there is line number info */ - lseek (a_out, coff_offset + lnnoptr, 0); /* start copying from there */ - else - lseek (a_out, coff_offset + SYMS_START, 0); /* Position a.out to symtab. */ - - while ((n = read (a_out, page, sizeof page)) > 0) - { - if (write (new, page, n) != n) - { - PERROR (new_name); - } - } - if (n < 0) - { - PERROR (a_name); - } - return 0; -} - - -/* - * If the COFF file contains a symbol table and a line number section, - * then any auxiliary entries that have values for x_lnnoptr must - * be adjusted by the amount that the line number section has moved - * in the file (bias computed in make_hdr). The #@$%&* designers of - * the auxiliary entry structures used the absolute file offsets for - * the line number entry rather than an offset from the start of the - * line number section! - * - * When I figure out how to scan through the symbol table and pick out - * the auxiliary entries that need adjustment, this routine will - * be fixed. As it is now, all such entries are wrong and sdb - * will complain. Fred Fish, UniSoft Systems Inc. - */ - -/* This function is probably very slow. Instead of reopening the new - file for input and output it should copy from the old to the new - using the two descriptors already open (WRITEDESC and READDESC). - Instead of reading one small structure at a time it should use - a reasonable size buffer. But I don't have time to work on such - things, so I am installing it as submitted to me. -- RMS. */ - -int -adjust_lnnoptrs (int writedesc, int readdesc, const char *new_name) -{ - register int nsyms; - register int new; - struct syment symentry; - union auxent auxentry; - - if (!lnnoptr || !f_hdr.f_symptr) - return 0; - -#ifdef MSDOS - if ((new = writedesc) < 0) -#else - if ((new = emacs_open (new_name, O_RDWR, 0)) < 0) -#endif - { - PERROR (new_name); - return -1; - } - - lseek (new, f_hdr.f_symptr, 0); - for (nsyms = 0; nsyms < f_hdr.f_nsyms; nsyms++) - { - read (new, &symentry, SYMESZ); - if (symentry.n_numaux) - { - read (new, &auxentry, AUXESZ); - nsyms++; - if (ISFCN (symentry.n_type) || symentry.n_type == 0x2400) - { - auxentry.x_sym.x_fcnary.x_fcn.x_lnnoptr += bias; - lseek (new, -AUXESZ, 1); - write (new, &auxentry, AUXESZ); - } - } - } -#ifndef MSDOS - emacs_close (new); -#endif - return 0; -} - -/* **************************************************************** - * unexec - * - * driving logic. - */ -void -unexec (const char *new_name, const char *a_name) -{ - int new = -1, a_out = -1; - - if (a_name && (a_out = emacs_open (a_name, O_RDONLY, 0)) < 0) - { - PERROR (a_name); - } - if ((new = emacs_open (new_name, O_WRONLY | O_CREAT | O_TRUNC, 0777)) < 0) - { - PERROR (new_name); - } - - if (make_hdr (new, a_out, a_name, new_name) < 0 - || copy_text_and_data (new, a_out) < 0 - || copy_sym (new, a_out, a_name, new_name) < 0 - || adjust_lnnoptrs (new, a_out, new_name) < 0 - ) - { - emacs_close (new); - return; - } - - emacs_close (new); - if (a_out >= 0) - emacs_close (a_out); -} - -#endif /* HAVE_UNEXEC */ diff --git a/src/unexcw.c b/src/unexcw.c deleted file mode 100644 index 5c91498cc6c..00000000000 --- a/src/unexcw.c +++ /dev/null @@ -1,302 +0,0 @@ -/* unexec() support for Cygwin; - complete rewrite of xemacs Cygwin unexec() code - - Copyright (C) 2004-2024 Free Software Foundation, Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or (at -your option) any later version. - -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see . */ - -#include -#include "unexec.h" -#include "lisp.h" -#include -#include -#include -#include -#include - -#define DOTEXE ".exe" - -/* -** header for Windows executable files -*/ -typedef struct -{ - FILHDR file_header; - PEAOUTHDR file_optional_header; - SCNHDR section_header[32]; -} exe_header_t; - -int debug_unexcw = 0; - -/* -** Read the header from the executable into memory so we can more easily access it. -*/ -static exe_header_t * -read_exe_header (int fd, exe_header_t * exe_header_buffer) -{ - int i; - MAYBE_UNUSED int ret; - - assert (fd >= 0); - assert (exe_header_buffer != 0); - - ret = lseek (fd, 0L, SEEK_SET); - assert (ret != -1); - - ret = - read (fd, &exe_header_buffer->file_header, - sizeof (exe_header_buffer->file_header)); - assert (ret == sizeof (exe_header_buffer->file_header)); - - assert (exe_header_buffer->file_header.e_magic == 0x5a4d); - assert (exe_header_buffer->file_header.nt_signature == 0x4550); -#ifdef __x86_64__ - assert (exe_header_buffer->file_header.f_magic == 0x8664); -#else - assert (exe_header_buffer->file_header.f_magic == 0x014c); -#endif - assert (exe_header_buffer->file_header.f_nscns > 0); - assert (exe_header_buffer->file_header.f_nscns <= - ARRAYELTS (exe_header_buffer->section_header)); - assert (exe_header_buffer->file_header.f_opthdr > 0); - - ret = - read (fd, &exe_header_buffer->file_optional_header, - sizeof (exe_header_buffer->file_optional_header)); - assert (ret == sizeof (exe_header_buffer->file_optional_header)); - -#ifdef __x86_64__ - assert (exe_header_buffer->file_optional_header.magic == 0x020b); -#else - assert (exe_header_buffer->file_optional_header.magic == 0x010b); -#endif - - for (i = 0; i < exe_header_buffer->file_header.f_nscns; ++i) - { - ret = - read (fd, &exe_header_buffer->section_header[i], - sizeof (exe_header_buffer->section_header[i])); - assert (ret == sizeof (exe_header_buffer->section_header[i])); - } - - return (exe_header_buffer); -} - -/* -** Fix the dumped emacs executable: -** -** - copy .data section data of interest from running executable into -** output .exe file -** -** - convert .bss section into an initialized data section (like -** .data) and copy .bss section data of interest from running -** executable into output .exe file -*/ -static void -fixup_executable (int fd) -{ - exe_header_t exe_header_buffer; - exe_header_t *exe_header; - int i; - MAYBE_UNUSED int ret; - int found_data = 0; - int found_bss = 0; - - exe_header = read_exe_header (fd, &exe_header_buffer); - assert (exe_header != 0); - - assert (exe_header->file_header.f_nscns > 0); - for (i = 0; i < exe_header->file_header.f_nscns; ++i) - { - unsigned long start_address = - exe_header->section_header[i].s_vaddr + - exe_header->file_optional_header.ImageBase; - unsigned long end_address = - exe_header->section_header[i].s_vaddr + - exe_header->file_optional_header.ImageBase + - exe_header->section_header[i].s_paddr; - if (debug_unexcw) - printf ("%8s start %#lx end %#lx\n", - exe_header->section_header[i].s_name, - start_address, end_address); - if (my_edata >= (char *) start_address - && my_edata < (char *) end_address) - { - /* data section */ - ret = - lseek (fd, (long) (exe_header->section_header[i].s_scnptr), - SEEK_SET); - assert (ret != -1); - ret = - write (fd, (char *) start_address, - my_edata - (char *) start_address); - assert (ret == my_edata - (char *) start_address); - ++found_data; - if (debug_unexcw) - printf (" .data, mem start %#lx mem length %td\n", - start_address, my_edata - (char *) start_address); - if (debug_unexcw) - printf (" .data, file start %d file length %d\n", - (int) exe_header->section_header[i].s_scnptr, - (int) exe_header->section_header[i].s_paddr); - } - else if (my_endbss >= (char *) start_address - && my_endbss < (char *) end_address) - { - /* bss section */ - ++found_bss; - if (exe_header->section_header[i].s_flags & 0x00000080) - { - /* convert uninitialized data section to initialized data section */ - struct stat statbuf; - ret = fstat (fd, &statbuf); - assert (ret != -1); - - exe_header->section_header[i].s_flags &= ~0x00000080; - exe_header->section_header[i].s_flags |= 0x00000040; - - exe_header->section_header[i].s_scnptr = - (statbuf.st_size + - exe_header->file_optional_header.FileAlignment) / - exe_header->file_optional_header.FileAlignment * - exe_header->file_optional_header.FileAlignment; - - exe_header->section_header[i].s_size = - (exe_header->section_header[i].s_paddr + - exe_header->file_optional_header.FileAlignment) / - exe_header->file_optional_header.FileAlignment * - exe_header->file_optional_header.FileAlignment; - - /* Make sure the generated bootstrap binary isn't - * sparse. NT doesn't use a file cache for sparse - * executables, so if we bootstrap Emacs using a sparse - * bootstrap-emacs.exe, bootstrap takes about twenty - * times longer than it would otherwise. */ - - ret = posix_fallocate (fd, - ( exe_header->section_header[i].s_scnptr + - exe_header->section_header[i].s_size ), - 1); - - assert (ret != -1); - - ret = - lseek (fd, - (long) (exe_header->section_header[i].s_scnptr + - exe_header->section_header[i].s_size - 1), - SEEK_SET); - assert (ret != -1); - ret = write (fd, "", 1); - assert (ret == 1); - - ret = - lseek (fd, - (long) ((char *) &exe_header->section_header[i] - - (char *) exe_header), SEEK_SET); - assert (ret != -1); - ret = - write (fd, &exe_header->section_header[i], - sizeof (exe_header->section_header[i])); - assert (ret == sizeof (exe_header->section_header[i])); - if (debug_unexcw) - printf (" seek to %ld, write %zu\n", - (long) ((char *) &exe_header->section_header[i] - - (char *) exe_header), - sizeof (exe_header->section_header[i])); - } - /* write initialized data section */ - ret = - lseek (fd, (long) (exe_header->section_header[i].s_scnptr), - SEEK_SET); - assert (ret != -1); - ret = - write (fd, (char *) start_address, - my_endbss - (char *) start_address); - assert (ret == (my_endbss - (char *) start_address)); - if (debug_unexcw) - printf (" .bss, mem start %#lx mem length %td\n", - start_address, my_endbss - (char *) start_address); - if (debug_unexcw) - printf (" .bss, file start %d file length %d\n", - (int) exe_header->section_header[i].s_scnptr, - (int) exe_header->section_header[i].s_paddr); - } - } - assert (found_bss == 1); - assert (found_data == 1); -} - -/* -** Windows likes .exe suffixes on executables. -*/ -static char * -add_exe_suffix_if_necessary (const char *name, char *modified) -{ - int i = strlen (name); - if (i <= (sizeof (DOTEXE) - 1)) - { - sprintf (modified, "%s%s", name, DOTEXE); - } - else if (!strcasecmp (name + i - (sizeof (DOTEXE) - 1), DOTEXE)) - { - strcpy (modified, name); - } - else - { - sprintf (modified, "%s%s", name, DOTEXE); - } - return (modified); -} - -void -unexec (const char *outfile, const char *infile) -{ - char infile_buffer[FILENAME_MAX]; - char outfile_buffer[FILENAME_MAX]; - int fd_in; - int fd_out; - int ret; - MAYBE_UNUSED int ret2; - - infile = add_exe_suffix_if_necessary (infile, infile_buffer); - outfile = add_exe_suffix_if_necessary (outfile, outfile_buffer); - - fd_in = emacs_open (infile, O_RDONLY, 0); - assert (fd_in >= 0); - fd_out = emacs_open (outfile, O_RDWR | O_TRUNC | O_CREAT, 0755); - assert (fd_out >= 0); - for (;;) - { - char buffer[4096]; - ret = read (fd_in, buffer, sizeof (buffer)); - if (ret == 0) - { - /* eof */ - break; - } - assert (ret > 0); - /* data */ - ret2 = write (fd_out, buffer, ret); - assert (ret2 == ret); - } - ret = emacs_close (fd_in); - assert (ret == 0); - - fixup_executable (fd_out); - - ret = emacs_close (fd_out); - assert (ret == 0); -} diff --git a/src/unexec.h b/src/unexec.h deleted file mode 100644 index cdb2e8016ea..00000000000 --- a/src/unexec.h +++ /dev/null @@ -1,4 +0,0 @@ -#ifndef EMACS_UNEXEC_H -#define EMACS_UNEXEC_H -void unexec (const char *, const char *); -#endif /* EMACS_UNEXEC_H */ diff --git a/src/unexelf.c b/src/unexelf.c deleted file mode 100644 index 4b109470066..00000000000 --- a/src/unexelf.c +++ /dev/null @@ -1,658 +0,0 @@ -/* Copyright (C) 1985-1988, 1990, 1992, 1999-2024 Free Software - Foundation, Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or (at -your option) any later version. - -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see . */ - -/* -In other words, you are welcome to use, share and improve this program. -You are forbidden to forbid anyone else to use, share and improve -what you give them. Help stamp out software-hoarding! */ - - -/* - * unexec.c - Convert a running program into an a.out file. - * - * Author: Spencer W. Thomas - * Computer Science Dept. - * University of Utah - * Date: Tue Mar 2 1982 - * Modified heavily since then. - * - * Synopsis: - * unexec (const char *new_name, const char *old_name); - * - * Takes a snapshot of the program and makes an a.out format file in the - * file named by the string argument new_name. - * If old_name is non-NULL, the symbol table will be taken from the given file. - * On some machines, an existing old_name file is required. - * - */ - -/* We do not use mmap because that fails with NFS. - Instead we read the whole file, modify it, and write it out. */ - -#include -#include "unexec.h" -#include "lisp.h" - -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#ifdef __QNX__ -# include -#elif !defined __NetBSD__ && !defined __OpenBSD__ -# include -#endif -#include -#if defined (_SYSTYPE_SYSV) -#include -#include -#endif /* _SYSTYPE_SYSV */ - -#ifndef MAP_ANON -#ifdef MAP_ANONYMOUS -#define MAP_ANON MAP_ANONYMOUS -#else -#define MAP_ANON 0 -#endif -#endif - -#ifndef MAP_FAILED -#define MAP_FAILED ((void *) -1) -#endif - -#if defined (__alpha__) && !defined (__NetBSD__) && !defined (__OpenBSD__) -/* Declare COFF debugging symbol table. This used to be in - /usr/include/sym.h, but this file is no longer included in Red Hat - 5.0 and presumably in any other glibc 2.x based distribution. */ -typedef struct { - short magic; - short vstamp; - int ilineMax; - int idnMax; - int ipdMax; - int isymMax; - int ioptMax; - int iauxMax; - int issMax; - int issExtMax; - int ifdMax; - int crfd; - int iextMax; - long cbLine; - long cbLineOffset; - long cbDnOffset; - long cbPdOffset; - long cbSymOffset; - long cbOptOffset; - long cbAuxOffset; - long cbSsOffset; - long cbSsExtOffset; - long cbFdOffset; - long cbRfdOffset; - long cbExtOffset; -} HDRR, *pHDRR; -#define cbHDRR sizeof (HDRR) -#define hdrNil ((pHDRR)0) -#endif - -#ifdef __NetBSD__ -/* - * NetBSD does not have normal-looking user-land ELF support. - */ -# if defined __alpha__ || defined __sparc_v9__ || defined _LP64 -# define ELFSIZE 64 -# else -# define ELFSIZE 32 -# endif -# include - -# ifndef PT_LOAD -# define PT_LOAD Elf_pt_load -# if 0 /* was in pkgsrc patches for 20.7 */ -# define SHT_PROGBITS Elf_sht_progbits -# endif -# define SHT_SYMTAB Elf_sht_symtab -# define SHT_DYNSYM Elf_sht_dynsym -# define SHT_NULL Elf_sht_null -# define SHT_NOBITS Elf_sht_nobits -# define SHT_REL Elf_sht_rel -# define SHT_RELA Elf_sht_rela - -# define SHN_UNDEF Elf_eshn_undefined -# define SHN_ABS Elf_eshn_absolute -# define SHN_COMMON Elf_eshn_common -# endif /* !PT_LOAD */ - -# ifdef __alpha__ -# include -# define HDRR struct ecoff_symhdr -# define pHDRR HDRR * -# endif /* __alpha__ */ - -#ifdef __mips__ /* was in pkgsrc patches for 20.7 */ -# define SHT_MIPS_DEBUG DT_MIPS_FLAGS -# define HDRR struct Elf_Shdr -#endif /* __mips__ */ -#endif /* __NetBSD__ */ - -#ifdef __OpenBSD__ -# include -#endif - -#if __GNU_LIBRARY__ - 0 >= 6 -# include /* get ElfW etc */ -#endif - -#ifndef ElfW -# define ElfBitsW(bits, type) Elf##bits##_##type -# ifndef ELFSIZE -# ifdef _LP64 -# define ELFSIZE 64 -# else -# define ELFSIZE 32 -# endif -# endif - /* This macro expands `bits' before invoking ElfBitsW. */ -# define ElfExpandBitsW(bits, type) ElfBitsW (bits, type) -# define ElfW(type) ElfExpandBitsW (ELFSIZE, type) -#endif - -/* The code often converts ElfW (Half) values like e_shentsize to ptrdiff_t; - check that this doesn't lose information. */ -#include -static_assert ((! TYPE_SIGNED (ElfW (Half)) - || PTRDIFF_MIN <= TYPE_MINIMUM (ElfW (Half))) - && TYPE_MAXIMUM (ElfW (Half)) <= PTRDIFF_MAX); - -#ifdef UNEXELF_DEBUG -# define DEBUG_LOG(expr) fprintf (stderr, #expr " 0x%"PRIxMAX"\n", \ - (uintmax_t) (expr)) -#endif - -/* Get the address of a particular section or program header entry, - * accounting for the size of the entries. - */ - -static void * -entry_address (void *section_h, ptrdiff_t idx, ptrdiff_t entsize) -{ - char *h = section_h; - return h + idx * entsize; -} - -#define OLD_SECTION_H(n) \ - (*(ElfW (Shdr) *) entry_address (old_section_h, n, old_file_h->e_shentsize)) -#define NEW_SECTION_H(n) \ - (*(ElfW (Shdr) *) entry_address (new_section_h, n, new_file_h->e_shentsize)) -#define OLD_PROGRAM_H(n) \ - (*(ElfW (Phdr) *) entry_address (old_program_h, n, old_file_h->e_phentsize)) - -typedef unsigned char byte; - -/* **************************************************************** - * unexec - * - * driving logic. - * - * In ELF, this works by replacing the old bss SHT_NOBITS section with - * a new, larger, SHT_PROGBITS section. - * - */ -void -unexec (const char *new_name, const char *old_name) -{ - int new_file, old_file; - off_t new_file_size; - - /* Pointers to the base of the image of the two files. */ - caddr_t old_base, new_base; - -#if MAP_ANON == 0 - int mmap_fd; -#else -# define mmap_fd -1 -#endif - - /* Pointers to the file, program and section headers for the old and - new files. */ - ElfW (Ehdr) *old_file_h, *new_file_h; - ElfW (Phdr) *old_program_h, *new_program_h; - ElfW (Shdr) *old_section_h, *new_section_h; - - /* Point to the section name table. */ - char *old_section_names, *new_section_names; - - ElfW (Phdr) *old_bss_seg, *new_bss_seg; - ElfW (Addr) old_bss_addr, new_bss_addr; - ElfW (Word) old_bss_size, bss_size_growth, new_data2_size; - ElfW (Off) old_bss_offset, new_data2_offset; - - ptrdiff_t n; - ptrdiff_t old_bss_index; - struct stat stat_buf; - off_t old_file_size; - - /* Open the old file, allocate a buffer of the right size, and read - in the file contents. */ - - old_file = emacs_open (old_name, O_RDONLY, 0); - - if (old_file < 0) - fatal ("Can't open %s for reading: %s", old_name, strerror (errno)); - - if (fstat (old_file, &stat_buf) != 0) - fatal ("Can't fstat (%s): %s", old_name, strerror (errno)); - -#if MAP_ANON == 0 - mmap_fd = emacs_open ("/dev/zero", O_RDONLY, 0); - if (mmap_fd < 0) - fatal ("Can't open /dev/zero for reading: %s", strerror (errno)); -#endif - - /* We cannot use malloc here because that may use sbrk. If it does, - we'd dump our temporary buffers with Emacs, and we'd have to be - extra careful to use the correct value of sbrk(0) after - allocating all buffers in the code below, which we aren't. */ - old_file_size = stat_buf.st_size; - if (! (0 <= old_file_size && old_file_size <= SIZE_MAX)) - fatal ("File size out of range"); - old_base = mmap (NULL, old_file_size, PROT_READ | PROT_WRITE, - MAP_ANON | MAP_PRIVATE, mmap_fd, 0); - if (old_base == MAP_FAILED) - fatal ("Can't allocate buffer for %s: %s", old_name, strerror (errno)); - - if (read (old_file, old_base, old_file_size) != old_file_size) - fatal ("Didn't read all of %s: %s", old_name, strerror (errno)); - - /* Get pointers to headers & section names */ - - old_file_h = (ElfW (Ehdr) *) old_base; - old_program_h = (ElfW (Phdr) *) ((byte *) old_base + old_file_h->e_phoff); - old_section_h = (ElfW (Shdr) *) ((byte *) old_base + old_file_h->e_shoff); - old_section_names = (char *) old_base - + OLD_SECTION_H (old_file_h->e_shstrndx).sh_offset; - - /* Find the PT_LOAD header covering the highest address. This - segment will be where bss sections are located, past p_filesz. */ - old_bss_seg = 0; - for (n = old_file_h->e_phnum; --n >= 0; ) - { - ElfW (Phdr) *seg = &OLD_PROGRAM_H (n); - if (seg->p_type == PT_LOAD - && (old_bss_seg == 0 - || seg->p_vaddr > old_bss_seg->p_vaddr)) - old_bss_seg = seg; - } - eassume (old_bss_seg); - if (!old_bss_seg) - emacs_abort (); - - /* Note that old_bss_addr may be lower than the first bss section - address, since the section may need aligning. */ - old_bss_addr = old_bss_seg->p_vaddr + old_bss_seg->p_filesz; - old_bss_offset = old_bss_seg->p_offset + old_bss_seg->p_filesz; - old_bss_size = old_bss_seg->p_memsz - old_bss_seg->p_filesz; - - /* Find the last bss style section in the bss segment range. */ - old_bss_index = -1; - for (n = old_file_h->e_shnum; --n > 0; ) - { - ElfW (Shdr) *shdr = &OLD_SECTION_H (n); - if (shdr->sh_type == SHT_NOBITS - && shdr->sh_addr >= old_bss_addr - && shdr->sh_addr + shdr->sh_size <= old_bss_addr + old_bss_size - && (old_bss_index == -1 - || OLD_SECTION_H (old_bss_index).sh_addr < shdr->sh_addr)) - old_bss_index = n; - } - - if (old_bss_index == -1) - fatal ("no bss section found"); - - void *no_break = (void *) (intptr_t) -1; - void *new_break = no_break; -#ifdef HAVE_SBRK - new_break = sbrk (0); -#endif - if (new_break == no_break) - new_break = (byte *) old_bss_addr + old_bss_size; - new_bss_addr = (ElfW (Addr)) new_break; - bss_size_growth = new_bss_addr - old_bss_addr; - new_data2_size = bss_size_growth; - new_data2_size += alignof (ElfW (Shdr)) - 1; - new_data2_size -= new_data2_size % alignof (ElfW (Shdr)); - - new_data2_offset = old_bss_offset; - -#ifdef UNEXELF_DEBUG - fprintf (stderr, "old_bss_index %td\n", old_bss_index); - DEBUG_LOG (old_bss_addr); - DEBUG_LOG (old_bss_size); - DEBUG_LOG (old_bss_offset); - DEBUG_LOG (new_bss_addr); - DEBUG_LOG (new_data2_size); - DEBUG_LOG (new_data2_offset); -#endif - - if (new_bss_addr < old_bss_addr + old_bss_size) - fatal (".bss shrank when undumping"); - - /* Set the output file to the right size. Allocate a buffer to hold - the image of the new file. Set pointers to various interesting - objects. */ - - new_file = emacs_open (new_name, O_RDWR | O_CREAT, 0777); - if (new_file < 0) - fatal ("Can't creat (%s): %s", new_name, strerror (errno)); - - new_file_size = old_file_size + new_data2_size; - - if (ftruncate (new_file, new_file_size)) - fatal ("Can't ftruncate (%s): %s", new_name, strerror (errno)); - - new_base = mmap (NULL, new_file_size, PROT_READ | PROT_WRITE, - MAP_ANON | MAP_PRIVATE, mmap_fd, 0); - if (new_base == MAP_FAILED) - fatal ("Can't allocate buffer for %s: %s", old_name, strerror (errno)); - - /* Make our new file, program and section headers as copies of the - originals. */ - - new_file_h = (ElfW (Ehdr) *) new_base; - memcpy (new_file_h, old_file_h, old_file_h->e_ehsize); - - /* Fix up file header. Section header is further away now. */ - - if (new_file_h->e_shoff >= old_bss_offset) - new_file_h->e_shoff += new_data2_size; - - new_program_h = (ElfW (Phdr) *) ((byte *) new_base + new_file_h->e_phoff); - new_section_h = (ElfW (Shdr) *) ((byte *) new_base + new_file_h->e_shoff); - - memcpy (new_program_h, old_program_h, - old_file_h->e_phnum * old_file_h->e_phentsize); - memcpy (new_section_h, old_section_h, - old_file_h->e_shnum * old_file_h->e_shentsize); - -#ifdef UNEXELF_DEBUG - DEBUG_LOG (old_file_h->e_shoff); - fprintf (stderr, "Old section count %td\n", (ptrdiff_t) old_file_h->e_shnum); - DEBUG_LOG (new_file_h->e_shoff); - fprintf (stderr, "New section count %td\n", (ptrdiff_t) new_file_h->e_shnum); -#endif - - /* Fix up program header. Extend the writable data segment so - that the bss area is covered too. */ - - new_bss_seg = new_program_h + (old_bss_seg - old_program_h); - new_bss_seg->p_filesz = new_bss_addr - new_bss_seg->p_vaddr; - new_bss_seg->p_memsz = new_bss_seg->p_filesz; - - /* Copy over what we have in memory now for the bss area. */ - memcpy (new_base + new_data2_offset, (caddr_t) old_bss_addr, - bss_size_growth); - - /* Walk through all section headers, copying data and updating. */ - for (n = 1; n < old_file_h->e_shnum; n++) - { - caddr_t src; - ElfW (Shdr) *old_shdr = &OLD_SECTION_H (n); - ElfW (Shdr) *new_shdr = &NEW_SECTION_H (n); - - if (new_shdr->sh_type == SHT_NOBITS - && new_shdr->sh_addr >= old_bss_addr - && (new_shdr->sh_addr + new_shdr->sh_size - <= old_bss_addr + old_bss_size)) - { - /* This section now has file backing. */ - new_shdr->sh_type = SHT_PROGBITS; - - /* SHT_NOBITS sections do not need a valid sh_offset, so it - might be incorrect. Write the correct value. */ - new_shdr->sh_offset = (new_shdr->sh_addr - new_bss_seg->p_vaddr - + new_bss_seg->p_offset); - - /* If this is was a SHT_NOBITS .plt section, then it is - probably a PowerPC PLT. If it is PowerPC64 ELFv1 then - glibc ld.so doesn't initialize the toc pointer word. A - non-zero toc pointer word can defeat Power7 thread safety - during lazy update of a PLT entry. This only matters if - emacs becomes multi-threaded. */ - if (strcmp (old_section_names + new_shdr->sh_name, ".plt") == 0) - memset (new_shdr->sh_offset + new_base, 0, new_shdr->sh_size); - - /* Extend the size of the last bss section to cover dumped - data. */ - if (n == old_bss_index) - new_shdr->sh_size = new_bss_addr - new_shdr->sh_addr; - - /* We have already copied this section from the current - process. */ - continue; - } - - /* Any section that was originally placed after the .bss - section should now be offset by NEW_DATA2_SIZE. */ - if (new_shdr->sh_offset >= old_bss_offset) - new_shdr->sh_offset += new_data2_size; - - /* Now, start to copy the content of sections. */ - if (new_shdr->sh_type == SHT_NULL - || new_shdr->sh_type == SHT_NOBITS) - continue; - - /* Some sections are copied from the current process instead of - the old file. */ - if (!strcmp (old_section_names + new_shdr->sh_name, ".data") - || !strcmp (old_section_names + new_shdr->sh_name, ".sdata") - || !strcmp (old_section_names + new_shdr->sh_name, ".lit4") - || !strcmp (old_section_names + new_shdr->sh_name, ".lit8") - || !strcmp (old_section_names + new_shdr->sh_name, ".sdata1") - || !strcmp (old_section_names + new_shdr->sh_name, ".data1")) - src = (caddr_t) old_shdr->sh_addr; - else - src = old_base + old_shdr->sh_offset; - - memcpy (new_shdr->sh_offset + new_base, src, new_shdr->sh_size); - -#if (defined __alpha__ && !defined __OpenBSD__) || defined _SYSTYPE_SYSV - /* Update Alpha and MIPS COFF debug symbol table. */ - if (strcmp (old_section_names + new_shdr->sh_name, ".mdebug") == 0 - && new_shdr->sh_offset - old_shdr->sh_offset != 0 -#if defined _SYSTYPE_SYSV - && new_shdr->sh_type == SHT_MIPS_DEBUG -#endif - ) - { - ptrdiff_t diff = new_shdr->sh_offset - old_shdr->sh_offset; - HDRR *phdr = (HDRR *) (new_shdr->sh_offset + new_base); - - phdr->cbLineOffset += diff; - phdr->cbDnOffset += diff; - phdr->cbPdOffset += diff; - phdr->cbSymOffset += diff; - phdr->cbOptOffset += diff; - phdr->cbAuxOffset += diff; - phdr->cbSsOffset += diff; - phdr->cbSsExtOffset += diff; - phdr->cbFdOffset += diff; - phdr->cbRfdOffset += diff; - phdr->cbExtOffset += diff; - } -#endif /* __alpha__ || _SYSTYPE_SYSV */ - } - - /* Update the symbol values of _edata and _end. */ - for (n = new_file_h->e_shnum; 0 < --n; ) - { - byte *symnames; - ElfW (Sym) *symp, *symendp; - ElfW (Shdr) *sym_shdr = &NEW_SECTION_H (n); - - if (sym_shdr->sh_type != SHT_DYNSYM - && sym_shdr->sh_type != SHT_SYMTAB) - continue; - - symnames = ((byte *) new_base - + NEW_SECTION_H (sym_shdr->sh_link).sh_offset); - symp = (ElfW (Sym) *) (sym_shdr->sh_offset + new_base); - symendp = (ElfW (Sym) *) ((byte *) symp + sym_shdr->sh_size); - - for (; symp < symendp; symp ++) - { - if (strcmp ((char *) (symnames + symp->st_name), "_end") == 0 - || strcmp ((char *) (symnames + symp->st_name), "end") == 0 - || strcmp ((char *) (symnames + symp->st_name), "_edata") == 0 - || strcmp ((char *) (symnames + symp->st_name), "edata") == 0) - memcpy (&symp->st_value, &new_bss_addr, sizeof (new_bss_addr)); - - /* Strictly speaking, #ifdef below is not necessary. But we - keep it to indicate that this kind of change may also be - necessary for other unexecs to support GNUstep. */ -#ifdef NS_IMPL_GNUSTEP - /* ObjC runtime modifies the values of some data structures - such as classes and selectors in the .data section after - loading. As the dump process copies the .data section - from the current process, that causes problems when the - modified classes are reinitialized in the dumped - executable. We copy such data from the old file, not - from the current process. */ - if (strncmp ((char *) (symnames + symp->st_name), - "_OBJC_", sizeof ("_OBJC_") - 1) == 0) - { - ElfW (Shdr) *new_shdr = &NEW_SECTION_H (symp->st_shndx); - if (new_shdr->sh_type != SHT_NOBITS) - { - ElfW (Shdr) *old_shdr = &OLD_SECTION_H (symp->st_shndx); - ptrdiff_t reladdr = symp->st_value - new_shdr->sh_addr; - ptrdiff_t newoff = reladdr + new_shdr->sh_offset; - - if (old_shdr->sh_type == SHT_NOBITS) - memset (new_base + newoff, 0, symp->st_size); - else - { - ptrdiff_t oldoff = reladdr + old_shdr->sh_offset; - memcpy (new_base + newoff, old_base + oldoff, - symp->st_size); - } - } - } -#endif - } - } - - /* Modify the names of sections we changed from SHT_NOBITS to - SHT_PROGBITS. This is really just cosmetic, but some tools that - (wrongly) operate on section names rather than types might be - confused by a SHT_PROGBITS .bss section. */ - new_section_names = ((char *) new_base - + NEW_SECTION_H (new_file_h->e_shstrndx).sh_offset); - for (n = new_file_h->e_shnum; 0 < --n; ) - { - ElfW (Shdr) *old_shdr = &OLD_SECTION_H (n); - ElfW (Shdr) *new_shdr = &NEW_SECTION_H (n); - - /* Replace the leading '.' with ','. When .shstrtab is string - merged this will rename both .bss and .rela.bss to ,bss and - .rela,bss. */ - if (old_shdr->sh_type == SHT_NOBITS - && new_shdr->sh_type == SHT_PROGBITS) - *(new_section_names + new_shdr->sh_name) = ','; - } - - /* This loop seeks out relocation sections for the data section, so - that it can undo relocations performed by the runtime loader. - - The following approach does not work on x86 platforms that use - the GNU Gold linker, which can generate .rel.dyn relocation - sections containing R_386_32 entries that the following code does - not grok. Emacs works around this problem by avoiding C - constructs that generate such entries, which is horrible hack. - - FIXME: Presumably more problems like this will crop up as linkers - get fancier. We really need to stop assuming that Emacs can grok - arbitrary linker output. See Bug#27248. */ - for (n = new_file_h->e_shnum; 0 < --n; ) - { - ElfW (Shdr) *rel_shdr = &NEW_SECTION_H (n); - ElfW (Shdr) *shdr; - - switch (rel_shdr->sh_type) - { - default: - break; - case SHT_REL: - case SHT_RELA: - /* This code handles two different size structs, but there should - be no harm in that provided that r_offset is always the first - member. */ - shdr = &NEW_SECTION_H (rel_shdr->sh_info); - if (!strcmp (old_section_names + shdr->sh_name, ".data") - || !strcmp (old_section_names + shdr->sh_name, ".sdata") - || !strcmp (old_section_names + shdr->sh_name, ".lit4") - || !strcmp (old_section_names + shdr->sh_name, ".lit8") - || !strcmp (old_section_names + shdr->sh_name, ".sdata1") - || !strcmp (old_section_names + shdr->sh_name, ".data1")) - { - ElfW (Addr) offset = shdr->sh_addr - shdr->sh_offset; - caddr_t reloc = old_base + rel_shdr->sh_offset, end; - for (end = reloc + rel_shdr->sh_size; - reloc < end; - reloc += rel_shdr->sh_entsize) - { - ElfW (Addr) addr = ((ElfW (Rel) *) reloc)->r_offset - offset; - /* Ignore R_*_NONE relocs. */ - if (((ElfW (Rel) *) reloc)->r_offset == 0) - continue; - /* Assume reloc applies to a word. - ??? This is not always true, eg. TLS module/index - pair in .got which occupies two words. */ - memcpy (new_base + addr, old_base + addr, - sizeof (ElfW (Addr))); - } - } - break; - } - } - - /* Write out new_file, and free the buffers. */ - - if (write (new_file, new_base, new_file_size) != new_file_size) - fatal ("Didn't write %lu bytes to %s: %s", - (unsigned long) new_file_size, new_name, strerror (errno)); - munmap (old_base, old_file_size); - munmap (new_base, new_file_size); - - /* Close the files and make the new file executable. */ - -#if MAP_ANON == 0 - emacs_close (mmap_fd); -#endif - - if (emacs_close (old_file) != 0) - fatal ("Can't close (%s): %s", old_name, strerror (errno)); - - if (emacs_close (new_file) != 0) - fatal ("Can't close (%s): %s", new_name, strerror (errno)); -} diff --git a/src/unexhp9k800.c b/src/unexhp9k800.c deleted file mode 100644 index d2943eb18c9..00000000000 --- a/src/unexhp9k800.c +++ /dev/null @@ -1,324 +0,0 @@ -/* Unexec for HP 9000 Series 800 machines. - - This file is in the public domain. - - Author: John V. Morris - - This file was written by John V. Morris at Hewlett Packard. - Both the author and Hewlett Packard Co. have disclaimed the - copyright on this file, and it is therefore in the public domain. - (Search for "hp9k800" in copyright.list.) -*/ - -/* - Bob Desinger - - Note that the GNU project considers support for HP operation a - peripheral activity which should not be allowed to divert effort - from development of the GNU system. Changes in this code will be - installed when users send them in, but aside from that we don't - plan to think about it, or about whether other Emacs maintenance - might break it. - - - Unexec creates a copy of the old a.out file, and replaces the old data - area with the current data area. When the new file is executed, the - process will see the same data structures and data values that the - original process had when unexec was called. - - Unlike other versions of unexec, this one copies symbol table and - debug information to the new a.out file. Thus, the new a.out file - may be debugged with symbolic debuggers. - - If you fix any bugs in this, I'd like to incorporate your fixes. - Send them to uunet!hpda!hpsemc!jmorris or jmorris%hpsemc@hplabs.HP.COM. - - CAVEATS: - This routine saves the current value of all static and external - variables. This means that any data structure that needs to be - initialized must be explicitly reset. Variables will not have their - expected default values. - - Unfortunately, the HP-UX signal handler has internal initialization - flags which are not explicitly reset. Thus, for signals to work in - conjunction with this routine, the following code must executed when - the new process starts up. - - void _sigreturn (); - ... - sigsetreturn (_sigreturn); -*/ - -#include -#include "unexec.h" -#include "lisp.h" -#include "sysstdio.h" - -#include -#include -#include -#include - -/* brk value to restore, stored as a global. - This is really used only if we used shared libraries. */ -static long brk_on_dump = 0; - -/* Called from main, if we use shared libraries. */ -int -run_time_remap (char *ignored) -{ - brk ((char *) brk_on_dump); -} - -#undef roundup -#define roundup(x,n) (((x) + ((n) - 1)) & ~((n) - 1)) /* n is power of 2 */ - -/* Report a fatal error and exit. */ -static _Noreturn void -unexec_error (char const *msg) -{ - perror (msg); - exit (1); -} - -/* Do an lseek and check the result. */ -static void -check_lseek (int fd, off_t offset, int whence) -{ - if (lseek (fd, offset, whence) < 0) - unexec_error ("Cannot lseek"); -} - -/* Save current data space in the file, update header. */ - -static void -save_data_space (int file, struct header *hdr, struct som_exec_auxhdr *auxhdr, - int size) -{ - /* Write the entire data space out to the file */ - if (write (file, auxhdr->exec_dmem, size) != size) - unexec_error ("Can't save new data space"); - - /* Update the header to reflect the new data size */ - auxhdr->exec_dsize = size; - auxhdr->exec_bsize = 0; -} - -/* Update the values of file pointers when something is inserted. */ - -static void -update_file_ptrs (int file, struct header *hdr, struct som_exec_auxhdr *auxhdr, - unsigned int location, int offset) -{ - struct subspace_dictionary_record subspace; - int i; - - /* Increase the overall size of the module */ - hdr->som_length += offset; - - /* Update the various file pointers in the header */ -#define update(ptr) if (ptr > location) ptr = ptr + offset - update (hdr->aux_header_location); - update (hdr->space_strings_location); - update (hdr->init_array_location); - update (hdr->compiler_location); - update (hdr->symbol_location); - update (hdr->fixup_request_location); - update (hdr->symbol_strings_location); - update (hdr->unloadable_sp_location); - update (auxhdr->exec_tfile); - update (auxhdr->exec_dfile); - - /* Do for each subspace dictionary entry */ - check_lseek (file, hdr->subspace_location, 0); - for (i = 0; i < hdr->subspace_total; i++) - { - ptrdiff_t subspace_size = sizeof subspace; - if (read (file, &subspace, subspace_size) != subspace_size) - unexec_error ("Can't read subspace record"); - - /* If subspace has a file location, update it */ - if (subspace.initialization_length > 0 - && subspace.file_loc_init_value > location) - { - subspace.file_loc_init_value += offset; - check_lseek (file, -subspace_size, 1); - if (write (file, &subspace, subspace_size) != subspace_size) - unexec_error ("Can't update subspace record"); - } - } - - /* Do for each initialization pointer record */ - /* (I don't think it applies to executable files, only relocatables) */ -#undef update -} - -/* Read in the header records from an a.out file. */ - -static void -read_header (int file, struct header *hdr, struct som_exec_auxhdr *auxhdr) -{ - - /* Read the header in */ - check_lseek (file, 0, 0); - if (read (file, hdr, sizeof (*hdr)) != sizeof (*hdr)) - unexec_error ("Couldn't read header from a.out file"); - - if (hdr->a_magic != EXEC_MAGIC && hdr->a_magic != SHARE_MAGIC - && hdr->a_magic != DEMAND_MAGIC) - { - fputs ("a.out file doesn't have valid magic number\n", stderr); - exit (1); - } - - check_lseek (file, hdr->aux_header_location, 0); - if (read (file, auxhdr, sizeof (*auxhdr)) != sizeof (*auxhdr)) - unexec_error ("Couldn't read auxiliary header from a.out file"); -} - -/* Write out the header records into an a.out file. */ - -static void -write_header (int file, struct header *hdr, struct som_exec_auxhdr *auxhdr) -{ - /* Update the checksum */ - hdr->checksum = calculate_checksum (hdr); - - /* Write the header back into the a.out file */ - check_lseek (file, 0, 0); - if (write (file, hdr, sizeof (*hdr)) != sizeof (*hdr)) - unexec_error ("Couldn't write header to a.out file"); - check_lseek (file, hdr->aux_header_location, 0); - if (write (file, auxhdr, sizeof (*auxhdr)) != sizeof (*auxhdr)) - unexec_error ("Couldn't write auxiliary header to a.out file"); -} - -/* Calculate the checksum of a SOM header record. */ - -static int -calculate_checksum (struct header *hdr) -{ - int checksum, i, *ptr; - - checksum = 0; ptr = (int *) hdr; - - for (i = 0; i < sizeof (*hdr) / sizeof (int) - 1; i++) - checksum ^= ptr[i]; - - return (checksum); -} - -/* Copy size bytes from the old file to the new one. */ - -static void -copy_file (int old, int new, int size) -{ - int len; - int buffer[8192]; /* word aligned will be faster */ - - for (; size > 0; size -= len) - { - len = min (size, sizeof (buffer)); - if (read (old, buffer, len) != len) - unexec_error ("Read failure on a.out file"); - if (write (new, buffer, len) != len) - unexec_error ("Write failure in a.out file"); - } -} - -/* Copy the rest of the file, up to EOF. */ - -static void -copy_rest (int old, int new) -{ - int buffer[4096]; - int len; - - /* Copy bytes until end of file or error */ - while ((len = read (old, buffer, sizeof (buffer))) > 0) - if (write (new, buffer, len) != len) break; - - if (len != 0) - unexec_error ("Unable to copy the rest of the file"); -} - -#ifdef DEBUG -static void -display_header (struct header *hdr, struct som_exec_auxhdr *auxhdr) -{ - /* Display the header information (debug) */ - printf ("\n\nFILE HEADER\n"); - printf ("magic number %d \n", hdr->a_magic); - printf ("text loc %.8x size %d \n", auxhdr->exec_tmem, auxhdr->exec_tsize); - printf ("data loc %.8x size %d \n", auxhdr->exec_dmem, auxhdr->exec_dsize); - printf ("entry %x \n", auxhdr->exec_entry); - printf ("Bss segment size %u\n", auxhdr->exec_bsize); - printf ("\n"); - printf ("data file loc %d size %d\n", - auxhdr->exec_dfile, auxhdr->exec_dsize); - printf ("som_length %d\n", hdr->som_length); - printf ("unloadable sploc %d size %d\n", - hdr->unloadable_sp_location, hdr->unloadable_sp_size); -} -#endif /* DEBUG */ - - -/* Create a new a.out file, same as old but with current data space */ -void -unexec (const char *new_name, /* name of the new a.out file to be created */ - const char *old_name) /* name of the old a.out file */ -{ - int old, new; - int old_size, new_size; - struct header hdr; - struct som_exec_auxhdr auxhdr; - long i; - - /* For the greatest flexibility, should create a temporary file in - the same directory as the new file. When everything is complete, - rename the temp file to the new name. - This way, a program could update its own a.out file even while - it is still executing. If problems occur, everything is still - intact. NOT implemented. */ - - /* Open the input and output a.out files. */ - old = emacs_open (old_name, O_RDONLY, 0); - if (old < 0) - unexec_error (old_name); - new = emacs_open (new_name, O_CREAT | O_RDWR | O_TRUNC, 0777); - if (new < 0) - unexec_error (new_name); - - /* Read the old headers. */ - read_header (old, &hdr, &auxhdr); - - brk_on_dump = (long) sbrk (0); - - /* Decide how large the new and old data areas are. */ - old_size = auxhdr.exec_dsize; - /* I suspect these two statements are separate - to avoid a compiler bug in hpux version 8. */ - i = (long) sbrk (0); - new_size = i - auxhdr.exec_dmem; - - /* Copy the old file to the new, up to the data space. */ - check_lseek (old, 0, 0); - copy_file (old, new, auxhdr.exec_dfile); - - /* Skip the old data segment and write a new one. */ - check_lseek (old, old_size, 1); - save_data_space (new, &hdr, &auxhdr, new_size); - - /* Copy the rest of the file. */ - copy_rest (old, new); - - /* Update file pointers since we probably changed size of data area. */ - update_file_ptrs (new, &hdr, &auxhdr, auxhdr.exec_dfile, new_size-old_size); - - /* Save the modified header. */ - write_header (new, &hdr, &auxhdr); - - /* Close the binary file. */ - emacs_close (old); - emacs_close (new); -} diff --git a/src/unexmacosx.c b/src/unexmacosx.c deleted file mode 100644 index 7b2326441b4..00000000000 --- a/src/unexmacosx.c +++ /dev/null @@ -1,1406 +0,0 @@ -/* Dump Emacs in Mach-O format for use on macOS. - Copyright (C) 2001-2024 Free Software Foundation, Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or (at -your option) any later version. - -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see . */ - -/* Contributed by Andrew Choi (akochoi@mac.com). */ - -/* Documentation note. - - Consult the following documents/files for a description of the - Mach-O format: the file loader.h, man pages for Mach-O and ld, old - NEXTSTEP documents of the Mach-O format. The tool otool dumps the - mach header (-h option) and the load commands (-l option) in a - Mach-O file. The tool nm on macOS displays the symbol table in - a Mach-O file. For examples of unexec for the Mach-O format, see - the file unexnext.c in the GNU Emacs distribution, the file - unexdyld.c in the Darwin port of GNU Emacs 20.7, and unexdyld.c in - the Darwin port of XEmacs 21.1. Also the Darwin Libc source - contains the source code for malloc_freezedry and malloc_jumpstart. - Read that to see what they do. This file was written completely - from scratch, making use of information from the above sources. */ - -/* The macOS implementation of unexec makes use of Darwin's `zone' - memory allocator. All calls to malloc, realloc, and free in Emacs - are redirected to unexec_malloc, unexec_realloc, and unexec_free in - this file. When temacs is run, all memory requests are handled in - the zone EmacsZone. The Darwin memory allocator library calls - maintain the data structures to manage this zone. Dumping writes - its contents to data segments of the executable file. When emacs - is run, the loader recreates the contents of the zone in memory. - However since the initialization routine of the zone memory - allocator is run again, this `zone' can no longer be used as a - heap. That is why emacs uses the ordinary malloc system call to - allocate memory. Also, when a block of memory needs to be - reallocated and the new size is larger than the old one, a new - block must be obtained by malloc and the old contents copied to - it. */ - -/* Peculiarity of the Mach-O files generated by ld in macOS - (possible causes of future bugs if changed). - - The file offset of the start of the __TEXT segment is zero. Since - the Mach header and load commands are located at the beginning of a - Mach-O file, copying the contents of the __TEXT segment from the - input file overwrites them in the output file. Despite this, - unexec works fine as written below because the segment load command - for __TEXT appears, and is therefore processed, before all other - load commands except the segment load command for __PAGEZERO, which - remains unchanged. - - Although the file offset of the start of the __TEXT segment is - zero, none of the sections it contains actually start there. In - fact, the earliest one starts a few hundred bytes beyond the end of - the last load command. The linker option -headerpad controls the - minimum size of this padding. Its setting can be changed in - s/darwin.h. A value of 0x690, e.g., leaves room for 30 additional - load commands for the newly created __DATA segments (at 56 bytes - each). Unexec fails if there is not enough room for these new - segments. - - The __TEXT segment contains the sections __text, __cstring, - __picsymbol_stub, and __const and the __DATA segment contains the - sections __data, __la_symbol_ptr, __nl_symbol_ptr, __dyld, __bss, - and __common. The other segments do not contain any sections. - These sections are copied from the input file to the output file, - except for __data, __bss, and __common, which are dumped from - memory. The types of the sections __bss and __common are changed - from S_ZEROFILL to S_REGULAR. Note that the number of sections and - their relative order in the input and output files remain - unchanged. Otherwise all n_sect fields in the nlist records in the - symbol table (specified by the LC_SYMTAB load command) will have to - be changed accordingly. -*/ - -#include - -/* Although redefines malloc to unexec_malloc, etc., this - file wants stdlib.h to declare the originals. */ -#undef malloc -#undef realloc -#undef free - -#include - -#include "unexec.h" -#include "lisp.h" -#include "sysstdio.h" - -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#ifdef HAVE_MALLOC_MALLOC_H -#include -#else -#include -#endif - -#include - -/* LC_DATA_IN_CODE is not defined in mach-o/loader.h on Mac OS X 10.7. - But it is used if we build with "Command Line Tools for Xcode 4.5 - (Mac OS X Lion) - September 2012". */ -#ifndef LC_DATA_IN_CODE -#define LC_DATA_IN_CODE 0x29 /* table of non-instructions in __text */ -#endif - -#ifdef _LP64 -#define mach_header mach_header_64 -#define segment_command segment_command_64 -#undef VM_REGION_BASIC_INFO_COUNT -#define VM_REGION_BASIC_INFO_COUNT VM_REGION_BASIC_INFO_COUNT_64 -#undef VM_REGION_BASIC_INFO -#define VM_REGION_BASIC_INFO VM_REGION_BASIC_INFO_64 -#undef LC_SEGMENT -#define LC_SEGMENT LC_SEGMENT_64 -#define vm_region vm_region_64 -#define section section_64 -#undef MH_MAGIC -#define MH_MAGIC MH_MAGIC_64 -#endif - -#define VERBOSE 1 - -/* Size of buffer used to copy data from the input file to the output - file in function unexec_copy. */ -#define UNEXEC_COPY_BUFSZ 1024 - -/* Regions with memory addresses above this value are assumed to be - mapped to dynamically loaded libraries and will not be dumped. */ -#define VM_DATA_TOP (20 * 1024 * 1024) - -/* Type of an element on the list of regions to be dumped. */ -struct region_t { - vm_address_t address; - vm_size_t size; - vm_prot_t protection; - vm_prot_t max_protection; - - struct region_t *next; -}; - -/* Head and tail of the list of regions to be dumped. */ -static struct region_t *region_list_head = 0; -static struct region_t *region_list_tail = 0; - -/* Pointer to array of load commands. */ -static struct load_command **lca; - -/* Number of load commands. */ -static int nlc; - -/* The highest VM address of segments loaded by the input file. - Regions with addresses beyond this are assumed to be allocated - dynamically and thus require dumping. */ -static vm_address_t infile_lc_highest_addr = 0; - -/* The lowest file offset used by the all sections in the __TEXT - segments. This leaves room at the beginning of the file to store - the Mach-O header. Check this value against header size to ensure - the added load commands for the new __DATA segments did not - overwrite any of the sections in the __TEXT segment. */ -static unsigned long text_seg_lowest_offset = 0x10000000; - -/* Mach header. */ -static struct mach_header mh; - -/* Offset at which the next load command should be written. */ -static unsigned long curr_header_offset = sizeof (struct mach_header); - -/* Offset at which the next segment should be written. */ -static unsigned long curr_file_offset = 0; - -static unsigned long pagesize; -#define ROUNDUP_TO_PAGE_BOUNDARY(x) (((x) + pagesize - 1) & ~(pagesize - 1)) - -static int infd, outfd; - -static int in_dumped_exec = 0; - -static malloc_zone_t *emacs_zone; - -/* file offset of input file's data segment */ -static off_t data_segment_old_fileoff = 0; - -static struct segment_command *data_segment_scp; - -/* Read N bytes from infd into memory starting at address DEST. - Return true if successful, false otherwise. */ -static int -unexec_read (void *dest, size_t n) -{ - return n == read (infd, dest, n); -} - -/* Write COUNT bytes from memory starting at address SRC to outfd - starting at offset DEST. Return true if successful, false - otherwise. */ -static int -unexec_write (off_t dest, const void *src, size_t count) -{ - task_t task = mach_task_self(); - if (task == MACH_PORT_NULL || task == MACH_PORT_DEAD) - return false; - - if (lseek (outfd, dest, SEEK_SET) != dest) - return 0; - - /* We use the Mach virtual memory API to read our process memory - because using src directly would be undefined behavior and fails - under Address Sanitizer. */ - bool success = false; - vm_offset_t data; - mach_msg_type_number_t data_count; - if (vm_read (task, (uintptr_t) src, count, &data, &data_count) - == KERN_SUCCESS) - { - success = - write (outfd, (const void *) (uintptr_t) data, data_count) == count; - vm_deallocate (task, data, data_count); - } - return success; -} - -/* Write COUNT bytes of zeros to outfd starting at offset DEST. - Return true if successful, false otherwise. */ -static int -unexec_write_zero (off_t dest, size_t count) -{ - char buf[UNEXEC_COPY_BUFSZ]; - ssize_t bytes; - - memset (buf, 0, UNEXEC_COPY_BUFSZ); - if (lseek (outfd, dest, SEEK_SET) != dest) - return 0; - - while (count > 0) - { - bytes = count > UNEXEC_COPY_BUFSZ ? UNEXEC_COPY_BUFSZ : count; - if (write (outfd, buf, bytes) != bytes) - return 0; - count -= bytes; - } - - return 1; -} - -/* Copy COUNT bytes from starting offset SRC in infd to starting - offset DEST in outfd. Return true if successful, false - otherwise. */ -static int -unexec_copy (off_t dest, off_t src, ssize_t count) -{ - ssize_t bytes_read; - ssize_t bytes_to_read; - - char buf[UNEXEC_COPY_BUFSZ]; - - if (lseek (infd, src, SEEK_SET) != src) - return 0; - - if (lseek (outfd, dest, SEEK_SET) != dest) - return 0; - - while (count > 0) - { - bytes_to_read = count > UNEXEC_COPY_BUFSZ ? UNEXEC_COPY_BUFSZ : count; - bytes_read = read (infd, buf, bytes_to_read); - if (bytes_read <= 0) - return 0; - if (write (outfd, buf, bytes_read) != bytes_read) - return 0; - count -= bytes_read; - } - - return 1; -} - -/* Debugging and informational messages routines. */ - -static _Noreturn void -unexec_error (const char *format, ...) -{ - va_list ap; - - va_start (ap, format); - fputs ("unexec: ", stderr); - vfprintf (stderr, format, ap); - putc ('\n', stderr); - va_end (ap); - exit (1); -} - -static void -print_prot (vm_prot_t prot) -{ - if (prot == VM_PROT_NONE) - printf ("none"); - else - { - putchar (prot & VM_PROT_READ ? 'r' : ' '); - putchar (prot & VM_PROT_WRITE ? 'w' : ' '); - putchar (prot & VM_PROT_EXECUTE ? 'x' : ' '); - putchar (' '); - } -} - -static void -print_region (vm_address_t address, vm_size_t size, vm_prot_t prot, - vm_prot_t max_prot) -{ - printf ("%#10lx %#8lx ", (long) address, (long) size); - print_prot (prot); - putchar (' '); - print_prot (max_prot); - putchar ('\n'); -} - -static void -print_region_list (void) -{ - struct region_t *r; - - printf (" address size prot maxp\n"); - - for (r = region_list_head; r; r = r->next) - print_region (r->address, r->size, r->protection, r->max_protection); -} - -/* Build the list of regions that need to be dumped. Regions with - addresses above VM_DATA_TOP are omitted. Adjacent regions with - identical protection are merged. Note that non-writable regions - cannot be omitted because they some regions created at run time are - read-only. */ -static void -build_region_list (void) -{ - task_t target_task = mach_task_self (); - vm_address_t address = (vm_address_t) 0; - vm_size_t size; - struct vm_region_basic_info info; - mach_msg_type_number_t info_count = VM_REGION_BASIC_INFO_COUNT; - mach_port_t object_name; - struct region_t *r; - -#if VERBOSE - printf ("--- List of All Regions ---\n"); - printf (" address size prot maxp\n"); -#endif - - while (vm_region (target_task, &address, &size, VM_REGION_BASIC_INFO, - (vm_region_info_t) &info, &info_count, &object_name) - == KERN_SUCCESS && info_count == VM_REGION_BASIC_INFO_COUNT) - { - /* Done when we reach addresses of shared libraries, which are - loaded in high memory. */ - if (address >= VM_DATA_TOP) - break; - -#if VERBOSE - print_region (address, size, info.protection, info.max_protection); -#endif - - /* If a region immediately follows the previous one (the one - most recently added to the list) and has identical - protection, merge it with the latter. Otherwise create a - new list element for it. */ - if (region_list_tail - && info.protection == region_list_tail->protection - && info.max_protection == region_list_tail->max_protection - && region_list_tail->address + region_list_tail->size == address) - { - region_list_tail->size += size; - } - else - { - r = malloc (sizeof *r); - - if (!r) - unexec_error ("cannot allocate region structure"); - - r->address = address; - r->size = size; - r->protection = info.protection; - r->max_protection = info.max_protection; - - r->next = 0; - if (region_list_head == 0) - { - region_list_head = r; - region_list_tail = r; - } - else - { - region_list_tail->next = r; - region_list_tail = r; - } - - /* Deallocate (unused) object name returned by - vm_region. */ - if (object_name != MACH_PORT_NULL) - mach_port_deallocate (target_task, object_name); - } - - address += size; - } - - printf ("--- List of Regions to be Dumped ---\n"); - print_region_list (); -} - - -#define MAX_UNEXEC_REGIONS 400 - -static int num_unexec_regions; -typedef struct { - vm_range_t range; - vm_size_t filesize; -} unexec_region_info; -static unexec_region_info unexec_regions[MAX_UNEXEC_REGIONS]; - -static void -unexec_regions_recorder (task_t task, void *rr, unsigned type, - vm_range_t *ranges, unsigned num) -{ - vm_address_t p; - vm_size_t filesize; - - while (num && num_unexec_regions < MAX_UNEXEC_REGIONS) - { - /* Subtract the size of trailing null bytes from filesize. It - can be smaller than vmsize in segment commands. In such a - case, trailing bytes are initialized with zeros. */ - for (p = ranges->address + ranges->size; p > ranges->address; p--) - if (*(((char *) p)-1)) - break; - filesize = p - ranges->address; - - unexec_regions[num_unexec_regions].filesize = filesize; - unexec_regions[num_unexec_regions++].range = *ranges; - printf ("%#10lx (sz: %#8lx/%#8lx)\n", (long) (ranges->address), - (long) filesize, (long) (ranges->size)); - ranges++; num--; - } -} - -static kern_return_t -unexec_reader (task_t task, vm_address_t address, vm_size_t size, void **ptr) -{ - *ptr = (void *) address; - return KERN_SUCCESS; -} - -static void -find_emacs_zone_regions (void) -{ - num_unexec_regions = 0; - - emacs_zone->introspect->enumerator (mach_task_self (), 0, - MALLOC_PTR_REGION_RANGE_TYPE - | MALLOC_ADMIN_REGION_RANGE_TYPE, - (vm_address_t) emacs_zone, - unexec_reader, - unexec_regions_recorder); - - if (num_unexec_regions == MAX_UNEXEC_REGIONS) - unexec_error ("find_emacs_zone_regions: too many regions"); -} - -static int -unexec_regions_sort_compare (const void *a, const void *b) -{ - vm_address_t aa = ((unexec_region_info *) a)->range.address; - vm_address_t bb = ((unexec_region_info *) b)->range.address; - - if (aa < bb) - return -1; - else if (aa > bb) - return 1; - else - return 0; -} - -static void -unexec_regions_merge (void) -{ - qsort (unexec_regions, num_unexec_regions, sizeof (unexec_regions[0]), - &unexec_regions_sort_compare); - - /* Align each region start address to a page boundary. */ - for (unexec_region_info *cur = unexec_regions; - cur < unexec_regions + num_unexec_regions; cur++) - { - vm_size_t padsize = cur->range.address & (pagesize - 1); - if (padsize) - { - cur->range.address -= padsize; - cur->range.size += padsize; - cur->filesize += padsize; - - unexec_region_info *prev = cur == unexec_regions ? NULL : cur - 1; - if (prev - && prev->range.address + prev->range.size > cur->range.address) - { - prev->range.size = cur->range.address - prev->range.address; - if (prev->filesize > prev->range.size) - prev->filesize = prev->range.size; - } - } - } - - int n = 0; - unexec_region_info r = unexec_regions[0]; - for (int i = 1; i < num_unexec_regions; i++) - { - if (r.range.address + r.range.size == unexec_regions[i].range.address - && r.range.size - r.filesize < 2 * pagesize) - { - r.filesize = r.range.size + unexec_regions[i].filesize; - r.range.size += unexec_regions[i].range.size; - } - else - { - unexec_regions[n++] = r; - r = unexec_regions[i]; - } - } - unexec_regions[n++] = r; - num_unexec_regions = n; -} - - -/* More informational messages routines. */ - -static void -print_load_command_name (int lc) -{ - switch (lc) - { - case LC_SEGMENT: -#ifndef _LP64 - printf ("LC_SEGMENT "); -#else - printf ("LC_SEGMENT_64 "); -#endif - break; - case LC_LOAD_DYLINKER: - printf ("LC_LOAD_DYLINKER "); - break; - case LC_LOAD_DYLIB: - printf ("LC_LOAD_DYLIB "); - break; - case LC_SYMTAB: - printf ("LC_SYMTAB "); - break; - case LC_DYSYMTAB: - printf ("LC_DYSYMTAB "); - break; - case LC_UNIXTHREAD: - printf ("LC_UNIXTHREAD "); - break; - case LC_PREBOUND_DYLIB: - printf ("LC_PREBOUND_DYLIB"); - break; - case LC_TWOLEVEL_HINTS: - printf ("LC_TWOLEVEL_HINTS"); - break; -#ifdef LC_UUID - case LC_UUID: - printf ("LC_UUID "); - break; -#endif -#ifdef LC_DYLD_INFO - case LC_DYLD_INFO: - printf ("LC_DYLD_INFO "); - break; - case LC_DYLD_INFO_ONLY: - printf ("LC_DYLD_INFO_ONLY"); - break; -#endif -#ifdef LC_VERSION_MIN_MACOSX - case LC_VERSION_MIN_MACOSX: - printf ("LC_VERSION_MIN_MACOSX"); - break; -#endif -#ifdef LC_FUNCTION_STARTS - case LC_FUNCTION_STARTS: - printf ("LC_FUNCTION_STARTS"); - break; -#endif -#ifdef LC_MAIN - case LC_MAIN: - printf ("LC_MAIN "); - break; -#endif -#ifdef LC_DATA_IN_CODE - case LC_DATA_IN_CODE: - printf ("LC_DATA_IN_CODE "); - break; -#endif -#ifdef LC_SOURCE_VERSION - case LC_SOURCE_VERSION: - printf ("LC_SOURCE_VERSION"); - break; -#endif -#ifdef LC_DYLIB_CODE_SIGN_DRS - case LC_DYLIB_CODE_SIGN_DRS: - printf ("LC_DYLIB_CODE_SIGN_DRS"); - break; -#endif - default: - printf ("unknown "); - } -} - -static void -print_load_command (struct load_command *lc) -{ - print_load_command_name (lc->cmd); - printf ("%8d", lc->cmdsize); - - if (lc->cmd == LC_SEGMENT) - { - struct segment_command *scp; - struct section *sectp; - int j; - - scp = (struct segment_command *) lc; - printf (" %-16.16s %#10lx %#8lx\n", - scp->segname, (long) (scp->vmaddr), (long) (scp->vmsize)); - - sectp = (struct section *) (scp + 1); - for (j = 0; j < scp->nsects; j++) - { - printf (" %-16.16s %#10lx %#8lx\n", - sectp->sectname, (long) (sectp->addr), (long) (sectp->size)); - sectp++; - } - } - else - printf ("\n"); -} - -/* Read header and load commands from input file. Store the latter in - the global array lca. Store the total number of load commands in - global variable nlc. */ -static void -read_load_commands (void) -{ - int i; - - if (!unexec_read (&mh, sizeof (struct mach_header))) - unexec_error ("cannot read mach-o header"); - - if (mh.magic != MH_MAGIC) - unexec_error ("input file not in Mach-O format"); - - if (mh.filetype != MH_EXECUTE) - unexec_error ("input Mach-O file is not an executable object file"); - -#if VERBOSE - printf ("--- Header Information ---\n"); - printf ("Magic = 0x%08x\n", mh.magic); - printf ("CPUType = %d\n", mh.cputype); - printf ("CPUSubType = %d\n", mh.cpusubtype); - printf ("FileType = 0x%x\n", mh.filetype); - printf ("NCmds = %d\n", mh.ncmds); - printf ("SizeOfCmds = %d\n", mh.sizeofcmds); - printf ("Flags = 0x%08x\n", mh.flags); -#endif - - nlc = mh.ncmds; - lca = malloc (nlc * sizeof *lca); - - for (i = 0; i < nlc; i++) - { - struct load_command lc; - /* Load commands are variable-size: so read the command type and - size first and then read the rest. */ - if (!unexec_read (&lc, sizeof (struct load_command))) - unexec_error ("cannot read load command"); - lca[i] = malloc (lc.cmdsize); - memcpy (lca[i], &lc, sizeof (struct load_command)); - if (!unexec_read (lca[i] + 1, lc.cmdsize - sizeof (struct load_command))) - unexec_error ("cannot read content of load command"); - if (lc.cmd == LC_SEGMENT) - { - struct segment_command *scp = (struct segment_command *) lca[i]; - - if (scp->vmaddr + scp->vmsize > infile_lc_highest_addr) - infile_lc_highest_addr = scp->vmaddr + scp->vmsize; - - if (strncmp (scp->segname, SEG_TEXT, 16) == 0) - { - struct section *sectp = (struct section *) (scp + 1); - int j; - - for (j = 0; j < scp->nsects; j++) - if (sectp->offset < text_seg_lowest_offset) - text_seg_lowest_offset = sectp->offset; - } - } - } - - printf ("Highest address of load commands in input file: %#8lx\n", - (unsigned long)infile_lc_highest_addr); - - printf ("Lowest offset of all sections in __TEXT segment: %#8lx\n", - text_seg_lowest_offset); - - printf ("--- List of Load Commands in Input File ---\n"); - printf ("# cmd cmdsize name address size\n"); - - for (i = 0; i < nlc; i++) - { - printf ("%1d ", i); - print_load_command (lca[i]); - } -} - -/* Copy a LC_SEGMENT load command other than the __DATA segment from - the input file to the output file, adjusting the file offset of the - segment and the file offsets of sections contained in it. */ -static void -copy_segment (struct load_command *lc) -{ - struct segment_command *scp = (struct segment_command *) lc; - unsigned long old_fileoff = scp->fileoff; - struct section *sectp; - int j; - - scp->fileoff = curr_file_offset; - - sectp = (struct section *) (scp + 1); - for (j = 0; j < scp->nsects; j++) - { - sectp->offset += curr_file_offset - old_fileoff; - sectp++; - } - - printf ("Writing segment %-16.16s @ %#8lx (%#8lx/%#8lx @ %#10lx)\n", - scp->segname, (long) (scp->fileoff), (long) (scp->filesize), - (long) (scp->vmsize), (long) (scp->vmaddr)); - - if (!unexec_copy (scp->fileoff, old_fileoff, scp->filesize)) - unexec_error ("cannot copy segment from input to output file"); - curr_file_offset += ROUNDUP_TO_PAGE_BOUNDARY (scp->filesize); - - if (!unexec_write (curr_header_offset, lc, lc->cmdsize)) - unexec_error ("cannot write load command to header"); - - curr_header_offset += lc->cmdsize; -} - -/* Copy a LC_SEGMENT load command for the __DATA segment in the input - file to the output file. We assume that only one such segment load - command exists in the input file and it contains the sections - __data, __bss, __common, __la_symbol_ptr, __nl_symbol_ptr, and - __dyld. The first three of these should be dumped from memory and - the rest should be copied from the input file. Note that the - sections __bss and __common contain no data in the input file - because their flag fields have the value S_ZEROFILL. Dumping these - from memory makes it necessary to adjust file offset fields in - subsequently dumped load commands. Then, create new __DATA segment - load commands for regions on the region list other than the one - corresponding to the __DATA segment in the input file. */ -static void -copy_data_segment (struct load_command *lc) -{ - struct segment_command *scp = (struct segment_command *) lc; - struct section *sectp; - int j; - unsigned long header_offset, old_file_offset; - - /* The new filesize of the segment is set to its vmsize because data - blocks for segments must start at region boundaries. Note that - this may leave unused locations at the end of the segment data - block because the total of the sizes of all sections in the - segment is generally smaller than vmsize. */ - scp->filesize = scp->vmsize; - - printf ("Writing segment %-16.16s @ %#8lx (%#8lx/%#8lx @ %#10lx)\n", - scp->segname, curr_file_offset, (long)(scp->filesize), - (long)(scp->vmsize), (long) (scp->vmaddr)); - - /* Offsets in the output file for writing the next section structure - and segment data block, respectively. */ - header_offset = curr_header_offset + sizeof (struct segment_command); - - sectp = (struct section *) (scp + 1); - for (j = 0; j < scp->nsects; j++) - { - old_file_offset = sectp->offset; - sectp->offset = sectp->addr - scp->vmaddr + curr_file_offset; - /* The __data section is dumped from memory. The __bss and - __common sections are also dumped from memory but their flag - fields require changing (from S_ZEROFILL to S_REGULAR). The - other three kinds of sections are just copied from the input - file. */ - if (strncmp (sectp->sectname, SECT_DATA, 16) == 0) - { - unsigned long my_size; - - /* The __data section is basically dumped from memory. But - initialized data in statically linked libraries are - copied from the input file. In particular, - add_image_hook.names and add_image_hook.pointers stored - by libarclite_macosx.a, are restored so that they will be - reinitialized when the dumped binary is executed. */ - my_size = (unsigned long)my_edata - sectp->addr; - if (!(sectp->addr <= (unsigned long)my_edata - && my_size <= sectp->size)) - unexec_error ("my_edata is not in section %s", SECT_DATA); - if (!unexec_write (sectp->offset, (void *) sectp->addr, my_size)) - unexec_error ("cannot write section %s", SECT_DATA); - if (!unexec_copy (sectp->offset + my_size, old_file_offset + my_size, - sectp->size - my_size)) - unexec_error ("cannot copy section %s", SECT_DATA); - if (!unexec_write (header_offset, sectp, sizeof (struct section))) - unexec_error ("cannot write section %s's header", SECT_DATA); - } - else if (strncmp (sectp->sectname, SECT_COMMON, 16) == 0) - { - sectp->flags = S_REGULAR; - if (!unexec_write (sectp->offset, (void *) sectp->addr, sectp->size)) - unexec_error ("cannot write section %.16s", sectp->sectname); - if (!unexec_write (header_offset, sectp, sizeof (struct section))) - unexec_error ("cannot write section %.16s's header", sectp->sectname); - } - else if (strncmp (sectp->sectname, SECT_BSS, 16) == 0) - { - unsigned long my_size; - - sectp->flags = S_REGULAR; - - /* Clear uninitialized local variables in statically linked - libraries. In particular, function pointers stored by - libSystemStub.a, which is introduced in Mac OS X 10.4 for - binary compatibility with respect to long double, are - cleared so that they will be reinitialized when the - dumped binary is executed on other versions of OS. */ - my_size = (unsigned long)my_endbss_static - sectp->addr; - if (!(sectp->addr <= (unsigned long)my_endbss_static - && my_size <= sectp->size)) - unexec_error ("my_endbss_static is not in section %.16s", - sectp->sectname); - if (!unexec_write (sectp->offset, (void *) sectp->addr, my_size)) - unexec_error ("cannot write section %.16s", sectp->sectname); - if (!unexec_write_zero (sectp->offset + my_size, - sectp->size - my_size)) - unexec_error ("cannot write section %.16s", sectp->sectname); - if (!unexec_write (header_offset, sectp, sizeof (struct section))) - unexec_error ("cannot write section %.16s's header", sectp->sectname); - } - else if (strncmp (sectp->sectname, "__bss", 5) == 0 - || strncmp (sectp->sectname, "__pu_bss", 8) == 0) - { - sectp->flags = S_REGULAR; - - /* These sections are produced by GCC 4.6+. - - FIXME: We possibly ought to clear uninitialized local - variables in statically linked libraries like for - SECT_BSS (__bss) above, but setting up the markers we - need in lastfile.c would be rather messy. See - darwin_output_aligned_bss () in gcc/config/darwin.c for - the root of the problem, keeping in mind that the - sections are numbered by their alignment in GCC 4.6, but - by log2(alignment) in GCC 4.7. */ - - if (!unexec_write (sectp->offset, (void *) sectp->addr, sectp->size)) - unexec_error ("cannot copy section %.16s", sectp->sectname); - if (!unexec_write (header_offset, sectp, sizeof (struct section))) - unexec_error ("cannot write section %.16s's header", sectp->sectname); - } - else if (strncmp (sectp->sectname, "__la_symbol_ptr", 16) == 0 - || strncmp (sectp->sectname, "__nl_symbol_ptr", 16) == 0 - || strncmp (sectp->sectname, "__got", 16) == 0 - || strncmp (sectp->sectname, "__la_sym_ptr2", 16) == 0 - || strncmp (sectp->sectname, "__dyld", 16) == 0 - || strncmp (sectp->sectname, "__const", 16) == 0 - || strncmp (sectp->sectname, "__cfstring", 16) == 0 - || strncmp (sectp->sectname, "__gcc_except_tab", 16) == 0 - || strncmp (sectp->sectname, "__program_vars", 16) == 0 - || strncmp (sectp->sectname, "__mod_init_func", 16) == 0 - || strncmp (sectp->sectname, "__mod_term_func", 16) == 0 - || strncmp (sectp->sectname, "__static_data", 16) == 0 - || strncmp (sectp->sectname, "__objc_", 7) == 0) - { - if (!unexec_copy (sectp->offset, old_file_offset, sectp->size)) - unexec_error ("cannot copy section %.16s", sectp->sectname); - if (!unexec_write (header_offset, sectp, sizeof (struct section))) - unexec_error ("cannot write section %.16s's header", sectp->sectname); - } - else - unexec_error ("unrecognized section %.16s in __DATA segment", - sectp->sectname); - - printf (" section %-16.16s at %#8lx - %#8lx (sz: %#8lx)\n", - sectp->sectname, (long) (sectp->offset), - (long) (sectp->offset + sectp->size), (long) (sectp->size)); - - header_offset += sizeof (struct section); - sectp++; - } - - curr_file_offset += ROUNDUP_TO_PAGE_BOUNDARY (scp->filesize); - - if (!unexec_write (curr_header_offset, scp, sizeof (struct segment_command))) - unexec_error ("cannot write header of __DATA segment"); - curr_header_offset += lc->cmdsize; - - /* Create new __DATA segment load commands for regions on the region - list that do not corresponding to any segment load commands in - the input file. - */ - for (j = 0; j < num_unexec_regions; j++) - { - struct segment_command sc; - - sc.cmd = LC_SEGMENT; - sc.cmdsize = sizeof (struct segment_command); - strncpy (sc.segname, SEG_DATA, 16); - sc.vmaddr = unexec_regions[j].range.address; - sc.vmsize = unexec_regions[j].range.size; - sc.fileoff = curr_file_offset; - sc.filesize = unexec_regions[j].filesize; - sc.maxprot = VM_PROT_READ | VM_PROT_WRITE; - sc.initprot = VM_PROT_READ | VM_PROT_WRITE; - sc.nsects = 0; - sc.flags = 0; - - printf ("Writing segment %-16.16s @ %#8lx (%#8lx/%#8lx @ %#10lx)\n", - sc.segname, (long) (sc.fileoff), (long) (sc.filesize), - (long) (sc.vmsize), (long) (sc.vmaddr)); - - if (!unexec_write (sc.fileoff, (void *) sc.vmaddr, sc.filesize)) - unexec_error ("cannot write new __DATA segment"); - curr_file_offset += ROUNDUP_TO_PAGE_BOUNDARY (sc.filesize); - - if (!unexec_write (curr_header_offset, &sc, sc.cmdsize)) - unexec_error ("cannot write new __DATA segment's header"); - curr_header_offset += sc.cmdsize; - mh.ncmds++; - } -} - -/* Copy a LC_SYMTAB load command from the input file to the output - file, adjusting the file offset fields. */ -static void -copy_symtab (struct load_command *lc, long delta) -{ - struct symtab_command *stp = (struct symtab_command *) lc; - - stp->symoff += delta; - stp->stroff += delta; - - printf ("Writing LC_SYMTAB command\n"); - - if (!unexec_write (curr_header_offset, lc, lc->cmdsize)) - unexec_error ("cannot write symtab command to header"); - - curr_header_offset += lc->cmdsize; -} - -/* Fix up relocation entries. */ -static void -unrelocate (const char *name, off_t reloff, int nrel, vm_address_t base) -{ - int i, unreloc_count; - struct relocation_info reloc_info; - struct scattered_relocation_info *sc_reloc_info - = (struct scattered_relocation_info *) &reloc_info; - vm_address_t location; - - for (unreloc_count = 0, i = 0; i < nrel; i++) - { - if (lseek (infd, reloff, L_SET) != reloff) - unexec_error ("unrelocate: %s:%d cannot seek to reloc_info", name, i); - if (!unexec_read (&reloc_info, sizeof (reloc_info))) - unexec_error ("unrelocate: %s:%d cannot read reloc_info", name, i); - reloff += sizeof (reloc_info); - - if (sc_reloc_info->r_scattered == 0) - switch (reloc_info.r_type) - { - case GENERIC_RELOC_VANILLA: - location = base + reloc_info.r_address; - if (location >= data_segment_scp->vmaddr - && location < (data_segment_scp->vmaddr - + data_segment_scp->vmsize)) - { - off_t src_off = data_segment_old_fileoff - + (location - data_segment_scp->vmaddr); - off_t dst_off = data_segment_scp->fileoff - + (location - data_segment_scp->vmaddr); - - if (!unexec_copy (dst_off, src_off, 1 << reloc_info.r_length)) - unexec_error ("unrelocate: %s:%d cannot copy original value", - name, i); - unreloc_count++; - } - break; - default: - unexec_error ("unrelocate: %s:%d cannot handle type = %d", - name, i, reloc_info.r_type); - } - else - unexec_error ("unrelocate: %s:%d cannot handle scattered type = %d", - name, i, sc_reloc_info->r_type); - } - - if (nrel > 0) - printf ("Fixed up %d/%d %s relocation entries in data segment.\n", - unreloc_count, nrel, name); -} - -/* Copy a LC_DYSYMTAB load command from the input file to the output - file, adjusting the file offset fields. */ -static void -copy_dysymtab (struct load_command *lc, long delta) -{ - struct dysymtab_command *dstp = (struct dysymtab_command *) lc; - vm_address_t base; - -#ifdef _LP64 - /* First writable segment address. */ - base = data_segment_scp->vmaddr; -#else - /* First segment address in the file (unless MH_SPLIT_SEGS set). */ - base = 0; -#endif - - unrelocate ("local", dstp->locreloff, dstp->nlocrel, base); - unrelocate ("external", dstp->extreloff, dstp->nextrel, base); - - if (dstp->nextrel > 0) { - dstp->extreloff += delta; - } - - if (dstp->nlocrel > 0) { - dstp->locreloff += delta; - } - - if (dstp->nindirectsyms > 0) - dstp->indirectsymoff += delta; - - printf ("Writing LC_DYSYMTAB command\n"); - - if (!unexec_write (curr_header_offset, lc, lc->cmdsize)) - unexec_error ("cannot write symtab command to header"); - - curr_header_offset += lc->cmdsize; -} - -/* Copy a LC_TWOLEVEL_HINTS load command from the input file to the output - file, adjusting the file offset fields. */ -static void -copy_twolevelhints (struct load_command *lc, long delta) -{ - struct twolevel_hints_command *tlhp = (struct twolevel_hints_command *) lc; - - if (tlhp->nhints > 0) { - tlhp->offset += delta; - } - - printf ("Writing LC_TWOLEVEL_HINTS command\n"); - - if (!unexec_write (curr_header_offset, lc, lc->cmdsize)) - unexec_error ("cannot write two level hint command to header"); - - curr_header_offset += lc->cmdsize; -} - -#ifdef LC_DYLD_INFO -/* Copy a LC_DYLD_INFO(_ONLY) load command from the input file to the output - file, adjusting the file offset fields. */ -static void -copy_dyld_info (struct load_command *lc, long delta) -{ - struct dyld_info_command *dip = (struct dyld_info_command *) lc; - - if (dip->rebase_off > 0) - dip->rebase_off += delta; - if (dip->bind_off > 0) - dip->bind_off += delta; - if (dip->weak_bind_off > 0) - dip->weak_bind_off += delta; - if (dip->lazy_bind_off > 0) - dip->lazy_bind_off += delta; - if (dip->export_off > 0) - dip->export_off += delta; - - printf ("Writing "); - print_load_command_name (lc->cmd); - printf (" command\n"); - - if (!unexec_write (curr_header_offset, lc, lc->cmdsize)) - unexec_error ("cannot write dyld info command to header"); - - curr_header_offset += lc->cmdsize; -} -#endif - -#ifdef LC_FUNCTION_STARTS -/* Copy a LC_FUNCTION_STARTS/LC_DATA_IN_CODE/LC_DYLIB_CODE_SIGN_DRS - load command from the input file to the output file, adjusting the - data offset field. */ -static void -copy_linkedit_data (struct load_command *lc, long delta) -{ - struct linkedit_data_command *ldp = (struct linkedit_data_command *) lc; - - if (ldp->dataoff > 0) - ldp->dataoff += delta; - - printf ("Writing "); - print_load_command_name (lc->cmd); - printf (" command\n"); - - if (!unexec_write (curr_header_offset, lc, lc->cmdsize)) - unexec_error ("cannot write linkedit data command to header"); - - curr_header_offset += lc->cmdsize; -} -#endif - -/* Copy other kinds of load commands from the input file to the output - file, ones that do not require adjustments of file offsets. */ -static void -copy_other (struct load_command *lc) -{ - printf ("Writing "); - print_load_command_name (lc->cmd); - printf (" command\n"); - - if (!unexec_write (curr_header_offset, lc, lc->cmdsize)) - unexec_error ("cannot write symtab command to header"); - - curr_header_offset += lc->cmdsize; -} - -/* Loop through all load commands and dump them. Then write the Mach - header. */ -static void -dump_it (void) -{ - int i; - long linkedit_delta = 0; - - printf ("--- Load Commands written to Output File ---\n"); - - for (i = 0; i < nlc; i++) - switch (lca[i]->cmd) - { - case LC_SEGMENT: - { - struct segment_command *scp = (struct segment_command *) lca[i]; - if (strncmp (scp->segname, SEG_DATA, 16) == 0) - { - /* save data segment file offset and segment_command for - unrelocate */ - if (data_segment_old_fileoff) - unexec_error ("cannot handle multiple DATA segments" - " in input file"); - data_segment_old_fileoff = scp->fileoff; - data_segment_scp = scp; - - copy_data_segment (lca[i]); - } - else - { - if (strncmp (scp->segname, SEG_LINKEDIT, 16) == 0) - { - if (linkedit_delta) - unexec_error ("cannot handle multiple LINKEDIT segments" - " in input file"); - linkedit_delta = curr_file_offset - scp->fileoff; - } - - copy_segment (lca[i]); - } - } - break; - case LC_SYMTAB: - copy_symtab (lca[i], linkedit_delta); - break; - case LC_DYSYMTAB: - copy_dysymtab (lca[i], linkedit_delta); - break; - case LC_TWOLEVEL_HINTS: - copy_twolevelhints (lca[i], linkedit_delta); - break; -#ifdef LC_DYLD_INFO - case LC_DYLD_INFO: - case LC_DYLD_INFO_ONLY: - copy_dyld_info (lca[i], linkedit_delta); - break; -#endif -#ifdef LC_FUNCTION_STARTS - case LC_FUNCTION_STARTS: -#ifdef LC_DATA_IN_CODE - case LC_DATA_IN_CODE: -#endif -#ifdef LC_DYLIB_CODE_SIGN_DRS - case LC_DYLIB_CODE_SIGN_DRS: -#endif - copy_linkedit_data (lca[i], linkedit_delta); - break; -#endif - default: - copy_other (lca[i]); - break; - } - - if (curr_header_offset > text_seg_lowest_offset) - unexec_error ("not enough room for load commands for new __DATA segments" - " (increase headerpad_extra in configure.in to at least %lX)", - num_unexec_regions * sizeof (struct segment_command)); - - printf ("%ld unused bytes follow Mach-O header\n", - text_seg_lowest_offset - curr_header_offset); - - mh.sizeofcmds = curr_header_offset - sizeof (struct mach_header); - if (!unexec_write (0, &mh, sizeof (struct mach_header))) - unexec_error ("cannot write final header contents"); -} - -/* Take a snapshot of Emacs and make a Mach-O format executable file - from it. The file names of the output and input files are outfile - and infile, respectively. The three other parameters are - ignored. */ -void -unexec (const char *outfile, const char *infile) -{ - if (in_dumped_exec) - unexec_error ("Unexec from a dumped executable is not supported."); - - pagesize = getpagesize (); - infd = emacs_open (infile, O_RDONLY, 0); - if (infd < 0) - { - unexec_error ("%s: %s", infile, strerror (errno)); - } - - outfd = emacs_open (outfile, O_WRONLY | O_TRUNC | O_CREAT, 0777); - if (outfd < 0) - { - emacs_close (infd); - unexec_error ("%s: %s", outfile, strerror (errno)); - } - - build_region_list (); - read_load_commands (); - - find_emacs_zone_regions (); - unexec_regions_merge (); - - in_dumped_exec = 1; - - dump_it (); - - emacs_close (outfd); -} - - -void -unexec_init_emacs_zone (void) -{ - emacs_zone = malloc_create_zone (0, 0); - malloc_set_zone_name (emacs_zone, "EmacsZone"); -} - -#ifndef MACOSX_MALLOC_MULT16 -#define MACOSX_MALLOC_MULT16 1 -#endif - -typedef struct unexec_malloc_header { - union { - char c[8]; - size_t size; - } u; -} unexec_malloc_header_t; - -#if MACOSX_MALLOC_MULT16 - -#define ptr_in_unexec_regions(p) ((((vm_address_t) (p)) & 8) != 0) - -#else - -int -ptr_in_unexec_regions (void *ptr) -{ - int i; - - for (i = 0; i < num_unexec_regions; i++) - if ((vm_address_t) ptr - unexec_regions[i].range.address - < unexec_regions[i].range.size) - return 1; - - return 0; -} - -#endif - -void * -unexec_malloc (size_t size) -{ - if (in_dumped_exec) - { - void *p; - - p = malloc (size); -#if MACOSX_MALLOC_MULT16 - assert (((vm_address_t) p % 16) == 0); -#endif - return p; - } - else - { - unexec_malloc_header_t *ptr; - - ptr = (unexec_malloc_header_t *) - malloc_zone_malloc (emacs_zone, size + sizeof (unexec_malloc_header_t)); - ptr->u.size = size; - ptr++; -#if MACOSX_MALLOC_MULT16 - assert (((vm_address_t) ptr % 16) == 8); -#endif - return (void *) ptr; - } -} - -void * -unexec_realloc (void *old_ptr, size_t new_size) -{ - if (in_dumped_exec) - { - void *p; - - if (ptr_in_unexec_regions (old_ptr)) - { - size_t old_size = ((unexec_malloc_header_t *) old_ptr)[-1].u.size; - size_t size = new_size > old_size ? old_size : new_size; - - p = malloc (new_size); - if (size) - memcpy (p, old_ptr, size); - } - else - { - p = realloc (old_ptr, new_size); - } -#if MACOSX_MALLOC_MULT16 - assert (((vm_address_t) p % 16) == 0); -#endif - return p; - } - else - { - unexec_malloc_header_t *ptr; - - ptr = (unexec_malloc_header_t *) - malloc_zone_realloc (emacs_zone, (unexec_malloc_header_t *) old_ptr - 1, - new_size + sizeof (unexec_malloc_header_t)); - ptr->u.size = new_size; - ptr++; -#if MACOSX_MALLOC_MULT16 - assert (((vm_address_t) ptr % 16) == 8); -#endif - return (void *) ptr; - } -} - -void -unexec_free (void *ptr) -{ - if (ptr == NULL) - return; - if (in_dumped_exec) - { - if (!ptr_in_unexec_regions (ptr)) - free (ptr); - } - else - malloc_zone_free (emacs_zone, (unexec_malloc_header_t *) ptr - 1); -} diff --git a/src/unexsol.c b/src/unexsol.c deleted file mode 100644 index 0f84099d39e..00000000000 --- a/src/unexsol.c +++ /dev/null @@ -1,28 +0,0 @@ -/* Trivial unexec for Solaris. */ - -#include -#include "unexec.h" - -#include - -#include "lisp.h" -#include "buffer.h" -#include "coding.h" - -void -unexec (const char *new_name, const char *old_name) -{ - Lisp_Object data; - Lisp_Object errstring; - - if (! dldump (0, new_name, RTLD_MEMORY)) - return; - - data = list1 (build_string (new_name)); - synchronize_system_messages_locale (); - errstring = code_convert_string_norecord (build_string (dlerror ()), - Vlocale_coding_system, 0); - - xsignal (Qfile_error, - Fcons (build_string ("Cannot unexec"), Fcons (errstring, data))); -} diff --git a/src/unexw32.c b/src/unexw32.c deleted file mode 100644 index f0a910781cc..00000000000 --- a/src/unexw32.c +++ /dev/null @@ -1,684 +0,0 @@ -/* unexec for GNU Emacs on Windows NT. - Copyright (C) 1994, 2001-2024 Free Software Foundation, Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or (at -your option) any later version. - -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see . */ - -/* - Geoff Voelker (voelker@cs.washington.edu) 8-12-94 -*/ - -#include -#include "unexec.h" -#include "lisp.h" -#include "w32common.h" -#include "w32.h" - -#include -#include -#include -#include - -/* Include relevant definitions from IMAGEHLP.H, which can be found - in \\win32sdk\mstools\samples\image\include\imagehlp.h. */ - -PIMAGE_NT_HEADERS (__stdcall * pfnCheckSumMappedFile) (LPVOID BaseAddress, - DWORD FileLength, - LPDWORD HeaderSum, - LPDWORD CheckSum); - -extern char my_begdata[]; -extern char my_begbss[]; -extern char *my_begbss_static; - -#include "w32heap.h" - -void get_section_info (file_data *p_file); -void copy_executable_and_dump_data (file_data *, file_data *); -void dump_bss_and_heap (file_data *p_infile, file_data *p_outfile); - -/* Cached info about the .data section in the executable. */ -PIMAGE_SECTION_HEADER data_section; -PCHAR data_start = 0; -DWORD_PTR data_size = 0; - -/* Cached info about the .bss section in the executable. */ -PIMAGE_SECTION_HEADER bss_section; -PCHAR bss_start = 0; -DWORD_PTR bss_size = 0; -DWORD_PTR extra_bss_size = 0; -/* bss data that is static might be discontiguous from non-static. */ -PIMAGE_SECTION_HEADER bss_section_static; -PCHAR bss_start_static = 0; -DWORD_PTR bss_size_static = 0; -DWORD_PTR extra_bss_size_static = 0; - -/* File handling. */ - -/* Implementation note: this and the next functions work with ANSI - codepage encoded file names! */ - -int -open_output_file (file_data *p_file, char *filename, unsigned long size) -{ - HANDLE file; - HANDLE file_mapping; - void *file_base; - - /* We delete any existing FILENAME because loadup.el will create a - hard link to it under the name emacs-XX.YY.ZZ.nn.exe. Evidently, - overwriting a file on Unix breaks any hard links to it, but that - doesn't happen on Windows. If we don't delete the file before - creating it, all the emacs-XX.YY.ZZ.nn.exe end up being hard - links to the same file, which defeats the purpose of these hard - links: being able to run previous builds. */ - DeleteFileA (filename); - file = CreateFileA (filename, GENERIC_READ | GENERIC_WRITE, 0, NULL, - CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0); - if (file == INVALID_HANDLE_VALUE) - return FALSE; - - file_mapping = CreateFileMapping (file, NULL, PAGE_READWRITE, - 0, size, NULL); - if (!file_mapping) - return FALSE; - - file_base = MapViewOfFile (file_mapping, FILE_MAP_WRITE, 0, 0, size); - if (file_base == 0) - return FALSE; - - p_file->name = filename; - p_file->size = size; - p_file->file = file; - p_file->file_mapping = file_mapping; - p_file->file_base = file_base; - - return TRUE; -} - - -/* Routines to manipulate NT executable file sections. */ - -/* Return pointer to section header for named section. */ -IMAGE_SECTION_HEADER * -find_section (const char * name, IMAGE_NT_HEADERS * nt_header) -{ - PIMAGE_SECTION_HEADER section; - int i; - - section = IMAGE_FIRST_SECTION (nt_header); - - for (i = 0; i < nt_header->FileHeader.NumberOfSections; i++) - { - if (strcmp ((char *)section->Name, name) == 0) - return section; - section++; - } - return NULL; -} - -#if 0 /* unused */ -/* Return pointer to section header for section containing the given - offset in its raw data area. */ -static IMAGE_SECTION_HEADER * -offset_to_section (DWORD_PTR offset, IMAGE_NT_HEADERS * nt_header) -{ - PIMAGE_SECTION_HEADER section; - int i; - - section = IMAGE_FIRST_SECTION (nt_header); - - for (i = 0; i < nt_header->FileHeader.NumberOfSections; i++) - { - if (offset >= section->PointerToRawData - && offset < section->PointerToRawData + section->SizeOfRawData) - return section; - section++; - } - return NULL; -} -#endif - -/* Return offset to an object in dst, given offset in src. We assume - there is at least one section in both src and dst images, and that - the some sections may have been added to dst (after sections in src). */ -static DWORD_PTR -relocate_offset (DWORD_PTR offset, - IMAGE_NT_HEADERS * src_nt_header, - IMAGE_NT_HEADERS * dst_nt_header) -{ - PIMAGE_SECTION_HEADER src_section = IMAGE_FIRST_SECTION (src_nt_header); - PIMAGE_SECTION_HEADER dst_section = IMAGE_FIRST_SECTION (dst_nt_header); - int i = 0; - - while (offset >= src_section->PointerToRawData) - { - if (offset < src_section->PointerToRawData + src_section->SizeOfRawData) - break; - i++; - if (i == src_nt_header->FileHeader.NumberOfSections) - { - /* Handle offsets after the last section. */ - dst_section = IMAGE_FIRST_SECTION (dst_nt_header); - dst_section += dst_nt_header->FileHeader.NumberOfSections - 1; - while (dst_section->PointerToRawData == 0) - dst_section--; - while (src_section->PointerToRawData == 0) - src_section--; - return offset - + (dst_section->PointerToRawData + dst_section->SizeOfRawData) - - (src_section->PointerToRawData + src_section->SizeOfRawData); - } - src_section++; - dst_section++; - } - return offset + - (dst_section->PointerToRawData - src_section->PointerToRawData); -} - -#define RVA_TO_OFFSET(rva, section) \ - ((section)->PointerToRawData + ((DWORD_PTR)(rva) - (section)->VirtualAddress)) - -#define RVA_TO_SECTION_OFFSET(rva, section) \ - ((DWORD_PTR)(rva) - (section)->VirtualAddress) - -/* Convert address in executing image to RVA. */ -#define PTR_TO_RVA(ptr) ((DWORD_PTR)(ptr) - (DWORD_PTR) GetModuleHandle (NULL)) - -#define PTR_TO_OFFSET(ptr, pfile_data) \ - ((unsigned char *)(ptr) - (pfile_data)->file_base) - -#define OFFSET_TO_PTR(offset, pfile_data) \ - ((pfile_data)->file_base + (DWORD_PTR)(offset)) - -#if 0 /* unused */ -#define OFFSET_TO_RVA(offset, section) \ - ((section)->VirtualAddress + ((DWORD_PTR)(offset) - (section)->PointerToRawData)) - -#define RVA_TO_PTR(var,section,filedata) \ - ((unsigned char *)(RVA_TO_OFFSET (var,section) + (filedata).file_base)) -#endif - - -/* Flip through the executable and cache the info necessary for dumping. */ -void -get_section_info (file_data *p_infile) -{ - PIMAGE_DOS_HEADER dos_header; - PIMAGE_NT_HEADERS nt_header; - int overlap; - - dos_header = (PIMAGE_DOS_HEADER) p_infile->file_base; - if (dos_header->e_magic != IMAGE_DOS_SIGNATURE) - { - printf ("Unknown EXE header in %s...bailing.\n", p_infile->name); - exit (1); - } - nt_header = (PIMAGE_NT_HEADERS) (((DWORD_PTR) dos_header) + - dos_header->e_lfanew); - if (nt_header == NULL) - { - printf ("Failed to find IMAGE_NT_HEADER in %s...bailing.\n", - p_infile->name); - exit (1); - } - - /* Check the NT header signature ... */ - if (nt_header->Signature != IMAGE_NT_SIGNATURE) - { - printf ("Invalid IMAGE_NT_SIGNATURE 0x%lx in %s...bailing.\n", - nt_header->Signature, p_infile->name); - exit (1); - } - - /* Locate the ".data" and ".bss" sections for Emacs. (Note that the - actual section names are probably different from these, and might - actually be the same section.) - - We do this as follows: first we determine the virtual address - ranges in this process for the data and bss variables that we wish - to preserve. Then we map these VAs to the section entries in the - source image. Finally, we determine the new size of the raw data - area for the bss section, so we can make the new image the correct - size. */ - - /* We arrange for the Emacs initialized data to be in a separate - section if possible, because we cannot rely on my_begdata and - my_edata marking out the full extent of the initialized data, at - least on the Alpha where the linker freely reorders variables - across libraries. If we can arrange for this, all we need to do is - find the start and size of the EMDATA section. */ - data_section = find_section ("EMDATA", nt_header); - if (data_section) - { - data_start = (char *) nt_header->OptionalHeader.ImageBase + - data_section->VirtualAddress; - data_size = data_section->Misc.VirtualSize; - } - else - { - /* Fallback on the old method if compiler doesn't support the - data_set #pragma (or its equivalent). */ - data_start = my_begdata; - data_size = my_edata - my_begdata; - data_section = rva_to_section (PTR_TO_RVA (my_begdata), nt_header); - if (data_section != rva_to_section (PTR_TO_RVA (my_edata), nt_header)) - { - printf ("Initialized data is not in a single section...bailing\n"); - exit (1); - } - } - - /* As noted in lastfile.c, the Alpha (but not the Intel) MSVC linker - globally segregates all static and public bss data (ie. across all - linked modules, not just per module), so we must take both static - and public bss areas into account to determine the true extent of - the bss area used by Emacs. - - To be strictly correct, we dump the static and public bss areas - used by Emacs separately if non-overlapping (since otherwise we are - dumping bss data belonging to system libraries, eg. the static bss - system data on the Alpha). */ - - bss_start = my_begbss; - bss_size = my_endbss - my_begbss; - bss_section = rva_to_section (PTR_TO_RVA (my_begbss), nt_header); - if (bss_section != rva_to_section (PTR_TO_RVA (my_endbss), nt_header)) - { - printf ("Uninitialized data is not in a single section...bailing\n"); - exit (1); - } - /* Compute how much the .bss section's raw data will grow. */ - extra_bss_size = - ROUND_UP (RVA_TO_SECTION_OFFSET (PTR_TO_RVA (my_endbss), bss_section), - nt_header->OptionalHeader.FileAlignment) - - bss_section->SizeOfRawData; - - bss_start_static = my_begbss_static; - bss_size_static = my_endbss_static - my_begbss_static; - bss_section_static = rva_to_section (PTR_TO_RVA (my_begbss_static), nt_header); - if (bss_section_static != rva_to_section (PTR_TO_RVA (my_endbss_static), nt_header)) - { - printf ("Uninitialized static data is not in a single section...bailing\n"); - exit (1); - } - /* Compute how much the static .bss section's raw data will grow. */ - extra_bss_size_static = - ROUND_UP (RVA_TO_SECTION_OFFSET (PTR_TO_RVA (my_endbss_static), bss_section_static), - nt_header->OptionalHeader.FileAlignment) - - bss_section_static->SizeOfRawData; - - /* Combine the bss sections into one if they overlap. */ -#ifdef _ALPHA_ - overlap = 1; /* force all bss data to be dumped */ -#else - overlap = 0; -#endif - if (bss_start < bss_start_static) - { - if (bss_start_static < bss_start + bss_size) - overlap = 1; - } - else - { - if (bss_start < bss_start_static + bss_size_static) - overlap = 1; - } - if (overlap) - { - if (bss_section != bss_section_static) - { - printf ("BSS data not in a single section...bailing\n"); - exit (1); - } - bss_start = min (bss_start, bss_start_static); - bss_size = max (my_endbss, my_endbss_static) - bss_start; - bss_section_static = 0; - extra_bss_size = max (extra_bss_size, extra_bss_size_static); - extra_bss_size_static = 0; - } -} - -/* Format to print a DWORD_PTR value. */ -#if defined MINGW_W64 && defined _WIN64 -# define pDWP "16llx" -#else -# define pDWP "08lx" -#endif - -/* The dump routines. */ - -void -copy_executable_and_dump_data (file_data *p_infile, - file_data *p_outfile) -{ - unsigned char *dst, *dst_save; - PIMAGE_DOS_HEADER dos_header; - PIMAGE_NT_HEADERS nt_header; - PIMAGE_NT_HEADERS dst_nt_header; - PIMAGE_SECTION_HEADER section; - PIMAGE_SECTION_HEADER dst_section; - DWORD_PTR offset; - int i; - int be_verbose = GetEnvironmentVariable ("DEBUG_DUMP", NULL, 0) > 0; - -#define COPY_CHUNK(message, src, size, verbose) \ - do { \ - unsigned char *s = (void *)(src); \ - DWORD_PTR count = (size); \ - if (verbose) \ - { \ - printf ("%s\n", (message)); \ - printf ("\t0x%"pDWP" Offset in input file.\n", (DWORD_PTR)(s - p_infile->file_base)); \ - printf ("\t0x%"pDWP" Offset in output file.\n", (DWORD_PTR)(dst - p_outfile->file_base)); \ - printf ("\t0x%"pDWP" Size in bytes.\n", count); \ - } \ - memcpy (dst, s, count); \ - dst += count; \ - } while (0) - -#define COPY_PROC_CHUNK(message, src, size, verbose) \ - do { \ - unsigned char *s = (void *)(src); \ - DWORD_PTR count = (size); \ - if (verbose) \ - { \ - printf ("%s\n", (message)); \ - printf ("\t0x%p Address in process.\n", s); \ - printf ("\t0x%p Base output file.\n", p_outfile->file_base); \ - printf ("\t0x%"pDWP" Offset in output file.\n", (DWORD_PTR)(dst - p_outfile->file_base)); \ - printf ("\t0x%p Address in output file.\n", dst); \ - printf ("\t0x%"pDWP" Size in bytes.\n", count); \ - } \ - memcpy (dst, s, count); \ - dst += count; \ - } while (0) - -#define DST_TO_OFFSET() PTR_TO_OFFSET (dst, p_outfile) -#define ROUND_UP_DST(align) \ - (dst = p_outfile->file_base + ROUND_UP (DST_TO_OFFSET (), (align))) -#define ROUND_UP_DST_AND_ZERO(align) \ - do { \ - unsigned char *newdst = p_outfile->file_base \ - + ROUND_UP (DST_TO_OFFSET (), (align)); \ - /* Zero the alignment slop; it may actually initialize real data. */ \ - memset (dst, 0, newdst - dst); \ - dst = newdst; \ - } while (0) - - /* Copy the source image sequentially, ie. section by section after - copying the headers and section table, to simplify the process of - dumping the raw data for the bss and heap sections. - - Note that dst is updated implicitly by each COPY_CHUNK. */ - - dos_header = (PIMAGE_DOS_HEADER) p_infile->file_base; - nt_header = (PIMAGE_NT_HEADERS) (((DWORD_PTR) dos_header) + - dos_header->e_lfanew); - section = IMAGE_FIRST_SECTION (nt_header); - - dst = (unsigned char *) p_outfile->file_base; - - COPY_CHUNK ("Copying DOS header...", dos_header, - (DWORD_PTR) nt_header - (DWORD_PTR) dos_header, be_verbose); - dst_nt_header = (PIMAGE_NT_HEADERS) dst; - COPY_CHUNK ("Copying NT header...", nt_header, - (DWORD_PTR) section - (DWORD_PTR) nt_header, be_verbose); - dst_section = (PIMAGE_SECTION_HEADER) dst; - COPY_CHUNK ("Copying section table...", section, - nt_header->FileHeader.NumberOfSections * sizeof (*section), - be_verbose); - - /* Align the first section's raw data area, and set the header size - field accordingly. */ - ROUND_UP_DST_AND_ZERO (dst_nt_header->OptionalHeader.FileAlignment); - dst_nt_header->OptionalHeader.SizeOfHeaders = DST_TO_OFFSET (); - - for (i = 0; i < nt_header->FileHeader.NumberOfSections; i++) - { - char msg[100]; - /* Windows section names are fixed 8-char strings, only - zero-terminated if the name is shorter than 8 characters. */ - sprintf (msg, "Copying raw data for %.8s...", section->Name); - - dst_save = dst; - - /* Update the file-relative offset for this section's raw data (if - it has any) in case things have been relocated; we will update - the other offsets below once we know where everything is. */ - if (dst_section->PointerToRawData) - dst_section->PointerToRawData = DST_TO_OFFSET (); - - /* Can always copy the original raw data. */ - COPY_CHUNK - (msg, OFFSET_TO_PTR (section->PointerToRawData, p_infile), - section->SizeOfRawData, be_verbose); - /* Ensure alignment slop is zeroed. */ - ROUND_UP_DST_AND_ZERO (dst_nt_header->OptionalHeader.FileAlignment); - - /* Note that various sections below may be aliases. */ - if (section == data_section) - { - dst = dst_save - + RVA_TO_SECTION_OFFSET (PTR_TO_RVA (data_start), dst_section); - COPY_PROC_CHUNK ("Dumping initialized data...", - data_start, data_size, be_verbose); - dst = dst_save + dst_section->SizeOfRawData; - } - if (section == bss_section) - { - /* Dump contents of bss variables, adjusting the section's raw - data size as necessary. */ - dst = dst_save - + RVA_TO_SECTION_OFFSET (PTR_TO_RVA (bss_start), dst_section); - COPY_PROC_CHUNK ("Dumping bss data...", bss_start, - bss_size, be_verbose); - ROUND_UP_DST (dst_nt_header->OptionalHeader.FileAlignment); - dst_section->PointerToRawData = PTR_TO_OFFSET (dst_save, p_outfile); - /* Determine new size of raw data area. */ - dst = max (dst, dst_save + dst_section->SizeOfRawData); - dst_section->SizeOfRawData = dst - dst_save; - dst_section->Characteristics &= ~IMAGE_SCN_CNT_UNINITIALIZED_DATA; - dst_section->Characteristics |= IMAGE_SCN_CNT_INITIALIZED_DATA; - } - if (section == bss_section_static) - { - /* Dump contents of static bss variables, adjusting the - section's raw data size as necessary. */ - dst = dst_save - + RVA_TO_SECTION_OFFSET (PTR_TO_RVA (bss_start_static), dst_section); - COPY_PROC_CHUNK ("Dumping static bss data...", bss_start_static, - bss_size_static, be_verbose); - ROUND_UP_DST (dst_nt_header->OptionalHeader.FileAlignment); - dst_section->PointerToRawData = PTR_TO_OFFSET (dst_save, p_outfile); - /* Determine new size of raw data area. */ - dst = max (dst, dst_save + dst_section->SizeOfRawData); - dst_section->SizeOfRawData = dst - dst_save; - dst_section->Characteristics &= ~IMAGE_SCN_CNT_UNINITIALIZED_DATA; - dst_section->Characteristics |= IMAGE_SCN_CNT_INITIALIZED_DATA; - } - - /* Align the section's raw data area. */ - ROUND_UP_DST (dst_nt_header->OptionalHeader.FileAlignment); - - section++; - dst_section++; - } - - /* Copy remainder of source image. */ - do - section--; - while (section->PointerToRawData == 0); - offset = ROUND_UP (section->PointerToRawData + section->SizeOfRawData, - nt_header->OptionalHeader.FileAlignment); - COPY_CHUNK - ("Copying remainder of executable...", - OFFSET_TO_PTR (offset, p_infile), - p_infile->size - offset, be_verbose); - - /* Final size for new image. */ - p_outfile->size = DST_TO_OFFSET (); - - /* Now patch up remaining file-relative offsets. */ - section = IMAGE_FIRST_SECTION (nt_header); - dst_section = IMAGE_FIRST_SECTION (dst_nt_header); - -#define ADJUST_OFFSET(var) \ - do { \ - if ((var) != 0) \ - (var) = relocate_offset ((var), nt_header, dst_nt_header); \ - } while (0) - - dst_nt_header->OptionalHeader.SizeOfInitializedData = 0; - dst_nt_header->OptionalHeader.SizeOfUninitializedData = 0; - for (i = 0; i < dst_nt_header->FileHeader.NumberOfSections; i++) - { - /* Recompute data sizes for completeness. */ - if (dst_section[i].Characteristics & IMAGE_SCN_CNT_INITIALIZED_DATA) - dst_nt_header->OptionalHeader.SizeOfInitializedData += - ROUND_UP (dst_section[i].Misc.VirtualSize, dst_nt_header->OptionalHeader.FileAlignment); - else if (dst_section[i].Characteristics & IMAGE_SCN_CNT_UNINITIALIZED_DATA) - dst_nt_header->OptionalHeader.SizeOfUninitializedData += - ROUND_UP (dst_section[i].Misc.VirtualSize, dst_nt_header->OptionalHeader.FileAlignment); - - ADJUST_OFFSET (dst_section[i].PointerToLinenumbers); - } - - ADJUST_OFFSET (dst_nt_header->FileHeader.PointerToSymbolTable); - - /* Update offsets in debug directory entries. */ - { - IMAGE_DATA_DIRECTORY debug_dir = - dst_nt_header->OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_DEBUG]; - PIMAGE_DEBUG_DIRECTORY debug_entry; - - section = rva_to_section (debug_dir.VirtualAddress, dst_nt_header); - if (section) - { - debug_entry = (PIMAGE_DEBUG_DIRECTORY) - (RVA_TO_OFFSET (debug_dir.VirtualAddress, section) + p_outfile->file_base); - debug_dir.Size /= sizeof (IMAGE_DEBUG_DIRECTORY); - - for (i = 0; i < debug_dir.Size; i++, debug_entry++) - ADJUST_OFFSET (debug_entry->PointerToRawData); - } - } -} - - -/* Dump out .data and .bss sections into a new executable. */ -void -unexec (const char *new_name, const char *old_name) -{ - file_data in_file, out_file; - char out_filename[MAX_PATH], in_filename[MAX_PATH], new_name_a[MAX_PATH]; - unsigned long size; - char *p; - char *q; - - /* Ignore old_name, and get our actual location from the OS. */ - if (!GetModuleFileNameA (NULL, in_filename, MAX_PATH)) - abort (); - - /* Can't use dostounix_filename here, since that needs its file name - argument encoded in UTF-8. */ - for (p = in_filename; *p; p = CharNextA (p)) - if (*p == '\\') - *p = '/'; - - strcpy (out_filename, in_filename); - filename_to_ansi (new_name, new_name_a); - - /* Change the base of the output filename to match the requested name. */ - if ((p = strrchr (out_filename, '/')) == NULL) - abort (); - /* The filenames have already been expanded, and will be in Unix - format, so it is safe to expect an absolute name. */ - if ((q = strrchr (new_name_a, '/')) == NULL) - abort (); - strcpy (p, q); - -#ifdef ENABLE_CHECKING - report_temacs_memory_usage (); -#endif - - /* Make sure that the output filename has the ".exe" extension...patch - it up if not. */ - p = out_filename + strlen (out_filename) - 4; - if (strcmp (p, ".exe")) - strcat (out_filename, ".exe"); - - printf ("Dumping from %s\n", in_filename); - printf (" to %s\n", out_filename); - - /* Open the undumped executable file. */ - if (!open_input_file (&in_file, in_filename)) - { - printf ("Failed to open %s (%lu)...bailing.\n", - in_filename, GetLastError ()); - exit (1); - } - - /* Get the interesting section info, like start and size of .bss... */ - get_section_info (&in_file); - - /* The size of the dumped executable is the size of the original - executable plus the size of the heap and the size of the .bss section. */ - size = in_file.size + - extra_bss_size + - extra_bss_size_static; - if (!open_output_file (&out_file, out_filename, size)) - { - printf ("Failed to open %s (%lu)...bailing.\n", - out_filename, GetLastError ()); - exit (1); - } - - copy_executable_and_dump_data (&in_file, &out_file); - - /* Patch up header fields; profiler is picky about this. */ - { - PIMAGE_DOS_HEADER dos_header; - PIMAGE_NT_HEADERS nt_header; - HANDLE hImagehelp = LoadLibrary ("imagehlp.dll"); - DWORD headersum; - DWORD checksum; - - dos_header = (PIMAGE_DOS_HEADER) out_file.file_base; - nt_header = (PIMAGE_NT_HEADERS) ((char *) dos_header + dos_header->e_lfanew); - - nt_header->OptionalHeader.CheckSum = 0; - /* nt_header->FileHeader.TimeDateStamp = time (NULL); */ - /* dos_header->e_cp = size / 512; */ - /* nt_header->OptionalHeader.SizeOfImage = size; */ - - pfnCheckSumMappedFile = (void *) GetProcAddress (hImagehelp, "CheckSumMappedFile"); - if (pfnCheckSumMappedFile) - { - /* nt_header->FileHeader.TimeDateStamp = time (NULL); */ - pfnCheckSumMappedFile (out_file.file_base, - out_file.size, - &headersum, - &checksum); - nt_header->OptionalHeader.CheckSum = checksum; - } - FreeLibrary (hImagehelp); - } - - close_file_data (&in_file); - close_file_data (&out_file); -} - -/* eof */