------------------------------------------------------------ revno: 117175 committer: Dmitry Antipov branch nick: trunk timestamp: Wed 2014-05-28 12:00:10 +0400 message: On X, always make pointer visible when deleting frame (Bug#17609). * frame.c (frame_make_pointer_visible, frame_make_pointer_invisible): Pass frame as arg. * frame.h (frame_make_pointer_visible, frame_make_pointer_invisible): Adjust prototypes. * cmds.c (Fself_insert_command): Use SELECTED_FRAME. * keyboard.c (gobble_input): If there is no terminal input error, make sure the pointer is visible for all frames on this terminal. * xterm.c (x_free_frame_resources): Always enable pointer visibility. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2014-05-28 00:50:44 +0000 +++ src/ChangeLog 2014-05-28 08:00:10 +0000 @@ -1,3 +1,15 @@ +2014-05-28 Dmitry Antipov + + On X, always make pointer visible when deleting frame (Bug#17609). + * frame.c (frame_make_pointer_visible, frame_make_pointer_invisible): + Pass frame as arg. + * frame.h (frame_make_pointer_visible, frame_make_pointer_invisible): + Adjust prototypes. + * cmds.c (Fself_insert_command): Use SELECTED_FRAME. + * keyboard.c (gobble_input): If there is no terminal input error, + make sure the pointer is visible for all frames on this terminal. + * xterm.c (x_free_frame_resources): Always enable pointer visibility. + 2014-05-28 Stefan Monnier * data.c (Fzerop): Move to Elisp. === modified file 'src/cmds.c' --- src/cmds.c 2014-03-04 03:14:11 +0000 +++ src/cmds.c 2014-05-28 08:00:10 +0000 @@ -315,7 +315,7 @@ int val = internal_self_insert (character, XFASTINT (n)); if (val == 2) nonundocount = 0; - frame_make_pointer_invisible (); + frame_make_pointer_invisible (SELECTED_FRAME ()); } return Qnil; === modified file 'src/frame.c' --- src/frame.c 2014-04-03 20:46:04 +0000 +++ src/frame.c 2014-05-28 08:00:10 +0000 @@ -4373,16 +4373,11 @@ #endif /* HAVE_WINDOW_SYSTEM */ void -frame_make_pointer_invisible (void) +frame_make_pointer_invisible (struct frame *f) { if (! NILP (Vmake_pointer_invisible)) { - struct frame *f; - if (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame))) - return; - - f = SELECTED_FRAME (); - if (f && !f->pointer_invisible + if (f && FRAME_LIVE_P (f) && !f->pointer_invisible && FRAME_TERMINAL (f)->toggle_invisible_pointer_hook) { f->mouse_moved = 0; @@ -4393,17 +4388,11 @@ } void -frame_make_pointer_visible (void) +frame_make_pointer_visible (struct frame *f) { /* We don't check Vmake_pointer_invisible here in case the pointer was invisible when Vmake_pointer_invisible was set to nil. */ - struct frame *f; - - if (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame))) - return; - - f = SELECTED_FRAME (); - if (f && f->pointer_invisible && f->mouse_moved + if (f && FRAME_LIVE_P (f) && f->pointer_invisible && f->mouse_moved && FRAME_TERMINAL (f)->toggle_invisible_pointer_hook) { FRAME_TERMINAL (f)->toggle_invisible_pointer_hook (f, 0); === modified file 'src/frame.h' --- src/frame.h 2014-04-04 16:59:50 +0000 +++ src/frame.h 2014-05-28 08:00:10 +0000 @@ -995,8 +995,8 @@ #endif /* HAVE_WINDOW_SYSTEM */ extern bool window_system_available (struct frame *); extern void check_window_system (struct frame *); -extern void frame_make_pointer_invisible (void); -extern void frame_make_pointer_visible (void); +extern void frame_make_pointer_invisible (struct frame *); +extern void frame_make_pointer_visible (struct frame *); extern Lisp_Object delete_frame (Lisp_Object, Lisp_Object); extern Lisp_Object Vframe_list; === modified file 'src/keyboard.c' --- src/keyboard.c 2014-05-28 00:50:44 +0000 +++ src/keyboard.c 2014-05-28 08:00:10 +0000 @@ -6877,6 +6877,20 @@ } } + /* If there was no error, make sure the pointer + is visible for all frames on this terminal. */ + if (nr >= 0) + { + Lisp_Object tail, frame; + + FOR_EACH_FRAME (tail, frame) + { + struct frame *f = XFRAME (frame); + if (FRAME_TERMINAL (f) == t) + frame_make_pointer_visible (f); + } + } + if (hold_quit.kind != NO_EVENT) kbd_buffer_store_event (&hold_quit); } @@ -6887,8 +6901,6 @@ if (err && !nread) nread = -1; - frame_make_pointer_visible (); - return nread; } === modified file 'src/xterm.c' --- src/xterm.c 2014-05-14 13:55:37 +0000 +++ src/xterm.c 2014-05-28 08:00:10 +0000 @@ -9233,6 +9233,10 @@ commands to the X server. */ if (dpyinfo->display) { + /* Always exit with visible pointer to avoid weird issue + with Xfixes (Bug#17609). */ + FRAME_DISPLAY_INFO (f)->toggle_visible_pointer (f, 0); + /* We must free faces before destroying windows because some font-driver (e.g. xft) access a window while finishing a face. */ ------------------------------------------------------------ revno: 117174 committer: Glenn Morris branch nick: trunk timestamp: Tue 2014-05-27 23:51:36 -0700 message: * lisp/subr.el (zerop): Move later so bootstrap works. diff: === modified file 'lisp/subr.el' --- lisp/subr.el 2014-05-28 00:50:44 +0000 +++ lisp/subr.el 2014-05-28 06:51:36 +0000 @@ -335,12 +335,6 @@ (and (consp object) (eq (car object) 'frame-configuration))) -(defun zerop (number) - "Return t if NUMBER is zero." - ;; Used to be in C, but it's pointless since (= 0 n) is faster anyway because - ;; = has a byte-code. - (declare (compiler-macro (lambda (_) `(= 0 ,number)))) - (= 0 number)) ;;;; List functions. @@ -389,6 +383,13 @@ (if (> n 0) (setcdr (nthcdr (- (1- m) n) list) nil)) list)))) +(defun zerop (number) + "Return t if NUMBER is zero." + ;; Used to be in C, but it's pointless since (= 0 n) is faster anyway because + ;; = has a byte-code. + (declare (compiler-macro (lambda (_) `(= 0 ,number)))) + (= 0 number)) + (defun delete-dups (list) "Destructively remove `equal' duplicates from LIST. Store the result in LIST and return it. LIST must be a proper list. ------------------------------------------------------------ revno: 117173 fixes bug: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=17608 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2014-05-27 21:12:04 -0400 message: * lisp/progmodes/hideshow.el (hs-hide-all): Call syntax-propertize. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-05-28 01:00:44 +0000 +++ lisp/ChangeLog 2014-05-28 01:12:04 +0000 @@ -1,3 +1,8 @@ +2014-05-28 Stefan Monnier + + * progmodes/hideshow.el (hs-hide-all): Call syntax-propertize + (bug#17608). + 2014-05-21 Michal Nazarewicz * textmodes/tildify.el (tildify-buffer, tildify-region): === modified file 'lisp/progmodes/hideshow.el' --- lisp/progmodes/hideshow.el 2014-01-01 07:43:34 +0000 +++ lisp/progmodes/hideshow.el 2014-05-28 01:12:04 +0000 @@ -789,6 +789,7 @@ (unless hs-allow-nesting (hs-discard-overlays (point-min) (point-max))) (goto-char (point-min)) + (syntax-propertize (point-max)) (let ((spew (make-progress-reporter "Hiding all blocks..." (point-min) (point-max))) (re (concat "\\(" ------------------------------------------------------------ revno: 117172 fixes bug: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=17547 author: Michal Nazarewicz committer: Stefan Monnier branch nick: trunk timestamp: Tue 2014-05-27 21:00:44 -0400 message: * test/automated/tildify-tests.el: New file. * lisp/textmodes/tildify.el (tildify-buffer, tildify-region): Add dont-ask option. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-05-28 00:50:44 +0000 +++ lisp/ChangeLog 2014-05-28 01:00:44 +0000 @@ -1,3 +1,8 @@ +2014-05-21 Michal Nazarewicz + + * textmodes/tildify.el (tildify-buffer, tildify-region): + Add dont-ask option. + 2014-05-28 Stefan Monnier * subr.el (zerop): Move from C. Add compiler-macro (bug#17475). === modified file 'lisp/textmodes/tildify.el' --- lisp/textmodes/tildify.el 2014-01-01 07:43:34 +0000 +++ lisp/textmodes/tildify.el 2014-05-28 01:00:44 +0000 @@ -3,7 +3,7 @@ ;; Copyright (C) 1997-2014 Free Software Foundation, Inc. ;; Author: Milan Zamazal -;; Version: 4.5 +;; Version: 4.5.1 ;; Keywords: text, TeX, SGML, wp ;; This file is part of GNU Emacs. @@ -172,20 +172,22 @@ ;;; *** Interactive functions *** ;;;###autoload -(defun tildify-region (beg end) +(defun tildify-region (beg end &optional dont-ask) "Add hard spaces in the region between BEG and END. See variables `tildify-pattern-alist', `tildify-string-alist', and `tildify-ignored-environments-alist' for information about configuration parameters. -This function performs no refilling of the changed text." - (interactive "*r") +This function performs no refilling of the changed text. +If DONT-ASK is set, or called interactively with prefix argument, user +won't be prompted for confirmation of each substitution." + (interactive "*rP") (setq tildify-count 0) (let (a z (marker-end (copy-marker end)) end-env finish - (ask t) + (ask (not dont-ask)) (case-fold-search nil) (regexp (tildify-build-regexp)) ; beginnings of environments aux) @@ -226,14 +228,16 @@ (message "%d spaces replaced." tildify-count)) ;;;###autoload -(defun tildify-buffer () +(defun tildify-buffer (&optional dont-ask) "Add hard spaces in the current buffer. See variables `tildify-pattern-alist', `tildify-string-alist', and `tildify-ignored-environments-alist' for information about configuration parameters. -This function performs no refilling of the changed text." - (interactive "*") - (tildify-region (point-min) (point-max))) +This function performs no refilling of the changed text. +If DONT-ASK is set, or called interactively with prefix argument, user +won't be prompted for confirmation of each substitution." + (interactive "*P") + (tildify-region (point-min) (point-max) dont-ask)) ;;; *** Auxiliary functions *** === modified file 'test/ChangeLog' --- test/ChangeLog 2014-05-27 14:28:07 +0000 +++ test/ChangeLog 2014-05-28 01:00:44 +0000 @@ -1,3 +1,7 @@ +2014-05-21 Michal Nazarewicz + + * automated/tildify-tests.el: New file. + 2014-05-27 Stefan Monnier * indent/ruby.rb: Add one more test. === added file 'test/automated/tildify-tests.el' --- test/automated/tildify-tests.el 1970-01-01 00:00:00 +0000 +++ test/automated/tildify-tests.el 2014-05-28 01:00:44 +0000 @@ -0,0 +1,106 @@ +;;; tildify-test.el --- ERT tests for teldify.el + +;; Copyright (C) 2014 Free Software Foundation, Inc. + +;; Author: Michal Nazarewicz +;; Version: 4.5 +;; Keywords: text, TeX, SGML, wp + +;; 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 . + +;;; Commentary: + +;; This package defines regression tests for the tildify package. + +;;; Code: + +(require 'ert) +(require 'tildify) + +(defun tildify-test--example-sentence (space) + "Return an example sentence with SPACE where hard space is required." + (concat "Lorem ipsum v" space "dolor sit amet, a" space + "consectetur adipiscing elit.")) + + +(defun tildify-test--example-html (sentence &optional with-nbsp) + "Return an example HTML code. +SENTENCE is placed where spaces should not be replaced with hard spaces, and +WITH-NBSP is placed where spaces should be replaced with hard spaces. If the +latter is missing, SENTENCE will be used in all placeholder positions." + (let ((with-nbsp (or with-nbsp sentence))) + (concat "

" with-nbsp "

\n" + "
" sentence "
\n" + "\n" + "

" with-nbsp "

\n" + "<" sentence ">\n"))) + + +(defun tildify-test--test (modes input expected) + "Test tildify running in MODES. +INPUT is the initial content of the buffer and EXPECTED is expected result +after `tildify-buffer' is run." + (dolist (mode modes) + (with-temp-buffer + (funcall mode) + (let ((header (concat "Testing `tildify-buffer' in " + (symbol-name mode) "\n"))) + (insert header input) + (tildify-buffer t) + (should (string-equal (concat header expected) (buffer-string))))) + (with-temp-buffer + (funcall mode) + (let ((header (concat "Testing `tildify-region' in " + (symbol-name mode) "\n"))) + (insert header input) + (tildify-region (point-min) (point-max) t) + (should (string-equal (concat header expected) (buffer-string))))))) + +(ert-deftest tildify-test-html () + "Tests tildification in an HTML document" + (let* ((sentence (tildify-test--example-sentence " ")) + (with-nbsp (tildify-test--example-sentence " "))) + (tildify-test--test '(html-mode sgml-mode) + (tildify-test--example-html sentence sentence) + (tildify-test--example-html sentence with-nbsp)))) + + +(defun tildify-test--example-tex (sentence &optional with-nbsp) + "Return an example (La)Tex code. +SENTENCE is placed where spaces should not be replaced with hard spaces, and +WITH-NBSP is placed where spaces should be replaced with hard spaces. If the +latter is missing, SENTENCE will be used in all placeholder positions." + (let ((with-nbsp (or with-nbsp sentence))) + (concat with-nbsp "\n" + "\\begin{verbatim}\n" sentence "\n\\end{verbatim}\n" + "\\verb#" sentence "#\n" + "$$" sentence "$$\n" + "$" sentence "$\n" + "\\[" sentence "\\]\n" + "\\v A % " sentence "\n" + with-nbsp "\n"))) + +(ert-deftest tildify-test-tex () + "Tests tildification in a (La)TeX document" + (let* ((sentence (tildify-test--example-sentence " ")) + (with-nbsp (tildify-test--example-sentence "~"))) + (tildify-test--test '(tex-mode latex-mode plain-tex-mode) + (tildify-test--example-tex sentence sentence) + (tildify-test--example-tex sentence with-nbsp)))) + +(provide 'tildify-tests) + +;;; tildify-tests.el ends here ------------------------------------------------------------ revno: 117171 fixes bug: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=17475 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2014-05-27 20:50:44 -0400 message: * lisp/subr.el (zerop): Move from C. Add compiler-macro. * lisp/emacs-lisp/byte-opt.el (byte-optimize-zerop): Remove. * src/data.c (Fzerop): Move to Elisp. (syms_of_data): Don't defsubr it. * src/keyboard.c (echo_keystrokes_p): New function. (read_char, record_menu_key, read_key_sequence): Use it. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-05-28 00:09:14 +0000 +++ lisp/ChangeLog 2014-05-28 00:50:44 +0000 @@ -1,10 +1,12 @@ 2014-05-28 Stefan Monnier + * subr.el (zerop): Move from C. Add compiler-macro (bug#17475). + * emacs-lisp/byte-opt.el (byte-optimize-zerop): Remove. + * subr.el (internal--funcall-interactively): New. (internal--call-interactively): Remove. (called-interactively-p): Detect funcall-interactively instead of call-interactively. - * simple.el (repeat-complex-command): Use funcall-interactively. (repeat-complex-command--called-interactively-skip): Remove. === modified file 'lisp/emacs-lisp/byte-opt.el' --- lisp/emacs-lisp/byte-opt.el 2014-02-10 01:34:22 +0000 +++ lisp/emacs-lisp/byte-opt.el 2014-05-28 00:50:44 +0000 @@ -942,15 +942,6 @@ form (nth 1 form))) -(defun byte-optimize-zerop (form) - (cond ((numberp (nth 1 form)) - (eval form)) - (byte-compile-delete-errors - (list '= (nth 1 form) 0)) - (form))) - -(put 'zerop 'byte-optimizer 'byte-optimize-zerop) - (defun byte-optimize-and (form) ;; Simplify if less than 2 args. ;; if there is a literal nil in the args to `and', throw it and following === modified file 'lisp/subr.el' --- lisp/subr.el 2014-05-28 00:09:14 +0000 +++ lisp/subr.el 2014-05-28 00:50:44 +0000 @@ -334,6 +334,13 @@ configuration." (and (consp object) (eq (car object) 'frame-configuration))) + +(defun zerop (number) + "Return t if NUMBER is zero." + ;; Used to be in C, but it's pointless since (= 0 n) is faster anyway because + ;; = has a byte-code. + (declare (compiler-macro (lambda (_) `(= 0 ,number)))) + (= 0 number)) ;;;; List functions. @@ -3845,7 +3852,8 @@ (byte-compile-log-warning msg)) (run-with-timer 0 nil (lambda (msg) - (message "%s" msg)) msg)))) + (message "%s" msg)) + msg)))) ;; Finally, run any other hook. (run-hook-with-args 'after-load-functions abs-file)) === modified file 'src/ChangeLog' --- src/ChangeLog 2014-05-27 23:48:35 +0000 +++ src/ChangeLog 2014-05-28 00:50:44 +0000 @@ -1,3 +1,16 @@ +2014-05-28 Stefan Monnier + + * data.c (Fzerop): Move to Elisp. + (syms_of_data): Don't defsubr it. + * keyboard.c (echo_keystrokes_p): New function. + (read_char, record_menu_key, read_key_sequence): Use it. + + * callint.c (Qfuncall_interactively): New var. + (Qcall_interactively): Remove. + (Ffuncall_interactively): New function. + (Fcall_interactively): Use it. + (syms_of_callint): Defsubr it. + 2014-05-27 Stefan Monnier * bytecode.c (FETCH) [BYTE_CODE_SAFE]: Check the bytecode wasn't @@ -360,8 +373,8 @@ * term.c (tty_menu_display): Move the cursor to the active menu item. (tty_menu_activate): Return the cursor to the active menu item - after displaying the menu and after displaying help-echo. See - http://lists.gnu.org/archive/html/emacs-devel/2014-04/msg00402.html + after displaying the menu and after displaying help-echo. + See http://lists.gnu.org/archive/html/emacs-devel/2014-04/msg00402.html for the details of why this is needed by screen readers and Braille displays. @@ -480,8 +493,8 @@ 2014-04-17 Daniel Colascione - * term.c (Qtty_mode_set_strings, Qtty_mode_reset_strings): New - symbols. + * term.c (Qtty_mode_set_strings, Qtty_mode_reset_strings): + New symbols. (tty_send_additional_strings): New function. (tty_set_terminal_modes, tty_reset_terminal_modes): Use it. (syms_of_term): Intern tty-mode-set-strings and === modified file 'src/data.c' --- src/data.c 2014-05-19 19:19:05 +0000 +++ src/data.c 2014-05-28 00:50:44 +0000 @@ -2332,7 +2332,7 @@ ptrdiff_t argnum; for (argnum = 1; argnum < nargs; ++argnum) { - if (EQ (Qnil, arithcompare (args[argnum-1], args[argnum], comparison))) + if (EQ (Qnil, arithcompare (args[argnum - 1], args[argnum], comparison))) return Qnil; } return Qt; @@ -2386,24 +2386,6 @@ { return arithcompare (num1, num2, ARITH_NOTEQUAL); } - -DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0, - doc: /* Return t if NUMBER is zero. */) - (register Lisp_Object number) -{ - CHECK_NUMBER_OR_FLOAT (number); - - if (FLOATP (number)) - { - if (XFLOAT_DATA (number) == 0.0) - return Qt; - return Qnil; - } - - if (!XINT (number)) - return Qt; - return Qnil; -} /* Convert the cons-of-integers, integer, or float value C to an unsigned value with maximum value MAX. Signal an error if C does not @@ -3650,7 +3632,6 @@ defsubr (&Sleq); defsubr (&Sgeq); defsubr (&Sneq); - defsubr (&Szerop); defsubr (&Splus); defsubr (&Sminus); defsubr (&Stimes); === modified file 'src/keyboard.c' --- src/keyboard.c 2014-05-13 22:59:36 +0000 +++ src/keyboard.c 2014-05-28 00:50:44 +0000 @@ -2376,6 +2376,13 @@ } } +static bool +echo_keystrokes_p (void) +{ + return (FLOATP (Vecho_keystrokes) ? XFLOAT_DATA (Vecho_keystrokes) > 0.0 + : INTEGERP (Vecho_keystrokes) ? XINT (Vecho_keystrokes) > 0 : false); +} + /* Read a character from the keyboard; call the redisplay if needed. */ /* commandflag 0 means do not autosave, but do redisplay. -1 means do not redisplay, but do autosave. @@ -2711,8 +2718,7 @@ && !current_kboard->immediate_echo && this_command_key_count > 0 && ! noninteractive - && (FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes)) - && NILP (Fzerop (Vecho_keystrokes)) + && echo_keystrokes_p () && (/* No message. */ NILP (echo_area_buffer[0]) /* Or empty message. */ @@ -3173,8 +3179,7 @@ { /* Don't echo mouse motion events. */ - if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes)) - && NILP (Fzerop (Vecho_keystrokes)) + if (echo_keystrokes_p () && ! (EVENT_HAS_PARAMETERS (c) && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement))) { @@ -3250,8 +3255,7 @@ #endif /* Don't echo mouse motion events. */ - if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes)) - && NILP (Fzerop (Vecho_keystrokes))) + if (echo_keystrokes_p ()) { echo_char (c); @@ -8931,8 +8935,7 @@ echo_now (); } else if (cursor_in_echo_area - && (FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes)) - && NILP (Fzerop (Vecho_keystrokes))) + && echo_keystrokes_p ()) /* This doesn't put in a dash if the echo buffer is empty, so you don't always see a dash hanging out in the minibuffer. */ echo_dash (); @@ -9064,8 +9067,7 @@ { key = keybuf[t]; add_command_key (key); - if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes)) - && NILP (Fzerop (Vecho_keystrokes)) + if (echo_keystrokes_p () && current_kboard->immediate_echo) { echo_add_key (key); @@ -9729,8 +9731,7 @@ Better ideas? */ for (; t < mock_input; t++) { - if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes)) - && NILP (Fzerop (Vecho_keystrokes))) + if (echo_keystrokes_p ()) echo_char (keybuf[t]); add_command_key (keybuf[t]); } ------------------------------------------------------------ revno: 117170 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2014-05-27 20:09:14 -0400 message: * src/callint.c (Ffuncall_interactively): New function. (Qfuncall_interactively): New var. (Qcall_interactively): Remove. (Fcall_interactively): Use it. (syms_of_callint): Defsubr it. * lisp/subr.el (internal--funcall-interactively): New. (internal--call-interactively): Remove. (called-interactively-p): Detect funcall-interactively instead of call-interactively. * lisp/simple.el (repeat-complex-command): Use funcall-interactively. (repeat-complex-command--called-interactively-skip): Remove. diff: === modified file 'etc/NEWS' --- etc/NEWS 2014-05-27 17:31:17 +0000 +++ etc/NEWS 2014-05-28 00:09:14 +0000 @@ -123,6 +123,10 @@ * Lisp Changes in Emacs 24.5 +** New function `funcall-interactively', which works like `funcall' +but makes `called-interactively-p' treat the function as (you guessed it) +called interactively. + ** New function `function-put' to use instead of `put' for function properties. +++ === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-05-27 14:36:07 +0000 +++ lisp/ChangeLog 2014-05-28 00:09:14 +0000 @@ -1,3 +1,13 @@ +2014-05-28 Stefan Monnier + + * subr.el (internal--funcall-interactively): New. + (internal--call-interactively): Remove. + (called-interactively-p): Detect funcall-interactively instead of + call-interactively. + + * simple.el (repeat-complex-command): Use funcall-interactively. + (repeat-complex-command--called-interactively-skip): Remove. + 2014-05-27 Stefan Monnier * register.el (register-read-with-preview): Don't burp on === modified file 'lisp/simple.el' --- lisp/simple.el 2014-05-26 02:28:09 +0000 +++ lisp/simple.el 2014-05-28 00:09:14 +0000 @@ -1503,24 +1503,13 @@ ;; add it to the history. (or (equal newcmd (car command-history)) (setq command-history (cons newcmd command-history))) - (unwind-protect - (progn - ;; Trick called-interactively-p into thinking that `newcmd' is - ;; an interactive call (bug#14136). - (add-hook 'called-interactively-p-functions - #'repeat-complex-command--called-interactively-skip) - (eval newcmd)) - (remove-hook 'called-interactively-p-functions - #'repeat-complex-command--called-interactively-skip))) + (apply #'funcall-interactively + (car newcmd) + (mapcar (lambda (e) (eval e t)) (cdr newcmd)))) (if command-history (error "Argument %d is beyond length of command history" arg) (error "There are no previous complex commands to repeat"))))) -(defun repeat-complex-command--called-interactively-skip (i _frame1 frame2) - (and (eq 'eval (cadr frame2)) - (eq 'repeat-complex-command - (cadr (backtrace-frame i #'called-interactively-p))) - 1)) (defvar extended-command-history nil) === modified file 'lisp/subr.el' --- lisp/subr.el 2014-05-14 17:15:15 +0000 +++ lisp/subr.el 2014-05-28 00:09:14 +0000 @@ -4162,7 +4162,8 @@ if those frames don't seem special and otherwise, it should return the number of frames to skip (minus 1).") -(defconst internal--call-interactively (symbol-function 'call-interactively)) +(defconst internal--funcall-interactively + (symbol-function 'funcall-interactively)) (defun called-interactively-p (&optional kind) "Return t if the containing function was called by `call-interactively'. @@ -4236,10 +4237,13 @@ (pcase (cons frame nextframe) ;; No subr calls `interactive-p', so we can rule that out. (`((,_ ,(pred (lambda (f) (subrp (indirect-function f)))) . ,_) . ,_) nil) - ;; In case # without going through the - ;; `call-interactively' symbol (bug#3984). - (`(,_ . (t ,(pred (eq internal--call-interactively)) . ,_)) t) - (`(,_ . (t call-interactively . ,_)) t))))) + ;; In case # without going through the + ;; `funcall-interactively' symbol (bug#3984). + (`(,_ . (t ,(pred (lambda (f) + (eq internal--funcall-interactively + (indirect-function f)))) + . ,_)) + t))))) (defun interactive-p () "Return t if the containing function was run directly by user input. === modified file 'src/callint.c' --- src/callint.c 2014-04-22 07:04:34 +0000 +++ src/callint.c 2014-05-28 00:09:14 +0000 @@ -29,7 +29,7 @@ #include "keymap.h" Lisp_Object Qminus, Qplus; -static Lisp_Object Qcall_interactively; +static Lisp_Object Qfuncall_interactively; static Lisp_Object Qcommand_debug_status; static Lisp_Object Qenable_recursive_minibuffers; @@ -233,6 +233,22 @@ } } +/* BEWARE: Calling this directly from C would defeat the purpose! */ +DEFUN ("funcall-interactively", Ffuncall_interactively, Sfuncall_interactively, + 1, MANY, 0, doc: /* Like `funcall' but marks the call as interactive. +I.e. arrange that within the called function `called-interactively-p' will +return non-nil. */) + (ptrdiff_t nargs, Lisp_Object *args) +{ + ptrdiff_t speccount = SPECPDL_INDEX (); + temporarily_switch_to_single_kboard (NULL); + + /* Nothing special to do here, all the work is inside + `called-interactively-p'. Which will look for us as a marker in the + backtrace. */ + return unbind_to (speccount, Ffuncall (nargs, args)); +} + DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0, doc: /* Call FUNCTION, providing args according to its interactive calling specs. Return the value FUNCTION returns. @@ -374,8 +390,13 @@ Vreal_this_command = save_real_this_command; kset_last_command (current_kboard, save_last_command); - temporarily_switch_to_single_kboard (NULL); - return unbind_to (speccount, apply1 (function, specs)); + { + Lisp_Object args[3]; + args[0] = Qfuncall_interactively; + args[1] = function; + args[2] = specs; + return unbind_to (speccount, Fapply (3, args)); + } } /* Here if function specifies a string to control parsing the defaults. */ @@ -446,10 +467,11 @@ else break; } - /* Count the number of arguments, which is one plus the number of arguments - the interactive spec would have us give to the function. */ + /* Count the number of arguments, which is two (the function itself and + `funcall-interactively') plus the number of arguments the interactive spec + would have us give to the function. */ tem = string; - for (nargs = 1; *tem; ) + for (nargs = 2; *tem; ) { /* 'r' specifications ("point and mark as 2 numeric args") produce *two* arguments. */ @@ -488,13 +510,13 @@ specbind (Qenable_recursive_minibuffers, Qt); tem = string; - for (i = 1; *tem; i++) + for (i = 2; *tem; i++) { - visargs[0] = make_string (tem + 1, strcspn (tem + 1, "\n")); - if (strchr (SSDATA (visargs[0]), '%')) + visargs[1] = make_string (tem + 1, strcspn (tem + 1, "\n")); + if (strchr (SSDATA (visargs[1]), '%')) callint_message = Fformat (i, visargs); else - callint_message = visargs[0]; + callint_message = visargs[1]; switch (*tem) { @@ -789,21 +811,22 @@ QUIT; - args[0] = function; + args[0] = Qfuncall_interactively; + args[1] = function; if (arg_from_tty || !NILP (record_flag)) { /* We don't need `visargs' any more, so let's recycle it since we need an array of just the same size. */ - visargs[0] = function; - for (i = 1; i < nargs; i++) + visargs[1] = function; + for (i = 2; i < nargs; i++) { if (varies[i] > 0) visargs[i] = list1 (intern (callint_argfuns[varies[i]])); else visargs[i] = quotify_arg (args[i]); } - Vcommand_history = Fcons (Flist (nargs, visargs), + Vcommand_history = Fcons (Flist (nargs - 1, visargs + 1), Vcommand_history); /* Don't keep command history around forever. */ if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0) @@ -816,7 +839,7 @@ /* If we used a marker to hold point, mark, or an end of the region, temporarily, convert it to an integer now. */ - for (i = 1; i < nargs; i++) + for (i = 2; i < nargs; i++) if (varies[i] >= 1 && varies[i] <= 4) XSETINT (args[i], marker_position (args[i])); @@ -829,11 +852,7 @@ kset_last_command (current_kboard, save_last_command); { - Lisp_Object val; - specbind (Qcommand_debug_status, Qnil); - - temporarily_switch_to_single_kboard (NULL); - val = Ffuncall (nargs, args); + Lisp_Object val = Ffuncall (nargs, args); UNGCPRO; return unbind_to (speccount, val); } @@ -888,7 +907,7 @@ DEFSYM (Qplus, "+"); DEFSYM (Qhandle_shift_selection, "handle-shift-selection"); DEFSYM (Qread_number, "read-number"); - DEFSYM (Qcall_interactively, "call-interactively"); + DEFSYM (Qfuncall_interactively, "funcall-interactively"); DEFSYM (Qcommand_debug_status, "command-debug-status"); DEFSYM (Qenable_recursive_minibuffers, "enable-recursive-minibuffers"); DEFSYM (Qmouse_leave_buffer_hook, "mouse-leave-buffer-hook"); @@ -946,5 +965,6 @@ defsubr (&Sinteractive); defsubr (&Scall_interactively); + defsubr (&Sfuncall_interactively); defsubr (&Sprefix_numeric_value); } ------------------------------------------------------------ revno: 117169 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2014-05-27 19:48:35 -0400 message: * src/bytecode.c (FETCH) [BYTE_CODE_SAFE]: Check the bytecode wasn't relocated from under us. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2014-05-27 17:31:17 +0000 +++ src/ChangeLog 2014-05-27 23:48:35 +0000 @@ -1,3 +1,8 @@ +2014-05-27 Stefan Monnier + + * bytecode.c (FETCH) [BYTE_CODE_SAFE]: Check the bytecode wasn't + relocated from under us. + 2014-05-27 Fabrice Popineau * Makefile.in (C_HEAP_SWITCH): Get the predefined heap size from === modified file 'src/bytecode.c' --- src/bytecode.c 2014-05-17 08:11:31 +0000 +++ src/bytecode.c 2014-05-27 23:48:35 +0000 @@ -388,7 +388,11 @@ /* Fetch the next byte from the bytecode stream. */ +#ifdef BYTE_CODE_SAFE +#define FETCH (eassert (stack.byte_string_start == SDATA (stack.byte_string)), *stack.pc++) +#else #define FETCH *stack.pc++ +#endif /* Fetch two bytes from the bytecode stream and make a 16-bit number out of them. */ ------------------------------------------------------------ revno: 117168 author: Fabrice Popineau committer: Eli Zaretskii branch nick: trunk timestamp: Tue 2014-05-27 20:31:17 +0300 message: Use mmap(2) emulation for buffer text on MS-Windows. src/Makefile.in (C_HEAP_SWITCH): Get the predefined heap size from configure. (ADDSECTION, MINGW_TEMACS_POST_LINK): Remove, no longer used. src/lisp.h (NONPOINTER_BITS): Modify the condition to define to zero for MinGW, since it no longer uses gmalloc. src/buffer.c: Do not define mmap allocations functions for Windows. Remove mmap_find which is unused. Remove mmap_set_vars which does nothing useful. [WINDOWSNT]: Include w32heap.h. (init_buffer): Always allocate new memory for buffers. src/emacs.c: Remove mmap_set_vars calls. src/image.c (free_image): Undef free for Windows because it is redirected to our private version. src/unexw32.c (COPY_PROC_CHUNK): Use %p format for 64bits compatibility. (copy_executable_and_dump_data): Remove dumping the heap section. (unexec): Restore using_dynamic_heap after dumping. src/w32heap.c (dumped_data_commit, malloc_after_dump) (malloc_before_dump, realloc_after_dump, realloc_before_dump) (free_after_dump, free_before_dump, mmap_alloc, mmap_realloc) (mmap_free): New functions. src/w32heap.h: Declare dumped_data and mmap_* function prototypes. nt/inc/ms-w32.h: Switch to the system heap allocation scheme instead of GNU malloc and ralloc. nt/inc/sys/mman.h: New file. nt/INSTALL: Update for the new build requirements. etc/NEWS: Mention build changes on MS-Windows. configure.ac (C_HEAP_SWITCH) define for different values of dumped heap size depending on 32/64bits arch on Windows. Don't check for pthreads.h on MinGW32/64, it gets in the way. Use mmap(2) for buffers and system malloc for MinGW32/64. diff: === modified file 'ChangeLog' --- ChangeLog 2014-05-27 05:55:18 +0000 +++ ChangeLog 2014-05-27 17:31:17 +0000 @@ -1,3 +1,10 @@ +2014-05-27 Fabrice Popineau + + * configure.ac (C_HEAP_SWITCH) define for different values of + dumped heap size depending on 32/64bits arch on Windows. + Don't check for pthreads.h on MinGW32/64, it gets in the way. + Use mmap(2) for buffers and system malloc for MinGW32/64. + 2014-05-27 Paul Eggert Merge from gnulib, incorporating: === modified file 'configure.ac' --- configure.ac 2014-05-26 02:28:09 +0000 +++ configure.ac 2014-05-27 17:31:17 +0000 @@ -1973,7 +1973,7 @@ system_malloc=$emacs_cv_sanitize_address case "$opsys" in ## darwin ld insists on the use of malloc routines in the System framework. - darwin|sol2-10) system_malloc=yes ;; + darwin|mingw32|sol2-10) system_malloc=yes ;; esac GMALLOC_OBJ= @@ -2020,7 +2020,7 @@ ## #ifdef DOUG_LEA_MALLOC; #undef REL_ALLOC; #endif ## Does the AC_FUNC_MMAP test below make this check unnecessary? case "$opsys" in - gnu*) REL_ALLOC=no ;; + mingw32|gnu*) REL_ALLOC=no ;; esac fi @@ -2030,7 +2030,7 @@ use_mmap_for_buffers=no case "$opsys" in - cygwin|freebsd|irix6-5) use_mmap_for_buffers=yes ;; + cygwin|mingw32|freebsd|irix6-5) use_mmap_for_buffers=yes ;; esac AC_FUNC_MMAP @@ -2046,6 +2046,7 @@ dnl Check for the POSIX thread library. LIB_PTHREAD= +if test "$opsys" != "mingw32"; then AC_CHECK_HEADERS_ONCE(pthread.h) if test "$ac_cv_header_pthread_h"; then dnl gmalloc.c uses pthread_atfork, which is not available on older-style @@ -2066,6 +2067,7 @@ LIBS=$OLD_LIBS fi AC_SUBST([LIB_PTHREAD]) +fi dnl Check for need for bigtoc support on IBM AIX @@ -4817,11 +4819,9 @@ gnu*) LD_SWITCH_SYSTEM_TEMACS="\$(LD_SWITCH_X_SITE_RPATH)" ;; mingw32) - ## MinGW64 does not prepend an underscore to symbols, so we must - ## pass a different -entry switch to linker. FIXME: It is better - ## to make the entry points the same by changing unexw32.c. + ## Is it any better under MinGW64 to relocate emacs into higher addresses? case "$canonical" in - x86_64-*-*) LD_SWITCH_SYSTEM_TEMACS="-Wl,-stack,0x00800000 -Wl,-heap,0x00100000 -Wl,-image-base,0x01000000 -Wl,-entry,__start -Wl,-Map,./temacs.map" ;; + 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 ;; @@ -4845,20 +4845,20 @@ ## MinGW-specific post-link processing of temacs. TEMACS_POST_LINK=":" ADDSECTION= -EMACS_HEAPSIZE= +C_HEAP_SWITCH= if test "${opsys}" = "mingw32"; then TEMACS_POST_LINK="\$(MINGW_TEMACS_POST_LINK)" ADDSECTION="../nt/addsection\$(EXEEXT)" ## Preload heap size of temacs.exe in MB. case "$canonical" in - x86_64-*-*) EMACS_HEAPSIZE=42 ;; - *) EMACS_HEAPSIZE=27 ;; + x86_64-*-*) C_HEAP_SWITCH="-DHEAPSIZE=18" ;; + *) C_HEAP_SWITCH="-DHEAPSIZE=10" ;; esac fi AC_SUBST(ADDSECTION) AC_SUBST(TEMACS_POST_LINK) -AC_SUBST(EMACS_HEAPSIZE) +AC_SUBST(C_HEAP_SWITCH) ## Common for all window systems if test "$window_system" != "none"; then === modified file 'etc/ChangeLog' --- etc/ChangeLog 2014-05-26 02:28:09 +0000 +++ etc/ChangeLog 2014-05-27 17:31:17 +0000 @@ -1,3 +1,7 @@ +2014-05-27 Fabrice Popineau + + * NEWS: Mention build changes on MS-Windows. + 2014-05-26 Paul Eggert Specify coding if Latin-1 Emacs would misinterpret (Bug#17575). === modified file 'etc/NEWS' --- etc/NEWS 2014-05-26 02:28:09 +0000 +++ etc/NEWS 2014-05-27 17:31:17 +0000 @@ -40,6 +40,11 @@ ** The configure option `--with-pkg-config-prog' has been removed. Use './configure PKG_CONFIG=/full/name/of/pkg-config' if you need to. +--- +** Building Emacs for MS-Windows requires at least Windows XP +or Windows Server 2003. The built binaries still run on all versions +of Windows starting with Windows 9X. + * Startup Changes in Emacs 24.5 === modified file 'nt/ChangeLog' --- nt/ChangeLog 2014-05-17 08:11:31 +0000 +++ nt/ChangeLog 2014-05-27 17:31:17 +0000 @@ -1,3 +1,12 @@ +2014-05-27 Fabrice Popineau + + * inc/ms-w32.h: Switch to the system heap allocation scheme + instead of GNU malloc and ralloc. + + * inc/sys/mman.h: New file. + + * INSTALL: Update for the new build requirements. + 2014-05-17 Paul Eggert Assume C99 or later (Bug#17487). === modified file 'nt/INSTALL' --- nt/INSTALL 2014-05-16 15:49:13 +0000 +++ nt/INSTALL 2014-05-27 17:31:17 +0000 @@ -5,9 +5,9 @@ See the end of the file for license conditions. The MSYS/MinGW build described here is supported on versions of -Windows starting with Windows 2000 and newer. Windows 9X are not -supported (but the Emacs binary produced by this build will run on -Windows 9X as well). +Windows starting with Windows XP and newer. Building on Windows 2000 +and Windows 9X is not supported (but the Emacs binary produced by this +build will run on Windows 9X and newer systems). Do not use this recipe with Cygwin. For building on Cygwin, use the normal installation instructions, ../INSTALL. @@ -389,9 +389,10 @@ Where should the build process find the source code? /path/to/emacs/sources What compiler should emacs be built with? gcc -std=gnu99 -O0 -g3 - Should Emacs use the GNU version of malloc? yes - Should Emacs use a relocating allocator for buffers? yes - Should Emacs use mmap(2) for buffer allocation? no + Should Emacs use the GNU version of malloc? no + (The GNU allocators don't work with this system configuration.) + Should Emacs use a relocating allocator for buffers? no + Should Emacs use mmap(2) for buffer allocation? yes What window system should Emacs use? w32 What toolkit should Emacs use? none Where do we find X Windows header files? NONE @@ -401,13 +402,16 @@ Does Emacs use -ljpeg? yes Does Emacs use -ltiff? yes Does Emacs use a gif library? yes - Does Emacs use -lpng? yes - Does Emacs use -lrsvg-2? no + Does Emacs use a png library? yes + Does Emacs use -lrsvg-2? yes Does Emacs use imagemagick? no + Does Emacs support sound? no Does Emacs use -lgpm? no Does Emacs use -ldbus? no Does Emacs use -lgconf? no Does Emacs use GSettings? no + Does Emacs use a file notification library? yes (w32) + Does Emacs use access control lists? yes Does Emacs use -lselinux? no Does Emacs use -lgnutls? yes Does Emacs use -lxml2? yes @@ -415,6 +419,7 @@ Does Emacs use -lm17n-flt? no Does Emacs use -lotf? no Does Emacs use -lxft? no + Does Emacs directly use zlib? yes Does Emacs use toolkit scroll bars? yes You are almost there, hang on. === modified file 'nt/inc/ms-w32.h' --- nt/inc/ms-w32.h 2014-04-21 06:37:21 +0000 +++ nt/inc/ms-w32.h 2014-05-27 17:31:17 +0000 @@ -140,6 +140,7 @@ in its system headers, and is not really compatible with values lower than 0x0500, so leave it alone. */ #ifndef _W64 +# undef _WIN32_WINNT # define _WIN32_WINNT 0x0400 #endif @@ -427,20 +428,36 @@ #define _WINSOCK_H /* Defines size_t and alloca (). */ -#ifdef emacs -#define malloc e_malloc -#define free e_free -#define realloc e_realloc -#define calloc e_calloc -#endif +#include +#include #ifdef _MSC_VER #define alloca _alloca #else #include #endif -#include -#include +#ifdef emacs + +typedef void * (* malloc_fn)(size_t); +typedef void * (* realloc_fn)(void *, size_t); +typedef void (* free_fn)(void *); + +extern void *malloc_before_dump(size_t); +extern void *realloc_before_dump(void *, size_t); +extern void free_before_dump(void *); +extern void *malloc_after_dump(size_t); +extern void *realloc_after_dump(void *, size_t); +extern void free_after_dump(void *); + +extern malloc_fn the_malloc_fn; +extern realloc_fn the_realloc_fn; +extern free_fn the_free_fn; + +#define malloc(size) (*the_malloc_fn)(size) +#define free(ptr) (*the_free_fn)(ptr) +#define realloc(ptr, size) (*the_realloc_fn)(ptr, size) + +#endif /* Define for those source files that do not include enough NT system files. */ #ifndef NULL === added file 'nt/inc/sys/mman.h' --- nt/inc/sys/mman.h 1970-01-01 00:00:00 +0000 +++ nt/inc/sys/mman.h 2014-05-27 17:31:17 +0000 @@ -0,0 +1,31 @@ +/* + * sys/mman.h + * mman-win32 + */ + +#ifndef _SYS_MMAN_H_ +#define _SYS_MMAN_H_ + +#include + +#ifdef __cplusplus +extern "C" { +#endif + +/* We need MAP_ANON in src/buffer.c */ + +#define MAP_FILE 0 +#define MAP_SHARED 1 +#define MAP_PRIVATE 2 +#define MAP_TYPE 0xf +#define MAP_FIXED 0x10 +#define MAP_ANONYMOUS 0x20 +#define MAP_ANON MAP_ANONYMOUS + +#define MAP_FAILED ((void *)-1) + +#ifdef __cplusplus +}; +#endif + +#endif /* _SYS_MMAN_H_ */ === modified file 'src/ChangeLog' --- src/ChangeLog 2014-05-27 06:37:29 +0000 +++ src/ChangeLog 2014-05-27 17:31:17 +0000 @@ -1,3 +1,35 @@ +2014-05-27 Fabrice Popineau + + * Makefile.in (C_HEAP_SWITCH): Get the predefined heap size from + configure. + (ADDSECTION, MINGW_TEMACS_POST_LINK): Remove, no longer used. + + * lisp.h (NONPOINTER_BITS): Modify the condition to define to zero + for MinGW, since it no longer uses gmalloc. + + * buffer.c: Do not define mmap allocations functions for Windows. + Remove mmap_find which is unused. Remove mmap_set_vars which does + nothing useful. + [WINDOWSNT]: Include w32heap.h. + (init_buffer): Always allocate new memory for buffers. + + * emacs.c: Remove mmap_set_vars calls. + + * image.c (free_image): Undef free for Windows because it is + redirected to our private version. + + * unexw32.c (COPY_PROC_CHUNK): Use %p format for 64bits + compatibility. + (copy_executable_and_dump_data): Remove dumping the heap section. + (unexec): Restore using_dynamic_heap after dumping. + + * w32heap.c (dumped_data_commit, malloc_after_dump) + (malloc_before_dump, realloc_after_dump, realloc_before_dump) + (free_after_dump, free_before_dump, mmap_alloc, mmap_realloc) + (mmap_free): New functions. + + * w32heap.h: Declare dumped_data and mmap_* function prototypes. + 2014-05-27 Paul Eggert * image.c (imagemagick_load_image): Use MagickRealType for local === modified file 'src/Makefile.in' --- src/Makefile.in 2014-05-13 14:18:54 +0000 +++ src/Makefile.in 2014-05-27 17:31:17 +0000 @@ -86,6 +86,9 @@ ## something similar. This is normally set by configure. C_SWITCH_X_SITE=@C_SWITCH_X_SITE@ +## Set Emacs dumped heap size for Windows NT +C_HEAP_SWITCH=@C_HEAP_SWITCH@ + ## Define LD_SWITCH_X_SITE to contain any special flags your loader ## may need to deal with X Windows. For instance, if your X libraries ## aren't in a place that your loader can find on its own, you might @@ -300,11 +303,7 @@ ## Invoke ../nt/addsection for MinGW, ":" elsewhere. TEMACS_POST_LINK = @TEMACS_POST_LINK@ -ADDSECTION = @ADDSECTION@ EMACS_HEAPSIZE = @EMACS_HEAPSIZE@ -MINGW_TEMACS_POST_LINK = \ - mv temacs$(EXEEXT) temacs.tmp; \ - ../nt/addsection temacs.tmp temacs$(EXEEXT) EMHEAP $(EMACS_HEAPSIZE) UNEXEC_OBJ = @UNEXEC_OBJ@ @@ -326,7 +325,7 @@ ## ## FIXME? MYCPPFLAGS only referenced in etc/DEBUG. ALL_CFLAGS=-Demacs $(MYCPPFLAGS) -I. -I$(srcdir) \ - -I$(lib) -I$(srcdir)/../lib \ + -I$(lib) -I$(srcdir)/../lib $(C_HEAP_SWITCH) \ $(C_SWITCH_MACHINE) $(C_SWITCH_SYSTEM) $(C_SWITCH_X_SITE) \ $(GNUSTEP_CFLAGS) $(CFLAGS_SOUND) $(RSVG_CFLAGS) $(IMAGEMAGICK_CFLAGS) \ $(PNG_CFLAGS) $(LIBXML2_CFLAGS) $(DBUS_CFLAGS) \ === modified file 'src/buffer.c' --- src/buffer.c 2014-05-17 07:14:59 +0000 +++ src/buffer.c 2014-05-27 17:31:17 +0000 @@ -41,6 +41,10 @@ #include "keymap.h" #include "frame.h" +#ifdef WINDOWSNT +#include "w32heap.h" /* for mmap_* */ +#endif + struct buffer *current_buffer; /* The current buffer. */ /* First buffer in chain of all buffers (in reverse order of creation). @@ -4632,7 +4636,8 @@ Allocation with mmap ***********************************************************************/ -#ifdef USE_MMAP_FOR_BUFFERS +/* Note: WINDOWSNT implements this stuff on w32heap.c. */ +#if defined USE_MMAP_FOR_BUFFERS && !defined WINDOWSNT #include @@ -4774,36 +4779,6 @@ mmap_page_size = getpagesize (); } -/* Return a region overlapping address range START...END, or null if - none. END is not including, i.e. the last byte in the range - is at END - 1. */ - -static struct mmap_region * -mmap_find (void *start, void *end) -{ - struct mmap_region *r; - char *s = start, *e = end; - - for (r = mmap_regions; r; r = r->next) - { - char *rstart = (char *) r; - char *rend = rstart + r->nbytes_mapped; - - if (/* First byte of range, i.e. START, in this region? */ - (s >= rstart && s < rend) - /* Last byte of range, i.e. END - 1, in this region? */ - || (e > rstart && e <= rend) - /* First byte of this region in the range? */ - || (rstart >= s && rstart < e) - /* Last byte of this region in the range? */ - || (rend > s && rend <= e)) - break; - } - - return r; -} - - /* Unmap a region. P is a pointer to the start of the user-araa of the region. */ @@ -4880,38 +4855,6 @@ } -/* Set or reset variables holding references to mapped regions. - If not RESTORE_P, set all variables to null. If RESTORE_P, set all - variables to the start of the user-areas of mapped regions. - - This function is called from Fdump_emacs to ensure that the dumped - Emacs doesn't contain references to memory that won't be mapped - when Emacs starts. */ - -void -mmap_set_vars (bool restore_p) -{ - struct mmap_region *r; - - if (restore_p) - { - mmap_regions = mmap_regions_1; - mmap_fd = mmap_fd_1; - for (r = mmap_regions; r; r = r->next) - *r->var = MMAP_USER_AREA (r); - } - else - { - for (r = mmap_regions; r; r = r->next) - *r->var = NULL; - mmap_regions_1 = mmap_regions; - mmap_regions = NULL; - mmap_fd_1 = mmap_fd; - mmap_fd = -1; - } -} - - /* Allocate a block of storage large enough to hold NBYTES bytes of data. A pointer to the data is returned in *VAR. VAR is thus the address of some variable which will use the data area. === modified file 'src/emacs.c' --- src/emacs.c 2014-05-17 08:11:31 +0000 +++ src/emacs.c 2014-05-27 17:31:17 +0000 @@ -2155,13 +2155,8 @@ malloc_state_ptr = malloc_get_state (); #endif -#ifdef USE_MMAP_FOR_BUFFERS - mmap_set_vars (0); -#endif unexec (SSDATA (filename), !NILP (symfile) ? SSDATA (symfile) : 0); -#ifdef USE_MMAP_FOR_BUFFERS - mmap_set_vars (1); -#endif + #ifdef DOUG_LEA_MALLOC free (malloc_state_ptr); #endif === modified file 'src/image.c' --- src/image.c 2014-05-27 06:37:29 +0000 +++ src/image.c 2014-05-27 17:31:17 +0000 @@ -998,6 +998,11 @@ c->images[img->id] = NULL; + /* Windows NT redefines 'free', but in this file, we need to + avoid the redefinition. */ +#ifdef WINDOWSNT +#undef free +#endif /* Free resources, then free IMG. */ img->type->free (f, img); xfree (img); @@ -6453,7 +6458,6 @@ src->mgr.next_input_byte = NULL; } - /* Load image IMG for use on frame F. Patterned after example.c from the JPEG lib. */ === modified file 'src/lisp.h' --- src/lisp.h 2014-05-26 02:28:09 +0000 +++ src/lisp.h 2014-05-27 17:31:17 +0000 @@ -72,7 +72,7 @@ 2. We know malloc returns a multiple of 8. */ #if (defined alignas \ && (defined GNU_MALLOC || defined DOUG_LEA_MALLOC || defined __GLIBC__ \ - || defined DARWIN_OS || defined __sun)) + || defined DARWIN_OS || defined __sun || defined __MINGW32__)) # define NONPOINTER_BITS 0 #else # define NONPOINTER_BITS GCTYPEBITS === modified file 'src/unexw32.c' --- src/unexw32.c 2014-01-11 13:36:06 +0000 +++ src/unexw32.c 2014-05-27 17:31:17 +0000 @@ -83,8 +83,6 @@ DWORD_PTR bss_size_static = 0; DWORD_PTR extra_bss_size_static = 0; -PIMAGE_SECTION_HEADER heap_section; - /* MinGW64 doesn't add a leading underscore to external symbols, whereas configure.ac sets up LD_SWITCH_SYSTEM_TEMACS to force the entry point at __start, with two underscores. */ @@ -475,8 +473,6 @@ bss_section_static = 0; extra_bss_size_static = 0; } - - heap_section = rva_to_section (PTR_TO_RVA (get_heap_start ()), nt_header); } @@ -518,9 +514,11 @@ if (verbose) \ { \ printf ("%s\n", (message)); \ - printf ("\t0x%08x Address in process.\n", s); \ - printf ("\t0x%08x Offset in output file.\n", dst - p_outfile->file_base); \ - printf ("\t0x%08x Size in bytes.\n", count); \ + printf ("\t0x%p Address in process.\n", s); \ + printf ("\t0x%p Base output file.\n", p_outfile->file_base); \ + printf ("\t0x%p Offset in output file.\n", dst - p_outfile->file_base); \ + printf ("\t0x%p Address in output file.\n", dst); \ + printf ("\t0x%p Size in bytes.\n", count); \ } \ memcpy (dst, s, count); \ dst += count; \ @@ -629,34 +627,6 @@ dst_section->Characteristics &= ~IMAGE_SCN_CNT_UNINITIALIZED_DATA; dst_section->Characteristics |= IMAGE_SCN_CNT_INITIALIZED_DATA; } - if (section == heap_section) - { - DWORD_PTR heap_start = (DWORD_PTR) get_heap_start (); - DWORD_PTR heap_size = get_committed_heap_size (); - - /* Dump the used portion of the predump heap, adjusting the - section's size to the appropriate size. */ - dst = dst_save - + RVA_TO_SECTION_OFFSET (PTR_TO_RVA (heap_start), dst_section); - COPY_PROC_CHUNK ("Dumping heap...", heap_start, heap_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; - /* Reduce the size of the heap section to fit (must be last - section). */ - dst_nt_header->OptionalHeader.SizeOfImage -= - dst_section->Misc.VirtualSize - - ROUND_UP (dst_section->SizeOfRawData, - dst_nt_header->OptionalHeader.SectionAlignment); - dst_section->Misc.VirtualSize = - ROUND_UP (dst_section->SizeOfRawData, - dst_nt_header->OptionalHeader.SectionAlignment); - 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); @@ -767,9 +737,6 @@ printf ("Dumping from %s\n", in_filename); printf (" to %s\n", out_filename); - /* We need to round off our heap to NT's page size. */ - round_heap (get_page_size ()); - /* Open the undumped executable file. */ if (!open_input_file (&in_file, in_filename)) { @@ -784,7 +751,6 @@ /* 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 + - get_committed_heap_size () + extra_bss_size + extra_bss_size_static; if (!open_output_file (&out_file, out_filename, size)) @@ -799,6 +765,10 @@ copy_executable_and_dump_data (&in_file, &out_file); + /* Unset it because it is plain wrong to keep it after dumping. + Malloc can still occur! */ + using_dynamic_heap = FALSE; + /* Patch up header fields; profiler is picky about this. */ { PIMAGE_DOS_HEADER dos_header; === modified file 'src/w32heap.c' --- src/w32heap.c 2014-01-01 07:43:34 +0000 +++ src/w32heap.c 2014-05-27 17:31:17 +0000 @@ -1,256 +1,611 @@ -/* Heap management routines for GNU Emacs on the Microsoft Windows API. - Copyright (C) 1994, 2001-2014 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) 7-29-94 -*/ +/* Heap management routines for GNU Emacs on the Microsoft Windows + API. Copyright (C) 1994, 2001-2014 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) 7-29-94 +*/ + +/* + Heavily modified by Fabrice Popineau (fabrice.popineau@gmail.com) 28-02-2014 +*/ + +/* + Memory allocation scheme for w32/w64: + + - Buffers are mmap'ed using a very simple emulation of mmap/munmap + - During the temacs phase: + * 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: + * we create a private heap for new memory blocks + * we make sure that we never free a block that has been dumped. + Freeing a dumped block could work in principle, but may prove + unreliable if we distribute binaries of emacs.exe: MS does not + guarantee that the heap data structures are the same across all + versions of their OS, even though the API is available since XP. */ #include #include +#include #include "w32common.h" #include "w32heap.h" #include "lisp.h" /* for VALMASK */ -#define RVA_TO_PTR(rva) ((unsigned char *)((DWORD_PTR)(rva) + (DWORD_PTR)GetModuleHandle (NULL))) - -/* Emulate getpagesize. */ -int -getpagesize (void) -{ - return sysinfo_cache.dwPageSize; -} +/* We chose to leave those declarations here. They are used only in + this file. The RtlCreateHeap is available since XP. It is located + in ntdll.dll and is available with the DDK. People often + complained that HeapCreate doesn't offer the ability to create a + heap at a given place, which we need here, and which RtlCreateHeap + provides. We reproduce here the definitions available with the + DDK. */ + +typedef PVOID (WINAPI * RtlCreateHeap_Proc) ( + /* _In_ */ ULONG Flags, + /* _In_opt_ */ PVOID HeapBase, + /* _In_opt_ */ SIZE_T ReserveSize, + /* _In_opt_ */ SIZE_T CommitSize, + /* _In_opt_ */ PVOID Lock, + /* _In_opt_ */ PVOID Parameters + ); + +typedef LONG NTSTATUS; + +typedef NTSTATUS +(NTAPI * PRTL_HEAP_COMMIT_ROUTINE)( + IN PVOID Base, + IN OUT PVOID *CommitAddress, + IN OUT PSIZE_T CommitSize + ); + +typedef struct _RTL_HEAP_PARAMETERS { + ULONG Length; + SIZE_T SegmentReserve; + SIZE_T SegmentCommit; + SIZE_T DeCommitFreeBlockThreshold; + SIZE_T DeCommitTotalFreeThreshold; + SIZE_T MaximumAllocationSize; + SIZE_T VirtualMemoryThreshold; + SIZE_T InitialCommit; + SIZE_T InitialReserve; + PRTL_HEAP_COMMIT_ROUTINE CommitRoutine; + 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 to + create 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. */ + +unsigned char dumped_data[DUMPED_HEAP_SIZE]; /* Info for managing our preload heap, which is essentially a fixed size - data area in the executable. */ -PIMAGE_SECTION_HEADER preload_heap_section; - -/* Info for keeping track of our heap. */ + data area in the executable. */ +/* Info for keeping track of our heap. */ unsigned char *data_region_base = NULL; unsigned char *data_region_end = NULL; -unsigned char *real_data_region_end = NULL; -size_t reserved_heap_size = 0; - -/* The start of the data segment. */ -unsigned char * -get_data_start (void) -{ - return data_region_base; -} - -/* The end of the data segment. */ -unsigned char * -get_data_end (void) -{ - return data_region_end; -} - -#if !USE_LSB_TAG -static char * -allocate_heap (void) -{ - /* Try to get as much as possible of the address range from the end of - the preload heap section up to the usable address limit. Since GNU - malloc can handle gaps in the memory it gets from sbrk, we can - simply set the sbrk pointer to the base of the new heap region. */ - DWORD_PTR base = - ROUND_UP ((RVA_TO_PTR (preload_heap_section->VirtualAddress) - + preload_heap_section->Misc.VirtualSize), - get_allocation_unit ()); - DWORD_PTR end = ((unsigned __int64)1) << VALBITS; /* 256MB */ - void *ptr = NULL; - - while (!ptr && (base < end)) - { -#ifdef _WIN64 - reserved_heap_size = min(end - base, 0x4000000000ull); /* Limit to 256Gb */ -#else - reserved_heap_size = end - base; -#endif - ptr = VirtualAlloc ((void *) base, - get_reserved_heap_size (), - MEM_RESERVE, - PAGE_NOACCESS); - base += 0x00100000; /* 1MB increment */ - } - - return ptr; -} -#else /* USE_LSB_TAG */ -static char * -allocate_heap (void) -{ -#ifdef _WIN64 - size_t size = 0x4000000000ull; /* start by asking for 32GB */ -#else - /* We used to start with 2GB here, but on Windows 7 that would leave - too little room in the address space for threads started by - Windows on our behalf, e.g. when we pop up the file selection - dialog. */ - size_t size = 0x68000000; /* start by asking for 1.7GB */ -#endif - void *ptr = NULL; - - while (!ptr && size > 0x00100000) - { - reserved_heap_size = size; - ptr = VirtualAlloc (NULL, - get_reserved_heap_size (), - MEM_RESERVE, - PAGE_NOACCESS); - size -= 0x00800000; /* if failed, decrease request by 8MB */ - } - - return ptr; -} -#endif /* USE_LSB_TAG */ - - -/* Emulate Unix sbrk. Note that ralloc.c expects the return value to - be the address of the _start_ (not end) of the new block in case of - success, and zero (not -1) in case of failure. */ -void * -sbrk (ptrdiff_t increment) -{ - void *result; - ptrdiff_t size = increment; - - result = data_region_end; - - /* If size is negative, shrink the heap by decommitting pages. */ - if (size < 0) - { - ptrdiff_t new_size; - unsigned char *new_data_region_end; - - size = -size; - - /* Sanity checks. */ - if ((data_region_end - size) < data_region_base) - return NULL; - - /* We can only decommit full pages, so allow for - partial deallocation [cga]. */ - new_data_region_end = (data_region_end - size); - new_data_region_end = (unsigned char *) - ((DWORD_PTR) (new_data_region_end + syspage_mask) & ~syspage_mask); - new_size = real_data_region_end - new_data_region_end; - real_data_region_end = new_data_region_end; - if (new_size > 0) - { - /* Decommit size bytes from the end of the heap. */ - if (using_dynamic_heap - && !VirtualFree (real_data_region_end, new_size, MEM_DECOMMIT)) - return NULL; - } - - data_region_end -= size; - } - /* If size is positive, grow the heap by committing reserved pages. */ - else if (size > 0) - { - /* Sanity checks. */ - if ((data_region_end + size) > - (data_region_base + get_reserved_heap_size ())) - return NULL; - - /* Commit more of our heap. */ - if (using_dynamic_heap - && VirtualAlloc (data_region_end, size, MEM_COMMIT, - PAGE_READWRITE) == NULL) - return NULL; - data_region_end += size; - - /* We really only commit full pages, so record where - the real end of committed memory is [cga]. */ - real_data_region_end = (unsigned char *) - ((DWORD_PTR) (data_region_end + syspage_mask) & ~syspage_mask); - } - - return result; -} - -/* Initialize the internal heap variables used by sbrk. When running in - preload phase (ie. in the undumped executable), we rely entirely on a - fixed size heap section included in the .exe itself; this is - preserved during dumping, and truncated to the size actually used. - - When running in the dumped executable, we reserve as much as possible - of the address range that is addressable by Lisp object pointers, to - supplement what is left of the preload heap. Although we cannot rely - on the dynamically allocated arena being contiguous with the static - heap area, it is not a problem because sbrk can pretend that the gap - was allocated by something else; GNU malloc detects when there is a - jump in the sbrk values, and starts a new heap block. */ +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 and 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 largest 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 like depicted below: + + ---------------------------------------------- + | | | | + | Private heap |-> <-| Big chunks | + | | | | + ---------------------------------------------- + ^ ^ ^ + dumped_data dumped_data bc_limit + + committed + +*/ +#define HEAP_ENTRY_SHIFT 3 +#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, + - outside of it after dump. +*/ +HANDLE heap = NULL; + +/* We redirect the standard allocation functions. */ +malloc_fn the_malloc_fn; +realloc_fn the_realloc_fn; +free_fn the_free_fn; + +/* It doesn't seem to be useful to allocate from a file mapping. + It would be if the memory was shared. + http://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, we allocate space + from the fixed size dumped_data[] array. +*/ +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; + if (((unsigned char *)(*CommitAddress)) + *CommitSize >= bc_limit) + { + /* Check that the private heap area does not overlap the big + chunks area. */ + fprintf(stderr, + "dumped_data_commit: memory exhausted.\nEnlarge dumped_data[]!\n"); + exit (-1); + } + return 0; +} + +/* Heap creation. */ + +/* Under MinGW32, we want to turn on Low Fragmentation Heap for XP. + MinGW32 lacks those definitions. */ +#ifndef _W64 +typedef enum _HEAP_INFORMATION_CLASS { + HeapCompatibilityInformation +} HEAP_INFORMATION_CLASS; + +typedef WINBASEAPI BOOL (WINAPI * HeapSetInformation_Proc)(HANDLE,HEAP_INFORMATION_CLASS,PVOID,SIZE_T); +#endif + void init_heap (void) { - PIMAGE_DOS_HEADER dos_header; - PIMAGE_NT_HEADERS nt_header; - - dos_header = (PIMAGE_DOS_HEADER) RVA_TO_PTR (0); - nt_header = (PIMAGE_NT_HEADERS) (((DWORD_PTR) dos_header) + - dos_header->e_lfanew); - preload_heap_section = find_section ("EMHEAP", nt_header); - if (using_dynamic_heap) { - data_region_base = allocate_heap (); - if (!data_region_base) - { - printf ("Error: Could not reserve dynamic heap area.\n"); - exit (1); - } - -#if !USE_LSB_TAG - /* Ensure that the addresses don't use the upper tag bits since - the Lisp type goes there. */ - if (((DWORD_PTR) data_region_base & ~VALMASK) != 0) - { - printf ("Error: The heap was allocated in upper memory.\n"); - exit (1); - } + unsigned long enable_lfh = 2; + + /* After dumping, use a new private heap. We explicitly enable + the low fragmentation heap here, for the sake of pre Vista + versions. Note: this will harnlessly fail on Vista and + later, whyere 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 + http://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 _W64 + /* Set the low-fragmentation heap for OS before XP and Windows + Server 2003. */ + HMODULE hm_kernel32dll = LoadLibrary("kernel32.dll"); + HeapSetInformation_Proc s_pfn_Heap_Set_Information = (HeapSetInformation_Proc) GetProcAddress(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\n")); #endif - data_region_end = data_region_base; - real_data_region_end = data_region_end; + + the_malloc_fn = malloc_after_dump; + the_realloc_fn = realloc_after_dump; + the_free_fn = free_after_dump; } else { - data_region_base = RVA_TO_PTR (preload_heap_section->VirtualAddress); - data_region_end = data_region_base; - real_data_region_end = data_region_end; - reserved_heap_size = preload_heap_section->Misc.VirtualSize; + /* 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) GetProcAddress (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. */ + heap = s_pfn_Rtl_Create_Heap (0, data_region_base, 0, 0, NULL, ¶ms); + the_malloc_fn = malloc_before_dump; + the_realloc_fn = realloc_before_dump; + the_free_fn = free_before_dump; } /* Update system version information to match current system. */ cache_system_info (); } -/* Round the heap up to the given alignment. */ -void -round_heap (size_t align) -{ - DWORD_PTR needs_to_be; - DWORD_PTR need_to_alloc; - - needs_to_be = (DWORD_PTR) ROUND_UP (get_heap_end (), align); - need_to_alloc = needs_to_be - (DWORD_PTR) get_heap_end (); - - if (need_to_alloc) - sbrk (need_to_alloc); +#undef malloc +#undef realloc +#undef calloc +#undef free + +/* FREEABLE_P checks if the block can be safely freed. */ +#define FREEABLE_P(addr) \ + ((unsigned char *)(addr) < dumped_data \ + || (unsigned char *)(addr) >= dumped_data + DUMPED_HEAP_SIZE) + +void * +malloc_after_dump (size_t size) +{ + /* Use the new private heap. */ + void *p = HeapAlloc (heap, 0, size); + + /* After dump, keep track of the last allocated byte for sbrk(0). */ + data_region_end = p + size - 1; + return p; +} + +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 = HeapAlloc (heap, 0, 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++; + if (bc_limit < dumped_data + committed) + { + /* Check that areas do not overlap. */ + 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 * +realloc_after_dump (void *ptr, size_t size) +{ + void *p; + + /* After dumping. */ + if (FREEABLE_P (ptr)) + { + /* Reallocate the block since it lies in the new heap. */ + p = HeapReAlloc (heap, 0, ptr, size); + } + else + { + /* If the block lies in the dumped data, do not free it. Only + allocate a new one. */ + p = HeapAlloc (heap, 0, size); + CopyMemory (p, ptr, size); + } + /* After dump, keep track of the last allocated byte for sbrk(0). */ + data_region_end = p + size - 1; + 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 = HeapReAlloc (heap, 0, 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); + 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) +{ + /* After dumping. */ + if (FREEABLE_P (ptr)) + { + /* Free the block if it is in the new private heap. */ + HeapFree (heap, 0, ptr); + } +} + +void +free_before_dump (void *ptr) +{ + /* 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); + } + } +} + +/* Emulate getpagesize. */ +int +getpagesize (void) +{ + return sysinfo_cache.dwPageSize; +} + +void * +sbrk (ptrdiff_t increment) +{ + /* The data_region_end address is the one of the last byte + allocated. The sbrk() function is not emulated at all, except + for a 0 value of its parameter. This is needed by the emacs lisp + function `memory-limit'. */ + return data_region_end; +} + +#define MAX_BUFFER_SIZE (512 * 1024 * 1024) + +/* MMAP allocation for buffers. */ +void * +mmap_alloc (void **var, size_t nbytes) +{ + void *p = NULL; + + /* We implement amortized allocation. We start by reserving twice + the size requested and commit only the size requested. Then + realloc could proceed and use the reserved pages, reallocating + only if needed. Buffer shrink would happen only so that we stay + in the 2x range. This is a big win when visiting compressed + files, where the final size of the buffer is not known in + advance, and the buffer is enlarged several times as the data is + decompressed on the fly. */ + if (nbytes < MAX_BUFFER_SIZE) + p = VirtualAlloc (NULL, (nbytes * 2), MEM_RESERVE, PAGE_READWRITE); + + /* If it fails, or if the request is above 512MB, try with the + requested size. */ + if (p == NULL) + p = VirtualAlloc (NULL, nbytes, MEM_RESERVE, PAGE_READWRITE); + + if (p != NULL) + { + /* Now, commit pages for NBYTES. */ + *var = VirtualAlloc (p, nbytes, MEM_COMMIT, PAGE_READWRITE); + } + + if (!p && GetLastError () != ERROR_NOT_ENOUGH_MEMORY) + DebPrint (("mmap_alloc: error %ld\n", GetLastError())); + + return *var = p; +} + +void +mmap_free (void **var) +{ + if (*var) + { + if (VirtualFree (*var, 0, MEM_RELEASE) == 0) + DebPrint (("mmap_free: error %ld\n", GetLastError())); + *var = NULL; + } +} + +void * +mmap_realloc (void **var, size_t nbytes) +{ + MEMORY_BASIC_INFORMATION memInfo, m2; + + if (*var == NULL) + return mmap_alloc (var, nbytes); + + /* This case happens in init_buffer(). */ + if (nbytes == 0) + { + mmap_free (var); + return mmap_alloc (var, nbytes); + } + + if (VirtualQuery (*var, &memInfo, sizeof (memInfo)) == 0) + DebPrint (("mmap_realloc: VirtualQuery error = %ld\n", GetLastError())); + + /* We need to enlarge the block. */ + if (memInfo.RegionSize < nbytes) + { + if (VirtualQuery (*var + memInfo.RegionSize, &m2, sizeof(m2)) == 0) + DebPrint (("mmap_realloc: VirtualQuery error = %ld\n", GetLastError())); + /* If there is enough room in the current reserved area, then + commit more pages as needed. */ + if (m2.State == MEM_RESERVE + && nbytes <= memInfo.RegionSize + m2.RegionSize) + { + void *p; + + p = VirtualAlloc (*var + memInfo.RegionSize, + nbytes - memInfo.RegionSize, + MEM_COMMIT, PAGE_READWRITE); + if (!p /* && GetLastError() != ERROR_NOT_ENOUGH_MEMORY */) + DebPrint (("realloc enlarge: VirtualAlloc error %ld\n", + GetLastError())); + return *var; + } + else + { + /* Else we must actually enlarge the block by allocating a + new one and copying previous contents from the old to the + new one. */ + void *old_ptr = *var; + + if (mmap_alloc (var, nbytes)) + { + CopyMemory (*var, old_ptr, memInfo.RegionSize); + mmap_free (&old_ptr); + return *var; + } + else + { + /* We failed to enlarge the buffer. */ + *var = old_ptr; + return NULL; + } + } + } + + /* If we are shrinking by more than one page... */ + if (memInfo.RegionSize > nbytes + getpagesize()) + { + /* If we are shrinking a lot... */ + if ((memInfo.RegionSize / 2) > nbytes) + { + /* Let's give some memory back to the system and release + some pages. */ + void *old_ptr = *var; + + if (mmap_alloc (var, nbytes)) + { + CopyMemory (*var, old_ptr, nbytes); + mmap_free (&old_ptr); + return *var; + } + else + { + /* In case we fail to shrink, try to go on with the old block. + But that means there is a lot of memory pressure. + We could also decommit pages. */ + *var = old_ptr; + return *var; + } + } + + /* We still can decommit pages. */ + if (VirtualFree (*var + nbytes + get_page_size(), + memInfo.RegionSize - nbytes - get_page_size(), + MEM_DECOMMIT) == 0) + DebPrint (("mmap_realloc: VirtualFree error %ld\n", GetLastError())); + return *var; + } + + /* Not enlarging, not shrinking by more than one page. */ + return *var; } === modified file 'src/w32heap.h' --- src/w32heap.h 2014-01-01 07:43:34 +0000 +++ src/w32heap.h 2014-05-27 17:31:17 +0000 @@ -27,15 +27,20 @@ /* * Heap related stuff. */ -#define get_reserved_heap_size() reserved_heap_size -#define get_committed_heap_size() (get_data_end () - get_data_start ()) -#define get_heap_start() get_data_start () -#define get_heap_end() get_data_end () + +#define DUMPED_HEAP_SIZE (HEAPSIZE*1024*1024) + +extern unsigned char dumped_data[]; extern unsigned char *get_data_start (void); extern unsigned char *get_data_end (void); extern size_t reserved_heap_size; -extern BOOL using_dynamic_heap; +extern BOOL using_dynamic_heap; + +extern void *mmap_realloc (void **, size_t); +extern void mmap_free (void **); +extern void *mmap_alloc (void **, size_t); + /* Emulation of Unix sbrk(). */ extern void *sbrk (ptrdiff_t size); @@ -43,11 +48,8 @@ /* Initialize heap structures for sbrk on startup. */ extern void init_heap (void); -/* Round the heap to this size. */ -extern void round_heap (size_t size); - /* ----------------------------------------------------------------- */ -/* Useful routines for manipulating memory-mapped files. */ +/* Useful routines for manipulating memory-mapped files. */ typedef struct file_data { char *name; @@ -61,11 +63,11 @@ int open_output_file (file_data *p_file, char *name, unsigned long size); void close_file_data (file_data *p_file); -/* Return pointer to section header for named section. */ +/* Return pointer to section header for named section. */ IMAGE_SECTION_HEADER * find_section (char * name, IMAGE_NT_HEADERS * nt_header); /* Return pointer to section header for section containing the given - relative virtual address. */ + relative virtual address. */ IMAGE_SECTION_HEADER * rva_to_section (DWORD_PTR rva, IMAGE_NT_HEADERS * nt_header); #endif /* NTHEAP_H_ */ ------------------------------------------------------------ revno: 117167 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2014-05-27 10:36:07 -0400 message: * lisp/register.el (register-read-with-preview): Don't burp on frame switches (e.g. due to the frame we just popped). diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-05-27 05:01:49 +0000 +++ lisp/ChangeLog 2014-05-27 14:36:07 +0000 @@ -1,5 +1,8 @@ 2014-05-27 Stefan Monnier + * register.el (register-read-with-preview): Don't burp on + frame switches (e.g. due to the frame we just popped). + * mouse.el (mouse-set-region): Handle spurious drag events (bug#17562). (mouse-drag-track): Annotate `mouse-drag-start' so we know we moved. === modified file 'lisp/register.el' --- lisp/register.el 2014-03-16 09:26:58 +0000 +++ lisp/register.el 2014-05-27 14:36:07 +0000 @@ -161,7 +161,7 @@ collect c))) (unwind-protect (progn - (while (memq (read-event (propertize prompt 'face 'minibuffer-prompt)) + (while (memq (read-key (propertize prompt 'face 'minibuffer-prompt)) help-chars) (unless (get-buffer-window buffer) (register-preview buffer 'show-empty))) ------------------------------------------------------------ revno: 117166 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2014-05-27 10:28:07 -0400 message: * test/indent/ps-mode.ps: New file. * test/automated/core-elisp-tests.el (core-elisp-test-window-configurations): New test. * test/indent/octave.m: Add a few more tests. * test/indent/ruby.rb: Add one more test. diff: === modified file 'test/ChangeLog' --- test/ChangeLog 2014-05-26 16:52:28 +0000 +++ test/ChangeLog 2014-05-27 14:28:07 +0000 @@ -1,3 +1,14 @@ +2014-05-27 Stefan Monnier + + * indent/ruby.rb: Add one more test. + + * indent/ps-mode.ps: New file. + + * indent/octave.m: Add a few more tests. + + * automated/core-elisp-tests.el + (core-elisp-test-window-configurations): New test. + 2014-05-26 Glenn Morris * automated/package-test.el (package-test-install-single): === modified file 'test/automated/core-elisp-tests.el' --- test/automated/core-elisp-tests.el 2014-01-01 07:43:34 +0000 +++ test/automated/core-elisp-tests.el 2014-05-27 14:28:07 +0000 @@ -36,5 +36,14 @@ c-e-x) '(1 2))))) +(ert-deftest core-elisp-test-window-configurations () + "Test properties of window-configurations." + (let ((wc (current-window-configuration))) + (with-current-buffer (window-buffer (frame-selected-window)) + (push-mark) + (activate-mark)) + (set-window-configuration wc) + (should (or (not mark-active) (mark))))) + (provide 'core-elisp-tests) ;;; core-elisp-tests.el ends here === modified file 'test/indent/octave.m' --- test/indent/octave.m 2013-05-29 06:50:48 +0000 +++ test/indent/octave.m 2014-05-27 14:28:07 +0000 @@ -14,7 +14,15 @@ y = 'hello'; z = y'; + ## Bug#14399. + vec = [... + one;... + two;... + three]; + cnty = repmat(x(:,1)(:), 10, 1); + x = ... + 12 pop = x(:,1:10)(:); ## Here and below, we test if the indentation aligns with a previous === added file 'test/indent/ps-mode.ps' --- test/indent/ps-mode.ps 1970-01-01 00:00:00 +0000 +++ test/indent/ps-mode.ps 2014-05-27 14:28:07 +0000 @@ -0,0 +1,14 @@ +%!PS-2.0 + +<< 23 45 >> %dictionary +< 23 > %hex string +<~a>a%a~> %base85 string +(%)s +(sf\(g>a)sdg) + +/foo { + << + hello 2 + 3 + >> +} def === modified file 'test/indent/ruby.rb' --- test/indent/ruby.rb 2014-05-10 20:07:01 +0000 +++ test/indent/ruby.rb 2014-05-27 14:28:07 +0000 @@ -6,6 +6,10 @@ foo end +def foo + %^bar^ +end + # Percent literals. b = %Q{This is a "string"} c = %w!foo ------------------------------------------------------------ revno: 117165 author: Paul Eggert committer: Paul Eggert branch nick: trunk timestamp: Mon 2014-05-26 23:37:29 -0700 message: * image.c (imagemagick_load_image): Use MagickRealType for local 'color_scale', instead of double, to avoid a GCC warning about double promotion. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2014-05-27 06:35:54 +0000 +++ src/ChangeLog 2014-05-27 06:37:29 +0000 @@ -1,5 +1,9 @@ 2014-05-27 Paul Eggert + * image.c (imagemagick_load_image): Use MagickRealType for local + 'color_scale', instead of double, to avoid a GCC warning about + double promotion. + * xfns.c (Fx_window_property): Remove unused local. Don't kill already-reaped process (Bug#17561). === modified file 'src/image.c' --- src/image.c 2014-05-21 19:51:58 +0000 +++ src/image.c 2014-05-27 06:37:29 +0000 @@ -8368,7 +8368,7 @@ #endif /* HAVE_MAGICKEXPORTIMAGEPIXELS */ { size_t image_height; - double color_scale = 65535.0 / QuantumRange; + MagickRealType color_scale = 65535.0 / QuantumRange; /* Try to create a x pixmap to hold the imagemagick pixmap. */ if (!image_create_x_image_and_pixmap (f, img, width, height, 0,