------------------------------------------------------------ revno: 117208 fixes bug: http://debbugs.gnu.org/17641 committer: Glenn Morris branch nick: trunk timestamp: Fri 2014-05-30 19:27:22 -0700 message: * lisp/files.el (locate-dominating-file): Expand file argument. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-05-30 23:50:09 +0000 +++ lisp/ChangeLog 2014-05-31 02:27:22 +0000 @@ -1,3 +1,7 @@ +2014-05-31 Glenn Morris + + * files.el (locate-dominating-file): Expand file argument. (Bug#17641) + 2014-05-30 Glenn Morris * loadup.el: Treat `command-line-args' more flexibly. === modified file 'lisp/files.el' --- lisp/files.el 2014-05-21 01:54:33 +0000 +++ lisp/files.el 2014-05-31 02:27:22 +0000 @@ -883,7 +883,7 @@ ;; ;; Represent /home/luser/foo as ~/foo so that we don't try to look for ;; `name' in /home or in /. - (setq file (abbreviate-file-name file)) + (setq file (abbreviate-file-name (expand-file-name file))) (let ((root nil) ;; `user' is not initialized outside the loop because ;; `file' may not exist, so we may have to walk up part of the ------------------------------------------------------------ revno: 117207 committer: Glenn Morris branch nick: trunk timestamp: Fri 2014-05-30 19:50:09 -0400 message: * lisp/loadup.el: Treat `command-line-args' more flexibly. This makes it easier to add --eval ... etc to the command-line without messing things up due to changed argument numbers. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-05-30 17:06:53 +0000 +++ lisp/ChangeLog 2014-05-30 23:50:09 +0000 @@ -1,3 +1,7 @@ +2014-05-30 Glenn Morris + + * loadup.el: Treat `command-line-args' more flexibly. + 2014-05-30 Alan Mackenzie Guard (looking-at "\\s!") from XEmacs. === modified file 'lisp/loadup.el' --- lisp/loadup.el 2014-05-18 22:57:37 +0000 +++ lisp/loadup.el 2014-05-30 23:50:09 +0000 @@ -1,7 +1,7 @@ ;;; loadup.el --- load up standardly loaded Lisp files for Emacs -;; Copyright (C) 1985-1986, 1992, 1994, 2001-2014 Free Software -;; Foundation, Inc. +;; Copyright (C) 1985-1986, 1992, 1994, 2001-2014 +;; Free Software Foundation, Inc. ;; Maintainer: emacs-devel@gnu.org ;; Keywords: internal @@ -46,8 +46,7 @@ ;; Add subdirectories to the load-path for files that might get ;; autoloaded when bootstrapping. ;; This is because PATH_DUMPLOADSEARCH is just "../lisp". -(if (or (equal (nth 3 command-line-args) "bootstrap") - (equal (nth 4 command-line-args) "bootstrap") +(if (or (equal (member "bootstrap" command-line-args) '("bootstrap")) ;; FIXME this is irritatingly fragile. (equal (nth 4 command-line-args) "unidata-gen.el") (equal (nth 7 command-line-args) "unidata-gen-files") @@ -70,8 +69,9 @@ (message "Using load-path %s" load-path) -(if (or (member (nth 3 command-line-args) '("dump" "bootstrap")) - (member (nth 4 command-line-args) '("dump" "bootstrap"))) +;; This is a poor man's `last', since we haven't loaded subr.el yet. +(if (or (equal (member "bootstrap" command-line-args) '("bootstrap")) + (equal (member "dump" command-line-args) '("dump"))) ;; To reduce the size of dumped Emacs, we avoid making huge ;; char-tables. (setq inhibit-load-charset-map t)) @@ -306,17 +306,13 @@ ;; file primitive. So the only workable solution to support building ;; in non-ASCII directories is to manipulate unibyte strings in the ;; current locale's encoding. -(if (and (or (equal (nth 3 command-line-args) "dump") - (equal (nth 4 command-line-args) "dump") - (equal (nth 3 command-line-args) "bootstrap") - (equal (nth 4 command-line-args) "bootstrap")) +(if (and (member (car (last command-line-args)) '("dump" "bootstrap")) (multibyte-string-p default-directory)) (error "default-directory must be unibyte when dumping Emacs!")) ;; Determine which last version number to use ;; based on the executables that now exist. -(if (and (or (equal (nth 3 command-line-args) "dump") - (equal (nth 4 command-line-args) "dump")) +(if (and (equal (last command-line-args) '("dump")) (not (eq system-type 'ms-dos))) (let* ((base (concat "emacs-" emacs-version ".")) (exelen (if (eq system-type 'windows-nt) -4)) @@ -335,8 +331,7 @@ (message "Finding pointers to doc strings...") -(if (or (equal (nth 3 command-line-args) "dump") - (equal (nth 4 command-line-args) "dump")) +(if (equal (last command-line-args) '("dump")) (Snarf-documentation "DOC") (condition-case nil (Snarf-documentation "DOC") @@ -394,8 +389,7 @@ (if (null (garbage-collect)) (setq pure-space-overflow t)) -(if (or (member (nth 3 command-line-args) '("dump" "bootstrap")) - (member (nth 4 command-line-args) '("dump" "bootstrap"))) +(if (member (car (last command-line-args)) '("dump" "bootstrap")) (progn (message "Dumping under the name emacs") (condition-case () @@ -411,8 +405,7 @@ (if (not (or (eq system-type 'ms-dos) ;; Don't bother adding another name if we're just ;; building bootstrap-emacs. - (equal (nth 3 command-line-args) "bootstrap") - (equal (nth 4 command-line-args) "bootstrap"))) + (equal (last command-line-args) '("bootstrap")))) (let ((name (concat "emacs-" emacs-version)) (exe (if (eq system-type 'windows-nt) ".exe" ""))) (while (string-match "[^-+_.a-zA-Z0-9]+" name) @@ -433,7 +426,7 @@ ;; this file must be loaded each time Emacs is run. ;; So run the startup code now. First, remove `-l loadup' from args. -(if (and (equal (nth 1 command-line-args) "-l") +(if (and (member (nth 1 command-line-args) '("-l" "--load")) (equal (nth 2 command-line-args) "loadup")) (setcdr command-line-args (nthcdr 3 command-line-args))) ------------------------------------------------------------ revno: 117206 committer: Alan Mackenzie branch nick: trunk timestamp: Fri 2014-05-30 17:06:53 +0000 message: Guard (looking-at "\\s!") from XEmacs. progmodes/cc-engine.el (c-state-pp-to-literal): add guard form. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-05-30 09:33:43 +0000 +++ lisp/ChangeLog 2014-05-30 17:06:53 +0000 @@ -1,3 +1,8 @@ +2014-05-30 Alan Mackenzie + + Guard (looking-at "\\s!") from XEmacs. + * progmodes/cc-engine.el (c-state-pp-to-literal): add guard form. + 2014-05-30 Ken Olum (tiny change) * mail/rmail.el (rmail-delete-forward, rmail-delete-backward): The === modified file 'lisp/progmodes/cc-engine.el' --- lisp/progmodes/cc-engine.el 2014-02-02 16:28:52 +0000 +++ lisp/progmodes/cc-engine.el 2014-05-30 17:06:53 +0000 @@ -2219,7 +2219,8 @@ ((and (not not-in-delimiter) ; inside a comment starter (not (bobp)) (progn (backward-char) - (and (not (looking-at "\\s!")) + (and (not (and (memq 'category-properties c-emacs-features) + (looking-at "\\s!"))) (looking-at c-comment-start-regexp)))) (setq ty (if (looking-at c-block-comment-start-regexp) 'c 'c++) co-st (point)) ------------------------------------------------------------ revno: 117205 committer: Dmitry Antipov branch nick: trunk timestamp: Fri 2014-05-30 17:22:29 +0400 message: Use common string allocation and freeing functions where applicable. * lwlib.h (safe_strdup): Remove prototype. * lwlib.c (safe_strdup, safe_free_str): Remove. (copy_widget_value_tree, allocate_widget_info, free_widget_info): (merge_widget_value): Prefer xstrdup, xfree and dupstring. * lwlib-Xm.c (make_destroyed_instance, xm_update_one_value): Ditto. diff: === modified file 'lwlib/ChangeLog' --- lwlib/ChangeLog 2014-03-03 04:57:26 +0000 +++ lwlib/ChangeLog 2014-05-30 13:22:29 +0000 @@ -1,3 +1,12 @@ +2014-05-30 Dmitry Antipov + + Use common string allocation and freeing functions where applicable. + * lwlib.h (safe_strdup): Remove prototype. + * lwlib.c (safe_strdup, safe_free_str): Remove. + (copy_widget_value_tree, allocate_widget_info, free_widget_info): + (merge_widget_value): Prefer xstrdup, xfree and dupstring. + * lwlib-Xm.c (make_destroyed_instance, xm_update_one_value): Ditto. + 2013-12-14 Paul Eggert Use bool for boolean, focusing on headers. === modified file 'lwlib/lwlib-Xm.c' --- lwlib/lwlib-Xm.c 2014-01-01 07:43:34 +0000 +++ lwlib/lwlib-Xm.c 2014-05-30 13:22:29 +0000 @@ -170,8 +170,8 @@ { destroyed_instance* instance = (destroyed_instance*) xmalloc (sizeof (destroyed_instance)); - instance->name = safe_strdup (name); - instance->type = safe_strdup (type); + instance->name = xstrdup (name); + instance->type = xstrdup (type); instance->widget = widget; instance->parent = parent; instance->pop_up_p = pop_up_p; @@ -953,10 +953,7 @@ XtVaGetValues (toggle, XmNset, &set, NULL); if (set) - { - xfree (val->value); - val->value = safe_strdup (XtName (toggle)); - } + dupstring (&val->value, XtName (toggle)); } val->edited = True; } @@ -979,7 +976,7 @@ if (pos_list [j] == i) { cur->selected = True; - val->value = safe_strdup (cur->name); + val->value = xstrdup (cur->name); } } val->edited = 1; === modified file 'lwlib/lwlib-int.h' --- lwlib/lwlib-int.h 2014-01-01 07:43:34 +0000 +++ lwlib/lwlib-int.h 2014-05-30 13:22:29 +0000 @@ -23,8 +23,6 @@ #include "lwlib.h" -extern char *safe_strdup (const char *); - struct widget_xft_data; typedef struct _widget_instance === modified file 'lwlib/lwlib.c' --- lwlib/lwlib.c 2014-01-01 07:43:34 +0000 +++ lwlib/lwlib.c 2014-05-30 13:22:29 +0000 @@ -71,7 +71,6 @@ widget_value *, int, int *); static void instantiate_widget_instance (widget_instance *); -static void safe_free_str (char *); static void free_widget_value_tree (widget_value *); static widget_value *copy_widget_value_tree (widget_value *, change_type); @@ -99,18 +98,6 @@ static void lw_pop_all_widgets (LWLIB_ID, Boolean); static Boolean get_one_value (widget_instance *, widget_value *); static void show_one_widget_busy (Widget, Boolean); - /* utility functions for widget_instance and widget_info */ -char * -safe_strdup (const char *s) -{ - return s ? xstrdup (s) : 0; -} - -static void -safe_free_str (char *s) -{ - xfree (s); -} static widget_value *widget_value_free_list = 0; static int malloc_cpt = 0; @@ -199,9 +186,9 @@ return val; copy = malloc_widget_value (); - copy->name = safe_strdup (val->name); - copy->value = safe_strdup (val->value); - copy->key = safe_strdup (val->key); + copy->name = xstrdup (val->name); + copy->value = val->value ? xstrdup (val->value) : NULL; + copy->key = val->key ? xstrdup (val->key) : NULL; copy->help = val->help; copy->enabled = val->enabled; copy->button_type = val->button_type; @@ -228,8 +215,8 @@ lw_callback highlight_cb) { widget_info* info = (widget_info*) xmalloc (sizeof (widget_info)); - info->type = safe_strdup (type); - info->name = safe_strdup (name); + info->type = xstrdup (type); + info->name = xstrdup (name); info->id = id; info->val = copy_widget_value_tree (val, STRUCTURAL_CHANGE); info->busy = False; @@ -248,8 +235,8 @@ static void free_widget_info (widget_info *info) { - safe_free_str (info->type); - safe_free_str (info->name); + xfree (info->type); + xfree (info->name); free_widget_value_tree (info->val); memset ((void*)info, 0xDEADBEEF, sizeof (widget_info)); xfree (info); @@ -431,24 +418,21 @@ EXPLAIN (val1->name, change, STRUCTURAL_CHANGE, "name change", val1->name, val2->name); change = max (change, STRUCTURAL_CHANGE); - safe_free_str (val1->name); - val1->name = safe_strdup (val2->name); + dupstring (&val1->name, val2->name); } if (safe_strcmp (val1->value, val2->value)) { EXPLAIN (val1->name, change, VISIBLE_CHANGE, "value change", val1->value, val2->value); change = max (change, VISIBLE_CHANGE); - safe_free_str (val1->value); - val1->value = safe_strdup (val2->value); + dupstring (&val1->value, val2->value); } if (safe_strcmp (val1->key, val2->key)) { EXPLAIN (val1->name, change, VISIBLE_CHANGE, "key change", val1->key, val2->key); change = max (change, VISIBLE_CHANGE); - safe_free_str (val1->key); - val1->key = safe_strdup (val2->key); + dupstring (&val1->key, val2->key); } if (! EQ (val1->help, val2->help)) { ------------------------------------------------------------ revno: 117204 fixes bug: http://debbugs.gnu.org/17560 author: Ken Olum committer: Eli Zaretskii branch nick: trunk timestamp: Fri 2014-05-30 12:33:43 +0300 message: Fix bug #17560 with backward-incompatible API change in rmail-delete-*. lisp/mail/rmail.el (rmail-delete-forward, rmail-delete-backward): The argument COUNT is now optional, to be more backward-compatible. Doc fix. etc/NEWS: Document the API change. diff: === modified file 'etc/NEWS' --- etc/NEWS 2014-05-29 03:45:29 +0000 +++ etc/NEWS 2014-05-30 09:33:43 +0000 @@ -146,6 +146,9 @@ ** You can access the slots of structures using `cl-struct-slot-value'. +** Functions `rmail-delete-forward' and `rmail-delete-backward' take an +optional repeat-count argument. + * Changes in Emacs 24.5 on Non-Free Operating Systems === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-05-29 22:51:47 +0000 +++ lisp/ChangeLog 2014-05-30 09:33:43 +0000 @@ -1,3 +1,9 @@ +2014-05-30 Ken Olum (tiny change) + + * mail/rmail.el (rmail-delete-forward, rmail-delete-backward): The + argument COUNT is now optional, to be more backward-compatible. + Doc fix. (Bug#17560) + 2014-05-29 Reuben Thomas * whitespace.el (whitespace-report-region): Simplify === modified file 'lisp/mail/rmail.el' --- lisp/mail/rmail.el 2014-05-29 03:45:29 +0000 +++ lisp/mail/rmail.el 2014-05-30 09:33:43 +0000 @@ -3476,11 +3476,12 @@ (defun rmail-delete-forward (&optional count) "Delete this message and move to next nondeleted one. Deleted messages stay in the file until the \\[rmail-expunge] command is given. -A prefix argument is a repeat count; +Optional argument COUNT (interactively, prefix argument) is a repeat count; negative argument means move backwards instead of forwards. Returns t if a new message is displayed after the delete, or nil otherwise." (interactive "p") + (if (not count) (setq count 1)) (let (value backward) (if (< count 0) (setq count (- count) backward t)) @@ -3495,15 +3496,16 @@ (rmail-maybe-display-summary) value)) -(defun rmail-delete-backward (count) +(defun rmail-delete-backward (&optional count) "Delete this message and move to previous nondeleted one. Deleted messages stay in the file until the \\[rmail-expunge] command is given. -A prefix argument is a repeat count; +Optional argument COUNT (interactively, prefix argument) is a repeat count; negative argument means move forwards instead of backwards. Returns t if a new message is displayed after the delete, or nil otherwise." (interactive "p") + (if (not count) (setq count 1)) (rmail-delete-forward (- count))) ;; Expunging. ------------------------------------------------------------ revno: 117203 committer: Eli Zaretskii branch nick: trunk timestamp: Fri 2014-05-30 12:02:55 +0300 message: Enhance error checking in heap allocation routines on MS-Windows. src/w32heap.c (malloc_before_dump, malloc_after_dump) (malloc_before_dump, realloc_after_dump, realloc_before_dump) (mmap_alloc, mmap_realloc): Check for errors more thoroughly and set errno where appropriate to emulate CRT functions. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2014-05-30 07:40:29 +0000 +++ src/ChangeLog 2014-05-30 09:02:55 +0000 @@ -1,3 +1,10 @@ +2014-05-30 Eli Zaretskii + + * w32heap.c (malloc_before_dump, malloc_after_dump) + (malloc_before_dump, realloc_after_dump, realloc_before_dump) + (mmap_alloc, mmap_realloc): Check for errors more thoroughly and + set errno where appropriate to emulate CRT functions. + 2014-05-30 Dmitry Antipov Debugging facility to check whether 'const char *' points to === modified file 'src/w32heap.c' --- src/w32heap.c 2014-05-29 15:21:08 +0000 +++ src/w32heap.c 2014-05-30 09:02:55 +0000 @@ -47,6 +47,7 @@ #include #include +#include #include #include "w32common.h" @@ -241,7 +242,8 @@ if (s_pfn_Heap_Set_Information ((PVOID) heap, HeapCompatibilityInformation, &enable_lfh, sizeof(enable_lfh)) == 0) - DebPrint (("Enabling Low Fragmentation Heap failed\n")); + DebPrint (("Enabling Low Fragmentation Heap failed: error %ld\n", + GetLastError ())); #endif the_malloc_fn = malloc_after_dump; @@ -298,7 +300,10 @@ void *p = HeapAlloc (heap, 0, size); /* After dump, keep track of the last allocated byte for sbrk(0). */ - data_region_end = p + size - 1; + if (p) + data_region_end = p + size - 1; + else + errno = ENOMEM; return p; } @@ -313,6 +318,8 @@ { /* Use the private heap if possible. */ p = HeapAlloc (heap, 0, size); + if (!p) + errno = ENOMEM; } else { @@ -371,16 +378,22 @@ { /* Reallocate the block since it lies in the new heap. */ p = HeapReAlloc (heap, 0, ptr, size); + if (!p) + errno = ENOMEM; } 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); + if (p) + CopyMemory (p, ptr, size); + else + errno = ENOMEM; } /* After dump, keep track of the last allocated byte for sbrk(0). */ - data_region_end = p + size - 1; + if (p) + data_region_end = p + size - 1; return p; } @@ -392,7 +405,11 @@ /* Before dumping. */ if (dumped_data < (unsigned char *)ptr && (unsigned char *)ptr < bc_limit && size <= MaxBlockSize) - p = HeapReAlloc (heap, 0, ptr, size); + { + p = HeapReAlloc (heap, 0, ptr, size); + if (!p) + errno = ENOMEM; + } else { /* In this case, either the new block is too large for the heap, @@ -400,8 +417,11 @@ 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); + if (p) + { + CopyMemory (p, ptr, size); + free_before_dump (ptr); + } } return p; } @@ -508,8 +528,16 @@ *var = VirtualAlloc (p, nbytes, MEM_COMMIT, PAGE_READWRITE); } - if (!p && GetLastError () != ERROR_NOT_ENOUGH_MEMORY) - DebPrint (("mmap_alloc: error %ld\n", GetLastError())); + if (!p) + { + if (GetLastError () == ERROR_NOT_ENOUGH_MEMORY) + errno = ENOMEM; + else + { + DebPrint (("mmap_alloc: error %ld\n", GetLastError ())); + errno = EINVAL; + } + } return *var = p; } @@ -520,7 +548,7 @@ if (*var) { if (VirtualFree (*var, 0, MEM_RELEASE) == 0) - DebPrint (("mmap_free: error %ld\n", GetLastError())); + DebPrint (("mmap_free: error %ld\n", GetLastError ())); *var = NULL; } } @@ -541,13 +569,14 @@ } if (VirtualQuery (*var, &memInfo, sizeof (memInfo)) == 0) - DebPrint (("mmap_realloc: VirtualQuery error = %ld\n", GetLastError())); + 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())); + 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 @@ -559,8 +588,11 @@ nbytes - memInfo.RegionSize, MEM_COMMIT, PAGE_READWRITE); if (!p /* && GetLastError() != ERROR_NOT_ENOUGH_MEMORY */) - DebPrint (("realloc enlarge: VirtualAlloc error %ld\n", - GetLastError())); + { + DebPrint (("realloc enlarge: VirtualAlloc error %ld\n", + GetLastError ())); + errno = ENOMEM; + } return *var; } else @@ -615,7 +647,7 @@ if (VirtualFree (*var + nbytes + get_page_size(), memInfo.RegionSize - nbytes - get_page_size(), MEM_DECOMMIT) == 0) - DebPrint (("mmap_realloc: VirtualFree error %ld\n", GetLastError())); + DebPrint (("mmap_realloc: VirtualFree error %ld\n", GetLastError ())); return *var; } ------------------------------------------------------------ revno: 117202 committer: Dmitry Antipov branch nick: trunk timestamp: Fri 2014-05-30 11:40:29 +0400 message: Debugging facility to check whether 'const char *' points to relocatable data of non-pure Lisp string. * alloc.c (maybe_lisp_pointer): New function, refactored out of ... (mark_maybe_pointer): ... adjusted user. (relocatable_string_data_p): New function. * lisp.h (relocatable_string_data_p): Add prototype. * xdisp.c (message_with_string): If ENABLE_CHECKING, make sure the pointer to relocatable Lisp data is not used. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2014-05-30 04:12:08 +0000 +++ src/ChangeLog 2014-05-30 07:40:29 +0000 @@ -1,3 +1,14 @@ +2014-05-30 Dmitry Antipov + + Debugging facility to check whether 'const char *' points to + relocatable data of non-pure Lisp string. + * alloc.c (maybe_lisp_pointer): New function, refactored out of ... + (mark_maybe_pointer): ... adjusted user. + (relocatable_string_data_p): New function. + * lisp.h (relocatable_string_data_p): Add prototype. + * xdisp.c (message_with_string): If ENABLE_CHECKING, make sure + the pointer to relocatable Lisp data is not used. + 2014-05-30 Paul Eggert Don't let SIGINT handling block SIGCHLD indefinitely (Bug#17561). === modified file 'src/alloc.c' --- src/alloc.c 2014-05-29 08:02:58 +0000 +++ src/alloc.c 2014-05-30 07:40:29 +0000 @@ -4547,7 +4547,16 @@ } } +/* Return true if P can point to Lisp data, and false otherwise. + USE_LSB_TAG needs Lisp data to be aligned on multiples of GCALIGNMENT. + Otherwise, assume that Lisp data is aligned on even addresses. */ +static bool +maybe_lisp_pointer (void *p) +{ + return !((intptr_t) p % (USE_LSB_TAG ? GCALIGNMENT : 2)); +} + /* If P points to Lisp data, mark that as live if it isn't already marked. */ @@ -4561,10 +4570,7 @@ VALGRIND_MAKE_MEM_DEFINED (&p, sizeof (p)); #endif - /* Quickly rule out some values which can't point to Lisp data. - USE_LSB_TAG needs Lisp data to be aligned on multiples of GCALIGNMENT. - Otherwise, assume that Lisp data is aligned on even addresses. */ - if ((intptr_t) p % (USE_LSB_TAG ? GCALIGNMENT : 2)) + if (!maybe_lisp_pointer (p)) return; m = mem_find (p); @@ -5007,9 +5013,34 @@ #endif } - - - +/* If GC_MARK_STACK, return 1 if STR is a relocatable data of Lisp_String + (i.e. there is a non-pure Lisp_Object X so that SDATA (X) == STR) and 0 + if not. Otherwise we can't rely on valid_lisp_object_p and return -1. + This function is slow and should be used for debugging purposes. */ + +int +relocatable_string_data_p (const char *str) +{ + if (PURE_POINTER_P (str)) + return 0; +#if GC_MARK_STACK + if (str) + { + struct sdata *sdata + = (struct sdata *) (str - offsetof (struct sdata, data)); + + if (valid_pointer_p (sdata) + && valid_pointer_p (sdata->string) + && maybe_lisp_pointer (sdata->string)) + return (valid_lisp_object_p + (make_lisp_ptr (sdata->string, Lisp_String)) + && (const char *) sdata->string->data == str); + } + return 0; +#endif /* GC_MARK_STACK */ + return -1; +} + /*********************************************************************** Pure Storage Management ***********************************************************************/ === modified file 'src/lisp.h' --- src/lisp.h 2014-05-29 14:52:47 +0000 +++ src/lisp.h 2014-05-30 07:40:29 +0000 @@ -3747,6 +3747,7 @@ extern void syms_of_alloc (void); extern struct buffer * allocate_buffer (void); extern int valid_lisp_object_p (Lisp_Object); +extern int relocatable_string_data_p (const char *); #ifdef GC_CHECK_CONS_LIST extern void check_cons_list (void); #else === modified file 'src/xdisp.c' --- src/xdisp.c 2014-05-26 02:28:09 +0000 +++ src/xdisp.c 2014-05-30 07:40:29 +0000 @@ -10201,19 +10201,17 @@ { if (m) { - /* ENCODE_SYSTEM below can GC and/or relocate the Lisp - String whose data pointer might be passed to us in M. So - we use a local copy. */ - char *fmt = xstrdup (m); + /* ENCODE_SYSTEM below can GC and/or relocate the + Lisp data, so make sure we don't use it here. */ + eassert (relocatable_string_data_p (m) != 1); if (noninteractive_need_newline) putc ('\n', stderr); noninteractive_need_newline = 0; - fprintf (stderr, fmt, SDATA (ENCODE_SYSTEM (string))); + fprintf (stderr, m, SDATA (ENCODE_SYSTEM (string))); if (!cursor_in_echo_area) fprintf (stderr, "\n"); fflush (stderr); - xfree (fmt); } } else if (INTERACTIVE)