[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 1400165 3/5: Merge from origin/emacs-25
|
From: |
John Wiegley |
|
Subject: |
[Emacs-diffs] master 1400165 3/5: Merge from origin/emacs-25 |
|
Date: |
Tue, 19 Jan 2016 07:18:08 +0000 |
branch: master
commit 140016558bcb462692d8b9f2f3f866e0f337d218
Merge: 7823745 3ae7934
Author: John Wiegley <address@hidden>
Commit: John Wiegley <address@hidden>
Merge from origin/emacs-25
3ae7934 ; * etc/NEWS: Mark entries that don't need further treatment.
6165c36 * lisp/files.el (dir-locals--all-files): Respect absolute file-names
2ffdf15 * lisp/help-fns.el (describe-variable): Fix a left-over parenthesis
71ecd62 * lisp/dired-x.el (dired-omit-here-always): Use
add-dir-local-variable
f0b82b3 * lisp/files.el (dir-locals--all-files): Use completion instead of
wildcards
86e4513 Fix incompatbilities with MS-Windows 2000 and older
4e96521 Mention in PROBLEMS an issue with MS-Windows NT4
15c23aa Ensure 8-byte aligned memory allocation on MS-Windows 9X
39afa42 Fix tests for active region in hideif.el
05df666 Fix interactive specs in some hideif.el commands
---
etc/NEWS | 5 ++-
etc/PROBLEMS | 7 ++++
lisp/dired-x.el | 14 +++----
lisp/dos-fns.el | 4 +-
lisp/files-x.el | 6 +--
lisp/files.el | 24 +++++++-----
lisp/help-fns.el | 27 +++++++-------
lisp/progmodes/hideif.el | 27 ++++++++++----
nt/inc/ms-w32.h | 4 ++
src/w32.c | 23 ++++++++----
src/w32.h | 1 +
src/w32fns.c | 42 +++++++++++++--------
src/w32heap.c | 89 ++++++++++++++++++++++++++++++++++++++++++---
13 files changed, 195 insertions(+), 78 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index 66e8e77..56f0ec3 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1484,8 +1484,6 @@ buffers to allow certain parts of the text to be writable.
+++
** New macro `define-advice'.
-** `read-buffer' takes a new `predicate' argument.
-
+++
** Emacs Lisp now supports generators.
See the "Generators" section of the ELisp manual for the details.
@@ -1495,6 +1493,7 @@ See the "Generators" section of the ELisp manual for the
details.
See the "Finalizer Type" subsection in the ELisp manual for the
details.
+---
** lexical closures can use (:documentation FORM) to build their docstring.
It should be placed right where the docstring would be, and FORM is then
evaluated (and should return a string) when the closure is built.
@@ -1570,6 +1569,7 @@ permissions set to temporary values (e.g., for creating
private files).
+++
** You can access the slots of structures using `cl-struct-slot-value'.
++++
** Function `sort' can deal with vectors.
** Function `system-name' now returns an updated value if the current
@@ -1797,6 +1797,7 @@ frames.
`window-divider-default-places', `window-divider-default-bottom-width'
and `window-divider-default-right-width'.
+---
** Tearoff menus and detachable toolbars for Gtk+ have been removed.
Those features have been deprecated in Gtk+ for a long time.
diff --git a/etc/PROBLEMS b/etc/PROBLEMS
index 58faef2..7d78037 100644
--- a/etc/PROBLEMS
+++ b/etc/PROBLEMS
@@ -1966,6 +1966,13 @@ runtime shared library, distributed with Windows 9X.
A workaround is to build Emacs with MinGW runtime 3.x (the latest
version is 3.20).
+** addpm fails to run on Windows NT4, complaining about Shell32.dll
+
+This is likely to happen because Shell32.dll shipped with NT4 lacks
+the updates required by Emacs. Installing Internet Explorer 4 solves
+the problem. Note that it is NOT enough to install IE6, because doing
+so will not install the Shell32.dll update.
+
** A few seconds delay is seen at startup and for many file operations
This happens when the Net Logon service is enabled. During Emacs
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
index 053b3cb..e8cea85 100644
--- a/lisp/dired-x.el
+++ b/lisp/dired-x.el
@@ -816,16 +816,14 @@ If in a Dired buffer, reverts it."
(interactive)
(if (file-exists-p dired-local-variables-file)
(error "Old-style dired-local-variables-file `./%s' found;
-replace it with a dir-locals-file `./%s'"
+replace it with a dir-locals-file `./%s.el'"
dired-local-variables-file
dir-locals-file))
- (if (file-exists-p dir-locals-file)
- (message "File `./%s' already exists." dir-locals-file)
- (with-temp-buffer
- (insert "\
-\((dired-mode . ((subdirs . nil)
- (dired-omit-mode . t))))\n")
- (write-file dir-locals-file))
+ (if (dir-locals--all-files default-directory)
+ (message "File `./%s' already exists."
+ (car (dir-locals--all-files default-directory)))
+ (add-dir-local-variable 'dired-mode 'subdirs nil)
+ (add-dir-local-variable 'dired-mode 'dired-omit-mode t)
;; Run extra-hooks and revert directory.
(when (derived-mode-p 'dired-mode)
(hack-dir-local-variables-non-file-buffer)
diff --git a/lisp/dos-fns.el b/lisp/dos-fns.el
index 7defb38..0ce2b23 100644
--- a/lisp/dos-fns.el
+++ b/lisp/dos-fns.el
@@ -201,8 +201,8 @@ that are used in Emacs Lisp sources; any other file name
will be
returned unaltered."
(cond
;; See files.el:dir-locals-file.
- ((string= file-name ".dir-locals.el")
- "_dir-locals.el")
+ ((string= file-name ".dir-locals")
+ "_dir-locals")
(t
file-name)))
diff --git a/lisp/files-x.el b/lisp/files-x.el
index ed3d49d..2e1a728 100644
--- a/lisp/files-x.el
+++ b/lisp/files-x.el
@@ -444,10 +444,8 @@ from the MODE alist ignoring the input argument VALUE."
(if (nth 2 variables-file)
(car (last (dir-locals--all-files (car
variables-file))))
(cadr variables-file)))
- ;; Try to make a proper file-name. This doesn't cover all
- ;; wildcards, but it covers the default value of
`dir-locals-file'.
- (t (replace-regexp-in-string
- "\\*" "" (replace-regexp-in-string "\\?" "-"
dir-locals-file)))))
+ ;; Try to make a proper file-name.
+ (t (concat dir-locals-file ".el"))))
;; I can't be bothered to handle this case right now.
;; Dir locals were set directly from a class. You need to
;; directly modify the class in dir-locals-class-alist.
diff --git a/lisp/files.el b/lisp/files.el
index 9cb46fc..5a15c71 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -3713,7 +3713,7 @@ VARIABLES list of the class. The list is processed in
order.
applied by recursively following these rules."
(setf (alist-get class dir-locals-class-alist) variables))
-(defconst dir-locals-file ".dir-locals*.el"
+(defconst dir-locals-file ".dir-locals"
"Pattern for files that contain directory-local variables.
It has to be constant to enforce uniform values across different
environments and users.
@@ -3730,16 +3730,20 @@ return a sorted list of all files matching
`dir-locals-file' in
this directory.
The returned list is sorted by `string<' order."
(require 'seq)
- (let ((default-directory (if (file-directory-p file-or-dir)
- file-or-dir
- default-directory)))
+ (let ((dir (if (file-directory-p file-or-dir)
+ file-or-dir
+ (or (file-name-directory file-or-dir)
+ default-directory)))
+ (file (cond ((not (file-directory-p file-or-dir))
(file-name-nondirectory file-or-dir))
+ ((eq system-type 'ms-dos) (dosified-file-name
dir-locals-file))
+ (t dir-locals-file))))
(seq-filter (lambda (f) (and (file-readable-p f)
- (file-regular-p f)))
- (file-expand-wildcards
- (cond ((not (file-directory-p file-or-dir)) file-or-dir)
- ((eq system-type 'ms-dos) (dosified-file-name
dir-locals-file))
- (t dir-locals-file))
- 'full))))
+ (file-regular-p f)
+ (not (file-directory-p f))))
+ (mapcar (lambda (f) (expand-file-name f dir))
+ (nreverse
+ (let ((completion-regexp-list '("\\.el\\'")))
+ (file-name-all-completions file dir)))))))
(defun dir-locals-find-file (file)
"Find the directory-local variables for FILE.
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index bc96601..2021885 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -918,29 +918,28 @@ if it is given a local binding.\n"))))
;; If the cache element has an mtime, we
;; assume it came from a file.
(if (nth 2 file)
- (setq file (expand-file-name
- dir-locals-file (car file)))
+ ;; (car file) is a directory.
+ (setq file (dir-locals--all-files (car file)))
;; Otherwise, assume it was set directly.
(setq file (car file)
is-directory t)))
(if (null file)
(princ ".\n")
(princ ", set ")
- (let ((files (file-expand-wildcards file)))
- (princ (substitute-command-keys
- (cond
- (is-directory "for the directory\n `")
- ;; Many files matched.
- ((cdr files)
- (setq file (file-name-directory (car
files)))
- (format "by a file\n matching `%s' in the
directory\n `"
- dir-locals-file))
- (t (setq file (car files))
- "by the file\n `"))))
+ (princ (substitute-command-keys
+ (cond
+ (is-directory "for the directory\n `")
+ ;; Many files matched.
+ ((and (consp file) (cdr file))
+ (setq file (file-name-directory (car file)))
+ (format "by one of the\n %s files in the
directory\n `"
+ dir-locals-file))
+ (t (setq file (car file))
+ "by the file\n `"))))
(with-current-buffer standard-output
(insert-text-button
file 'type 'help-dir-local-var-def
- 'help-args (list variable file))))
+ 'help-args (list variable file)))
(princ (substitute-command-keys "'.\n"))))
(princ (substitute-command-keys
" This variable's value is file-local.\n"))))
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el
index cc7d1c3..8a87eb9 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -1581,14 +1581,17 @@ Refer to `hide-ifdef-expand-reinclusion-protection' for
more details."
result))
(defun hif-evaluate-macro (rstart rend)
- "Evaluate the macro expansion result for a region.
+ "Evaluate the macro expansion result for the active region.
If no region active, find the current #ifdefs and evaluate the result.
Currently it supports only math calculations, strings or argumented macros can
not be expanded."
- (interactive "r")
+ (interactive
+ (if (use-region-p)
+ (list (region-beginning) (region-end))
+ '(nil nil)))
(let ((case-fold-search nil))
(save-excursion
- (unless mark-active
+ (unless (use-region-p)
(setq rstart nil rend nil)
(beginning-of-line)
(when (and (re-search-forward hif-macro-expr-prefix-regexp nil t)
@@ -1844,9 +1847,13 @@ This allows #ifdef VAR to be hidden."
(defun hide-ifdef-undef (start end)
"Undefine a VAR so that #ifdef VAR would not be included."
- (interactive "r")
+ (interactive
+ (if (use-region-p)
+ (list (region-beginning) (region-end))
+ '(nil nil)))
(let* ((symstr
- (or (and mark-active
+ (or (and (number-or-marker-p start)
+ (number-or-marker-p end)
(buffer-substring-no-properties start end))
(read-string "Undefine what? " (current-word))))
(sym (and symstr
@@ -1915,7 +1922,7 @@ Return as (TOP . BOTTOM) the extent of ifdef block."
With optional prefix argument ARG, also hide the #ifdefs themselves."
(interactive "P\nr")
(let ((hide-ifdef-lines arg))
- (if mark-active
+ (if (use-region-p)
(let ((hif-recurse-level (1+ hif-recurse-level)))
(hif-recurse-on start end t)
(setq mark-active nil))
@@ -1931,8 +1938,12 @@ With optional prefix argument ARG, also hide the #ifdefs
themselves."
(defun show-ifdef-block (&optional start end)
"Show the ifdef block (true or false part) enclosing or before the cursor."
- (interactive "r")
- (if mark-active
+ (interactive
+ (if (use-region-p)
+ (list (region-beginning) (region-end))
+ '(nil nil)))
+ (if (and (number-or-marker-p start)
+ (number-or-marker-p end))
(progn
(dolist (o (overlays-in start end))
(if (overlay-get o 'hide-ifdef)
diff --git a/nt/inc/ms-w32.h b/nt/inc/ms-w32.h
index cdbfac0..a37510e 100644
--- a/nt/inc/ms-w32.h
+++ b/nt/inc/ms-w32.h
@@ -457,6 +457,10 @@ extern void *malloc_after_dump(size_t);
extern void *realloc_after_dump(void *, size_t);
extern void free_after_dump(void *);
+extern void *malloc_after_dump_9x(size_t);
+extern void *realloc_after_dump_9x(void *, size_t);
+extern void free_after_dump_9x(void *);
+
extern malloc_fn the_malloc_fn;
extern realloc_fn the_realloc_fn;
extern free_fn the_free_fn;
diff --git a/src/w32.c b/src/w32.c
index ea3a9da..183a4e7 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -484,6 +484,7 @@ typedef DWORD (WINAPI *GetAdaptersInfo_Proc) (
int (WINAPI *pMultiByteToWideChar)(UINT,DWORD,LPCSTR,int,LPWSTR,int);
int (WINAPI
*pWideCharToMultiByte)(UINT,DWORD,LPCWSTR,int,LPSTR,int,LPCSTR,LPBOOL);
+DWORD multiByteToWideCharFlags;
/* ** A utility function ** */
static BOOL
@@ -1550,8 +1551,8 @@ codepage_for_filenames (CPINFO *cp_info)
int
filename_to_utf16 (const char *fn_in, wchar_t *fn_out)
{
- int result = pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS, fn_in, -1,
- fn_out, MAX_PATH);
+ int result = pMultiByteToWideChar (CP_UTF8, multiByteToWideCharFlags, fn_in,
+ -1, fn_out, MAX_PATH);
if (!result)
{
@@ -1641,8 +1642,8 @@ filename_from_ansi (const char *fn_in, char *fn_out)
{
wchar_t fn_utf16[MAX_PATH];
int codepage = codepage_for_filenames (NULL);
- int result = pMultiByteToWideChar (codepage, MB_ERR_INVALID_CHARS, fn_in, -1,
- fn_utf16, MAX_PATH);
+ int result = pMultiByteToWideChar (codepage, multiByteToWideCharFlags, fn_in,
+ -1, fn_utf16, MAX_PATH);
if (!result)
{
@@ -9104,14 +9105,14 @@ check_windows_init_file (void)
"not unpacked properly.\nSee the README.W32 file in the "
"top-level Emacs directory for more information.",
init_file_name, load_path);
- needed = pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS, buffer,
- -1, NULL, 0);
+ needed = pMultiByteToWideChar (CP_UTF8, multiByteToWideCharFlags,
+ buffer, -1, NULL, 0);
if (needed > 0)
{
wchar_t *msg_w = alloca ((needed + 1) * sizeof (wchar_t));
- pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS, buffer, -1,
- msg_w, needed);
+ pMultiByteToWideChar (CP_UTF8, multiByteToWideCharFlags, buffer,
+ -1, msg_w, needed);
needed = pWideCharToMultiByte (CP_ACP, 0, msg_w, -1,
NULL, 0, NULL, NULL);
if (needed > 0)
@@ -9298,6 +9299,7 @@ maybe_load_unicows_dll (void)
(MultiByteToWideChar_Proc)GetProcAddress (ret,
"MultiByteToWideChar");
pWideCharToMultiByte =
(WideCharToMultiByte_Proc)GetProcAddress (ret,
"WideCharToMultiByte");
+ multiByteToWideCharFlags = MB_ERR_INVALID_CHARS;
return ret;
}
else
@@ -9327,6 +9329,11 @@ maybe_load_unicows_dll (void)
pointers; no need for the LoadLibrary dance. */
pMultiByteToWideChar = MultiByteToWideChar;
pWideCharToMultiByte = WideCharToMultiByte;
+ /* On NT 4.0, though, MB_ERR_INVALID_CHARS is not supported. */
+ if (w32_major_version < 5)
+ multiByteToWideCharFlags = 0;
+ else
+ multiByteToWideCharFlags = MB_ERR_INVALID_CHARS;
return LoadLibrary ("Gdi32.dll");
}
}
diff --git a/src/w32.h b/src/w32.h
index 501056d..097241b 100644
--- a/src/w32.h
+++ b/src/w32.h
@@ -183,6 +183,7 @@ typedef int (WINAPI
*MultiByteToWideChar_Proc)(UINT,DWORD,LPCSTR,int,LPWSTR,int)
typedef int (WINAPI
*WideCharToMultiByte_Proc)(UINT,DWORD,LPCWSTR,int,LPSTR,int,LPCSTR,LPBOOL);
extern MultiByteToWideChar_Proc pMultiByteToWideChar;
extern WideCharToMultiByte_Proc pWideCharToMultiByte;
+extern DWORD multiByteToWideCharFlags;
extern void init_environment (char **);
extern void check_windows_init_file (void);
diff --git a/src/w32fns.c b/src/w32fns.c
index f3806a9..01f5d6f 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -6984,12 +6984,12 @@ value of DIR as in previous invocations; this is
standard Windows behavior. */)
if (errno == ENOENT && filename_buf_w[MAX_PATH - 1] != 0)
report_file_error ("filename too long", default_filename);
}
- len = pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS,
+ len = pMultiByteToWideChar (CP_UTF8, multiByteToWideCharFlags,
SSDATA (prompt), -1, NULL, 0);
if (len > 32768)
len = 32768;
prompt_w = alloca (len * sizeof (wchar_t));
- pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS,
+ pMultiByteToWideChar (CP_UTF8, multiByteToWideCharFlags,
SSDATA (prompt), -1, prompt_w, len);
}
else
@@ -7002,12 +7002,12 @@ value of DIR as in previous invocations; this is
standard Windows behavior. */)
if (errno == ENOENT && filename_buf_a[MAX_PATH - 1] != 0)
report_file_error ("filename too long", default_filename);
}
- len = pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS,
+ len = pMultiByteToWideChar (CP_UTF8, multiByteToWideCharFlags,
SSDATA (prompt), -1, NULL, 0);
if (len > 32768)
len = 32768;
prompt_w = alloca (len * sizeof (wchar_t));
- pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS,
+ pMultiByteToWideChar (CP_UTF8, multiByteToWideCharFlags,
SSDATA (prompt), -1, prompt_w, len);
len = pWideCharToMultiByte (CP_ACP, 0, prompt_w, -1, NULL, 0, NULL,
NULL);
if (len > 32768)
@@ -7489,10 +7489,10 @@ a ShowWindow flag:
current_dir = ENCODE_FILE (current_dir);
/* Cannot use filename_to_utf16/ansi with DOCUMENT, since it could
be a URL that is not limited to MAX_PATH chararcters. */
- doclen = pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS,
+ doclen = pMultiByteToWideChar (CP_UTF8, multiByteToWideCharFlags,
SSDATA (document), -1, NULL, 0);
doc_w = xmalloc (doclen * sizeof (wchar_t));
- pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS,
+ pMultiByteToWideChar (CP_UTF8, multiByteToWideCharFlags,
SSDATA (document), -1, doc_w, doclen);
if (use_unicode)
{
@@ -7507,12 +7507,12 @@ a ShowWindow flag:
int len;
parameters = ENCODE_SYSTEM (parameters);
- len = pMultiByteToWideChar (CP_ACP, MB_ERR_INVALID_CHARS,
+ len = pMultiByteToWideChar (CP_ACP, multiByteToWideCharFlags,
SSDATA (parameters), -1, NULL, 0);
if (len > 32768)
len = 32768;
params_w = alloca (len * sizeof (wchar_t));
- pMultiByteToWideChar (CP_ACP, MB_ERR_INVALID_CHARS,
+ pMultiByteToWideChar (CP_ACP, multiByteToWideCharFlags,
SSDATA (parameters), -1, params_w, len);
params_w[len - 1] = 0;
}
@@ -8959,7 +8959,7 @@ add_tray_notification (struct frame *f, const char *icon,
const char *tip,
later versions support up to 128. */
if (nidw.cbSize == MYNOTIFYICONDATAW_V1_SIZE)
{
- tiplen = pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS,
+ tiplen = pMultiByteToWideChar (CP_UTF8, multiByteToWideCharFlags,
tip, utf8_mbslen_lim (tip, 63),
tipw, 64);
if (tiplen >= 63)
@@ -8967,7 +8967,7 @@ add_tray_notification (struct frame *f, const char *icon,
const char *tip,
}
else
{
- tiplen = pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS,
+ tiplen = pMultiByteToWideChar (CP_UTF8, multiByteToWideCharFlags,
tip, utf8_mbslen_lim (tip, 127),
tipw, 128);
if (tiplen >= 127)
@@ -8986,7 +8986,7 @@ add_tray_notification (struct frame *f, const char *icon,
const char *tip,
{
int slen;
- slen = pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS,
+ slen = pMultiByteToWideChar (CP_UTF8, multiByteToWideCharFlags,
msg, utf8_mbslen_lim (msg, 255),
msgw, 256);
if (slen >= 255)
@@ -8999,7 +8999,7 @@ add_tray_notification (struct frame *f, const char *icon,
const char *tip,
}
wcscpy (nidw.szInfo, msgw);
nidw.uTimeout = timeout;
- slen = pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS,
+ slen = pMultiByteToWideChar (CP_UTF8, multiByteToWideCharFlags,
title, utf8_mbslen_lim (title, 63),
titlew, 64);
if (slen >= 63)
@@ -9670,6 +9670,12 @@ static PVOID except_addr;
/* Stack overflow recovery. */
+/* MinGW headers don't declare this (should be in malloc.h). Also,
+ the function is not present pre-W2K, so make the call through
+ a function pointer. */
+typedef int (__cdecl *_resetstkoflw_proc) (void);
+static _resetstkoflw_proc resetstkoflw;
+
/* Re-establish the guard page at stack limit. This is needed because
when a stack overflow is detected, Windows removes the guard bit
from the guard page, so if we don't re-establish that protection,
@@ -9677,12 +9683,14 @@ static PVOID except_addr;
void
w32_reset_stack_overflow_guard (void)
{
- /* MinGW headers don't declare this (should be in malloc.h). */
- _CRTIMP int __cdecl _resetstkoflw (void);
-
+ if (resetstkoflw == NULL)
+ resetstkoflw =
+ (_resetstkoflw_proc)GetProcAddress (GetModuleHandle ("msvcrt.dll"),
+ "_resetstkoflw");
/* We ignore the return value. If _resetstkoflw fails, the next
stack overflow will crash the program. */
- (void)_resetstkoflw ();
+ if (resetstkoflw != NULL)
+ (void)resetstkoflw ();
}
static void
@@ -9927,6 +9935,8 @@ globals_of_w32fns (void)
after_deadkey = -1;
+ resetstkoflw = NULL;
+
/* MessageBox does not work without this when linked to comctl32.dll 6.0. */
InitCommonControls ();
diff --git a/src/w32heap.c b/src/w32heap.c
index 54646bf..3d1c5ff 100644
--- a/src/w32heap.c
+++ b/src/w32heap.c
@@ -258,9 +258,18 @@ init_heap (void)
}
#endif
- the_malloc_fn = malloc_after_dump;
- the_realloc_fn = realloc_after_dump;
- the_free_fn = free_after_dump;
+ if (os_subtype == OS_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;
+ }
}
else
{
@@ -291,9 +300,18 @@ init_heap (void)
exit (-1);
}
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;
+
+ if (os_subtype == OS_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;
+ }
}
/* Update system version information to match current system. */
@@ -504,6 +522,65 @@ free_before_dump (void *ptr)
}
}
+/* 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
+ on Windows 9X. */
+
+void *
+malloc_after_dump_9x (size_t size)
+{
+ void *p = malloc_after_dump (size + 8);
+ void *pa;
+ if (p == NULL)
+ return p;
+ pa = (void*)(((intptr_t)p + 8) & ~7);
+ *((void**)pa-1) = p;
+ return pa;
+}
+
+void *
+realloc_after_dump_9x (void *ptr, size_t size)
+{
+ if (FREEABLE_P (ptr))
+ {
+ void *po = *((void**)ptr-1);
+ void *p;
+ void *pa;
+ p = realloc_after_dump (po, size + 8);
+ if (p == NULL)
+ return p;
+ pa = (void*)(((intptr_t)p + 8) & ~7);
+ if (ptr != NULL &&
+ (char*)pa - (char*)p != (char*)ptr - (char*)po)
+ {
+ /* Handle the case where alignment in pre-realloc and
+ post-realloc blocks does not match. */
+ MoveMemory (pa, (void*)((char*)p + ((char*)ptr - (char*)po)), size);
+ }
+ *((void**)pa-1) = p;
+ return pa;
+ }
+ else
+ {
+ /* Non-freeable pointers have no alignment-enforcing header
+ (since dumping is not allowed on Windows 9X). */
+ void* p = malloc_after_dump_9x (size);
+ if (p != NULL)
+ CopyMemory (p, ptr, size);
+ return p;
+ }
+}
+
+void
+free_after_dump_9x (void *ptr)
+{
+ if (FREEABLE_P (ptr))
+ {
+ free_after_dump (*((void**)ptr-1));
+ }
+}
+
#ifdef ENABLE_CHECKING
void
report_temacs_memory_usage (void)