Mercurial > hg > xemacs-beta
changeset 851:e7ee5f8bde58
[xemacs-hg @ 2002-05-23 11:46:08 by ben]
fix for raymond toy's crash, alloca crashes, some recover-session improvements
files.el: Recover-session improvements: Only show session files where some
files can actually be recovered, and show in chronological order.
subr.el, menubar-items.el: As promised to rms, the functionality in
truncate-string-with-continuation-dots has been merged into
truncate-string-to-width. Change callers in menubar-items.el.
select.el: Document some of these funs better. Fix problem where we were
doing own-clipboard twice.
Makefile.in.in: Add alloca.o. Ensure that alloca.s doesn't compile into alloca.o,
but allocax.o (not that it's currently used or anything.)
EmacsFrame.c, abbrev.c, alloc.c, alloca.c, callint.c, callproc.c, config.h.in, device-msw.c, device-x.c, dired.c, doc.c, editfns.c, emacs.c, emodules.c, eval.c, event-Xt.c, event-msw.c, event-stream.c, file-coding.c, fileio.c, filelock.c, fns.c, glyphs-gtk.c, glyphs-msw.c, glyphs-x.c, gui-x.c, input-method-xlib.c, intl-win32.c, lisp.h, lread.c, menubar-gtk.c, menubar-msw.c, menubar.c, mule-wnnfns.c, nt.c, objects-msw.c, process-nt.c, realpath.c, redisplay-gtk.c, redisplay-output.c, redisplay-x.c, redisplay.c, search.c, select-msw.c, sysdep.c, syswindows.h, text.c, text.h, ui-byhand.c: Fix Raymond Toy's crash. Repeat to self: 2^21 - 1 is NOT the
same as (2 << 21) - 1.
Fix crashes due to excessive alloca(). replace alloca() with
ALLOCA(), which calls the C alloca() [which uses xmalloc()]
when the size is too big. Insert in various places calls to
try to flush the C alloca() stored info if there is any.
Add MALLOC_OR_ALLOCA(), for places that expect to be alloca()ing
large blocks. This xmalloc()s when too large and records an
unwind-protect to free -- relying on the caller to unbind_to()
elsewhere in the function. Use it in concat().
Use MALLOC instead of ALLOCA in select-msw.c.
xemacs.mak: Add alloca.o.
line wrap: on
line diff
--- a/lisp/ChangeLog Tue May 21 23:47:40 2002 +0000 +++ b/lisp/ChangeLog Thu May 23 11:46:46 2002 +0000 @@ -1,3 +1,30 @@ +2002-05-23 Ben Wing <ben@xemacs.org> + + * files.el: + * files.el (recover-session): + * files.el (recover-session-finish): Removed. + * files.el (Recover-session-files-from-auto-save-list-file): New. + Recover-session improvements: Only show session files where some + files can actually be recovered, and show in chronological order. + + * subr.el: + * subr.el (truncate-string-to-width): + * subr.el (BUG): New. + * subr.el (truncate-string-with-continuation-dots): Removed. + * subr.el (plist-to-alist): + * menubar-items.el (default-menubar): + As promised to rms, the functionality in + truncate-string-with-continuation-dots has been merged into + truncate-string-to-width. Change callers in menubar-items.el. + + * select.el: + * select.el (copy-primary-selection): + * select.el (kill-primary-selection): + * select.el (own-selection): + * select.el (cut-copy-clear-internal): + Document some of these funs better. Fix problem where we were + doing own-clipboard twice. + 2002-05-20 Stephen J. Turnbull <stephen@xemacs.org> * files.el (revert-buffer):
--- a/lisp/files.el Tue May 21 23:47:40 2002 +0000 +++ b/lisp/files.el Thu May 23 11:46:46 2002 +0000 @@ -3131,33 +3131,35 @@ (if (null auto-save-list-file-prefix) (error "You set `auto-save-list-file-prefix' to disable making session files")) - (declare-fboundp (dired (concat auto-save-list-file-prefix "*"))) - (goto-char (point-min)) - (or (looking-at "Move to the session you want to recover,") - (let ((inhibit-read-only t)) - (insert "Move to the session you want to recover,\n" - "then type C-c C-c to select it.\n\n" - "You can also delete some of these files;\n" - "type d on a line to mark that file for deletion.\n\n"))) - (use-local-map (let ((map (make-sparse-keymap))) - (set-keymap-parents map (list (current-local-map))) - map)) - (define-key (current-local-map) "\C-c\C-c" 'recover-session-finish)) + (let* ((auto-save-list-dir + (file-name-directory auto-save-list-file-prefix)) + (files (directory-files + auto-save-list-dir + t + (concat "^" (regexp-quote (file-name-nondirectory + auto-save-list-file-prefix))))) + (files (sort (delete-if-not #'Recover-session-files-from-auto-save-list-file + files) #'file-newer-than-file-p))) + (unless files + (error "No sessions can be recovered now")) + (declare-fboundp (dired (cons auto-save-list-dir files))) + (goto-char (point-min)) + (or (looking-at "Move to the session you want to recover,") + (let ((inhibit-read-only t)) + (delete-matching-lines "^[ \t]*total.*$") + (insert "Move to the session you want to recover,\n" + "then type C-c C-c to select it.\n\n" + "You can also delete some of these files;\n" + "type d on a line to mark that file for deletion.\n\n"))) + (use-local-map (let ((map (make-sparse-keymap))) + (set-keymap-parents map (list (current-local-map))) + map)) + (define-key (current-local-map) "\C-c\C-c" 'recover-session-finish))) -(defun recover-session-finish () - "Choose one saved session to recover auto-save files from. -This command is used in the special Dired buffer created by -\\[recover-session]." - (interactive) - ;; Get the name of the session file to recover from. - (let ((file (declare-fboundp (dired-get-filename))) - files +(defun Recover-session-files-from-auto-save-list-file (file) + "Return the auto save files in list file FILE that are current." + (let (files (buffer (get-buffer-create " *recover*"))) - ;; #### dired-do-flagged-delete in FSF. - ;; This version is for ange-ftp - ;;(dired-do-deletions t) - ;; This version is for efs - (declare-fboundp (dired-expunge-deletions)) (unwind-protect (save-excursion ;; Read in the auto-save-list file. @@ -3202,23 +3204,38 @@ ;; Ignore a file if its auto-save file does not exist now. (if (file-exists-p autofile) (setq files (cons thisfile files))))) - (setq files (nreverse files)) - ;; The file contains a pair of line for each auto-saved buffer. - ;; The first line of the pair contains the visited file name - ;; or is empty if the buffer was not visiting a file. - ;; The second line is the auto-save file name. - (if files - (map-y-or-n-p "Recover %s? " - (lambda (file) - (condition-case nil - (save-excursion (recover-file file)) - (error - (lwarn 'recover 'alert "Failed to recover `%s'" file)))) - files - '("file" "files" "recover")) - (message "No files can be recovered from this session now"))) + (setq files (nreverse files))) (kill-buffer buffer)))) +(defun recover-session-finish () + "Choose one saved session to recover auto-save files from. +This command is used in the special Dired buffer created by +\\[recover-session]." + (interactive) + ;; Get the name of the session file to recover from. + (let ((file (declare-fboundp (dired-get-filename)))) + ;; #### dired-do-flagged-delete in FSF. + ;; This version is for ange-ftp + ;;(dired-do-deletions t) + ;; This version is for efs + (declare-fboundp (dired-expunge-deletions)) + (let ((files (Recover-session-files-from-auto-save-list-file file))) + ;; The file contains a pair of line for each auto-saved buffer. + ;; The first line of the pair contains the visited file name + ;; or is empty if the buffer was not visiting a file. + ;; The second line is the auto-save file name. + (if files + (map-y-or-n-p "Recover %s? " + (lambda (file) + (condition-case nil + (save-excursion (recover-file file)) + (error + (lwarn 'recover 'alert + "Failed to recover `%s'" file)))) + files + '("file" "files" "recover")) + (message "No files can be recovered from this session now"))))) + (defun kill-some-buffers (&optional list) "For each buffer in LIST, ask whether to kill it. LIST defaults to all existing live buffers."
--- a/lisp/menubar-items.el Tue May 21 23:47:40 2002 +0000 +++ b/lisp/menubar-items.el Thu May 23 11:46:46 2002 +0000 @@ -462,30 +462,27 @@ "----" ["D%_ynamic Abbrev Expand" dabbrev-expand] ["Define %_Global Abbrev for " add-global-abbrev - :suffix (truncate-string-with-continuation-dots - (abbrev-string-to-be-defined nil) - 40)] + :suffix (truncate-string-to-width (abbrev-string-to-be-defined nil) + 40 nil nil t)] ("Other %_Abbrev" ["Dynamic Abbrev %_Complete" dabbrev-completion] ["Dynamic Abbrev Complete in %_All Buffers" (dabbrev-completion 16)] "----" "----" ["%_Define Global Abbrev for " add-global-abbrev - :suffix (truncate-string-with-continuation-dots - (abbrev-string-to-be-defined nil) - 40)] + :suffix (truncate-string-to-width (abbrev-string-to-be-defined nil) + 40 nil nil t)] ["Define %_Mode-Specific Abbrev for " add-mode-abbrev - :suffix (truncate-string-with-continuation-dots - (abbrev-string-to-be-defined nil) - 40)] + :suffix (truncate-string-to-width (abbrev-string-to-be-defined nil) + 40 nil nil t)] ["Define Global Ex%_pansion for " inverse-add-global-abbrev - :suffix (truncate-string-with-continuation-dots + :suffix (truncate-string-to-width (inverse-abbrev-string-to-be-defined 1) - 40)] + 40 nil nil t)] ["Define Mode-Specific Expa%_nsion for " inverse-add-mode-abbrev - :suffix (truncate-string-with-continuation-dots + :suffix (truncate-string-to-width (inverse-abbrev-string-to-be-defined 1) - 40)] + 40 nil nil t)] "---" ["E%_xpand Abbrev" expand-abbrev] ["Expand Abbrevs in Re%_gion" expand-region-abbrevs
--- a/lisp/select.el Tue May 21 23:47:40 2002 +0000 +++ b/lisp/select.el Thu May 23 11:46:46 2002 +0000 @@ -3,6 +3,7 @@ ;; Copyright (C) 1998 Andy Piper. ;; Copyright (C) 1990, 1997 Free Software Foundation, Inc. ;; Copyright (C) 1995 Sun Microsystems. +;; Copyright (C) 2002 Ben Wing. ;; Maintainer: XEmacs Development Team ;; Keywords: extensions, dumped @@ -46,13 +47,19 @@ set the clipboard.") (defun copy-primary-selection () - "Copy the selection to the Clipboard and the kill ring." + "Copy the selection to the Clipboard and the kill ring. +This is similar to the command \\[kill-ring-save] except that it will +save to the Clipboard even if that command doesn't, and it handles rectangles +properly." (interactive) (and (console-on-window-system-p) (cut-copy-clear-internal 'copy))) (defun kill-primary-selection () - "Copy the selection to the Clipboard and the kill ring, then delete it." + "Copy the selection to the Clipboard and the kill ring, then deleted it. +This is similar to the command \\[kill-region] except that it will +save to the Clipboard even if that command doesn't, and it handles rectangles +properly." (interactive "*") (and (console-on-window-system-p) (cut-copy-clear-internal 'cut))) @@ -130,7 +137,7 @@ that can be converted using the function corresponding to DATA-TYPE in `select-converter-alist'---strings are the usual choice, but other types may be permissible depending on the DATA-TYPE parameter -(if DATA-TYPE is not supplied, the default behavior is window +\(if DATA-TYPE is not supplied, the default behavior is window system specific, but strings are always accepted). HOW-TO-ADD may be any of the following: @@ -139,7 +146,7 @@ 'append or t -- append data to existing DATA-TYPE data. DATA-TYPE is the window-system specific data type identifier -(see `register-selection-data-type' for more information). +\(see `register-selection-data-type' for more information). The selection may also be a cons of two markers pointing to the same buffer, or an overlay. In these cases, the selection is considered to be the text @@ -355,8 +362,7 @@ (cond ((memq mode '(cut copy)) (if rect-p (progn - ;; why is killed-rectangle free? Is it used somewhere? - ;; should it be defvarred? + ;; killed-rectangle is defvarred in rect.el (setq killed-rectangle (extract-rectangle s e)) (kill-new (mapconcat #'identity killed-rectangle "\n"))) (copy-region-as-kill s e)) @@ -365,6 +371,7 @@ ;; some other way, but owning the clipboard twice in that case ;; wouldn't actually hurt anything. (or (and (consp kill-hooks) (memq 'own-clipboard kill-hooks)) + (eq 'own-clipboard interprogram-cut-function) (own-clipboard (car kill-ring))))) (cond ((memq mode '(cut clear)) (if rect-p
--- a/lisp/subr.el Tue May 21 23:47:40 2002 +0000 +++ b/lisp/subr.el Thu May 23 11:46:46 2002 +0000 @@ -580,8 +580,10 @@ (setq idx (1+ idx) i (1+ i))) string)) -;; From FSF 21.1 -(defun truncate-string-to-width (str end-column &optional start-column padding) +;; From FSF 21.1; ELLIPSES is XEmacs addition. + +(defun truncate-string-to-width (str end-column &optional start-column padding + ellipses) "Truncate string STR to end at column END-COLUMN. The optional 3rd arg START-COLUMN, if non-nil, specifies the starting column; that means to return the characters occupying @@ -594,7 +596,18 @@ if column START-COLUMN appears in the middle of a character in STR. If PADDING is nil, no padding is added in these cases, so -the resulting string may be narrower than END-COLUMN." +the resulting string may be narrower than END-COLUMN. + +BUG: Currently assumes that the padding character is of width one. You +will get weird results if not. + +If ELLIPSES is non-nil, add ellipses (specified by ELLIPSES if a string, +else `...') if STR extends past END-COLUMN. The ellipses will be added in +such a way that the total string occupies no more than END-COLUMN columns +-- i.e. if the string goes past END-COLUMN, it will be truncated somewhere +short of END-COLUMN so that, with the ellipses added (and padding, if the +proper place to truncate the string would be in the middle of a character), +the string occupies exactly END-COLUMN columns." (or start-column (setq start-column 0)) (let ((len (length str)) @@ -602,6 +615,8 @@ (column 0) (head-padding "") (tail-padding "") ch last-column last-idx from-idx) + + ;; find the index of START-COLUMN; bail out if end of string reached. (condition-case nil (while (< column start-column) (setq ch (aref str idx) @@ -609,12 +624,32 @@ idx (1+ idx))) (args-out-of-range (setq idx len))) (if (< column start-column) - (if padding (make-string end-column padding) "") + ;; if string ends before START-COLUMN, return either a blank string + ;; or a string entirely padded. + (if padding (make-string (- end-column start-column) padding) "") (if (and padding (> column start-column)) (setq head-padding (make-string (- column start-column) padding))) (setq from-idx idx) + ;; If END-COLUMN is before START-COLUMN, then bail out. (if (< end-column column) - (setq idx from-idx) + (setq idx from-idx ellipses "") + + ;; handle ELLIPSES + (cond ((null ellipses) (setq ellipses "")) + ((if (<= (string-width str) end-column) + ;; string fits, no ellipses + (setq ellipses ""))) + (t + ;; else, insert default value and ... + (or (stringp ellipses) (setq ellipses "...")) + ;; ... take away the width of the ellipses from the + ;; destination. do all computations with new, shorter + ;; width. the padding computed will get us exactly up to + ;; the shorted width, which is right -- it just gets added + ;; to the right of the ellipses. + (setq end-column (- end-column (string-width ellipses))))) + + ;; find the index of END-COLUMN; bail out if end of string reached. (condition-case nil (while (< column end-column) (setq last-column column @@ -623,28 +658,18 @@ column (+ column (char-width ch)) idx (1+ idx))) (args-out-of-range (setq idx len))) + ;; if we went too far (stopped in middle of character), back up. (if (> column end-column) (setq column last-column idx last-idx)) + ;; compute remaining padding (if (and padding (< column end-column)) (setq tail-padding (make-string (- end-column column) padding)))) + ;; get substring ... (setq str (substring str from-idx idx)) + ;; and construct result (if padding - (concat head-padding str tail-padding) - str)))) - -(defun truncate-string-with-continuation-dots (str end-column &optional - dots-str) - "Truncate string STR to end at column END-COLUMN, adding dots if needed. -The dots (normally `...', but can be controlled by DOTS-STR)' will be added -in such a way that the total string occupies no more than END-COLUMN -columns -- i.e. if the string goes past END-COLUMN, it will be truncated -somewhere short of END-COLUMN so that, with the dots added, the string -occupies END-COLUMN columns." - (if (<= (string-width str) end-column) str - (let* ((dots-str (or dots-str "...")) - (dotswidth (string-width dots-str))) - (concat (truncate-string-to-width str (- end-column dotswidth)) - dots-str)))) + (concat head-padding str tail-padding ellipses) + (concat str ellipses))))) ;; alist/plist functions
--- a/nt/ChangeLog Tue May 21 23:47:40 2002 +0000 +++ b/nt/ChangeLog Thu May 23 11:46:46 2002 +0000 @@ -1,3 +1,8 @@ +2002-05-23 Ben Wing <ben@xemacs.org> + + * xemacs.mak (TEMACS_OBJS): + Add alloca.o. + 2002-05-14 Ben Wing <ben@xemacs.org> * xemacs.mak (batch_test_emacs):
--- a/nt/xemacs.mak Tue May 21 23:47:40 2002 +0000 +++ b/nt/xemacs.mak Thu May 23 11:46:46 2002 +0000 @@ -802,6 +802,7 @@ $(TEMACS_DUMP_OBJS)\ $(OUTDIR)\abbrev.obj \ $(OUTDIR)\alloc.obj \ + $(OUTDIR)\alloca.obj \ $(OUTDIR)\blocktype.obj \ $(OUTDIR)\buffer.obj \ $(OUTDIR)\bytecode.obj \
--- a/src/ChangeLog Tue May 21 23:47:40 2002 +0000 +++ b/src/ChangeLog Thu May 23 11:46:46 2002 +0000 @@ -1,3 +1,123 @@ +2002-05-23 Ben Wing <ben@xemacs.org> + + * Makefile.in.in (objs): + * Makefile.in.in (Emacs.ad.h): + * Makefile.in.in (alloca.o): Removed. + * Makefile.in.in (allocax.o): New. + Add alloca.o. Ensure that alloca.s doesn't compile into alloca.o, + but allocax.o (not that it's currently used or anything.) + + * EmacsFrame.c (Xt_StringToScrollBarPlacement): + * abbrev.c (abbrev_oblookup): + * alloc.c: + * alloc.c (allocate_lisp_storage): + * alloc.c (recompute_funcall_allocation_flag): + * alloc.c (recompute_need_to_garbage_collect): + * alloc.c (common_init_alloc_once_early): + * alloca.c: + * alloca.c (hdr): + * alloca.c (xemacs_c_alloca): + * callint.c (Fcall_interactively): + * callproc.c (Fold_call_process_internal): + * config.h.in: + * config.h.in (XEMACS_WANTS_C_ALLOCA): + * device-msw.c (msprinter_default_printer): + * device-msw.c (Fmswindows_printer_list): + * device-x.c (x_init_device): + * dired.c (Fdirectory_files): + * dired.c (file_name_completion_stat): + * doc.c (get_doc_string): + * editfns.c (Fformat_time_string): + * emacs.c (main_1): + * emodules.c (emodules_load): + * eval.c (Ffuncall): + * event-Xt.c (x_to_emacs_keysym): + * event-msw.c (mswindows_dde_callback): + * event-msw.c (mswindows_wnd_proc): + * event-stream.c (Fnext_event): + * file-coding.c (setup_eol_coding_systems): + * fileio.c: + * fileio.c (Fdirectory_file_name): + * fileio.c (if): + * fileio.c (Fsubstitute_in_file_name): + * fileio.c (Fencrypt_string): + * fileio.c (Fdecrypt_string): + * filelock.c (MAKE_LOCK_NAME): + * filelock.c (lock_file_1): + * filelock.c (current_lock_owner): + * filelock.c (lock_file): + * fns.c (concat): + * fns.c (mapcar1): + * fns.c (Fbase64_encode_region): + * fns.c (Fbase64_encode_string): + * fns.c (Fbase64_decode_region): + * fns.c (Fbase64_decode_string): + * glyphs-gtk.c (gtk_xface_instantiate): + * glyphs-msw.c (mswindows_xface_instantiate): + * glyphs-msw.c (mswindows_widget_property): + * glyphs-msw.c (mswindows_combo_box_property): + * glyphs-x.c (x_xface_instantiate): + * gui-x.c (add_accel_and_to_external): + * input-method-xlib.c (EmacsXtCvtStringToXIMStyles): + * intl-win32.c (Fmswindows_get_valid_keyboard_layouts): + * lisp.h: + * lisp.h (alloca_new): + * lisp.h (NOTE): New. + * lisp.h (MAX_STRING_ASCII_BEGIN): + * lread.c (Fload_internal): + * lread.c (locate_file_map_suffixes): + * menubar-gtk.c (menu_descriptor_to_widget_1): + * menubar-msw.c (mswindows_translate_menu_or_dialog_item): + * menubar.c (Fnormalize_menu_item_name): + * mule-wnnfns.c (Fwnn_open): + * nt.c (init_mswindows_environment): + * objects-msw.c (mswindows_string_to_color): + * objects-msw.c (mswindows_font_instance_truename): + * process-nt.c (nt_create_process): + * realpath.c (cygwin_readlink_and_correct_case): + * redisplay-gtk.c: + * redisplay-gtk.c (gtk_text_width): + * redisplay-gtk.c (gtk_output_string): + * redisplay-output.c: + * redisplay-output.c (compare_runes_2): + * redisplay-x.c: + * redisplay-x.c (x_text_width): + * redisplay-x.c (x_output_string): + * redisplay.c (generate_displayable_area): + * redisplay.c (regenerate_window): + * search.c (wordify): + * search.c (Fregexp_quote): + * select-msw.c (mswindows_own_selection): + * sysdep.c (sys_subshell): + * sysdep.c (init_system_name): + * syswindows.h (LOCAL_TO_WIN32_FILE_FORMAT): + * syswindows.h (WIN32_TO_LOCAL_FILE_FORMAT): + * text.c (convert_emchar_string_into_malloced_string): + * text.h: + * text.h (EI_ALLOC): + * text.h (eito_alloca): + * text.h (EI_CASECHANGE): + * text.h (DFC_ALLOCA_USE_CONVERTED_DATA): + * text.h (DFC_C_STRING_ALLOCA_USE_CONVERTED_DATA): + * text.h (GET_STRERROR): + * ui-byhand.c (Fgtk_curve_get_vector): + * ui-byhand.c (Fgtk_curve_set_vector): + + Fix Raymond Toy's crash. Repeat to self: 2^21 - 1 is NOT the + same as (2 << 21) - 1. + + Fix crashes due to excessive alloca(). replace alloca() with + ALLOCA(), which calls the C alloca() [which uses xmalloc()] + when the size is too big. Insert in various places calls to + try to flush the C alloca() stored info if there is any. + + Add MALLOC_OR_ALLOCA(), for places that expect to be alloca()ing + large blocks. This xmalloc()s when too large and records an + unwind-protect to free -- relying on the caller to unbind_to() + elsewhere in the function. Use it in concat(). + + Use MALLOC instead of ALLOCA in select-msw.c. + 2002-05-21 Jonathan Harris <jonathan@xemacs.org> * device-msw.c (mswindows_handle_page_setup_dialog_box):
--- a/src/EmacsFrame.c Tue May 21 23:47:40 2002 +0000 +++ b/src/EmacsFrame.c Thu May 23 11:46:46 2002 +0000 @@ -583,7 +583,7 @@ XrmValuePtr toVal) { XrmQuark q; - char *lowerName = (char *) alloca (strlen ((char *) fromVal->addr) + 1); + char *lowerName = (char *) ALLOCA (strlen ((char *) fromVal->addr) + 1); XmuCopyISOLatin1Lowered (lowerName, (char *) fromVal->addr); q = XrmStringToQuark (lowerName);
--- a/src/Makefile.in.in Tue May 21 23:47:40 2002 +0000 +++ b/src/Makefile.in.in Thu May 23 11:46:46 2002 +0000 @@ -307,11 +307,13 @@ ## if they all come out null. objs=\ - abbrev.o alloc.o $(balloon_help_objs) blocktype.o buffer.o bytecode.o\ - callint.o callproc.o casefiddle.o casetab.o chartab.o $(clash_detection_objs)\ - cmdloop.o cmds.o $(coding_system_objs) console.o console-stream.o\ + abbrev.o alloc.o alloca.o \ + $(balloon_help_objs) blocktype.o buffer.o bytecode.o \ + callint.o callproc.o casefiddle.o casetab.o chartab.o \ + $(clash_detection_objs) cmdloop.o cmds.o $(coding_system_objs) console.o \ + console-stream.o\ data.o $(database_objs) $(debug_objs) device.o dired.o doc.o doprnt.o\ - dynarr.o\ + dynarr.o \ editfns.o elhash.o emacs.o eval.o events.o\ event-stream.o $(event_unixoid_objs) $(extra_objs) extents.o\ faces.o file-coding.o fileio.o $(LOCK_OBJ) filemode.o floatfns.o fns.o \ @@ -794,18 +796,13 @@ ## be used but generate no code. ## Some have it written in assembler in alloca.s. ## Some use the C version in alloca.c (these define C_ALLOCA in config.h). - +## Nowadays we always compile in the C version and use it to avoid stack +## overflow. #ifdef C_ALLOCA -## We could put something in alloca.c to #define free and malloc -## whenever emacs was #defined, but that's not appropriate for all -## users of alloca in Emacs. Check out ../lib-src/getopt.c. */ - -alloca.o : ${srcdir}/alloca.c - $(CC) -c -Dfree=xfree -Dmalloc=xmalloc $(cflags) ${srcdir}/alloca.c #else #ifndef HAVE_ALLOCA -alloca.o : ${srcdir}/alloca.s config.h +allocax.o : ${srcdir}/alloca.s config.h ## $(CPP) is cc -E, which may get confused by filenames ## that do not end in .c. So copy file to a safe name. */ ## cp ${srcdir}/alloca.s allocatem.c @@ -819,7 +816,6 @@ @$(RM) alloca.o ## Xenix, in particular, needs to run assembler via cc. $(CC) -c allocax.s - mv allocax.o alloca.o $(RM) allocax.s allocatem.c #endif /* HAVE_ALLOCA */ #endif /* ! defined (C_ALLOCA) */
--- a/src/abbrev.c Tue May 21 23:47:40 2002 +0000 +++ b/src/abbrev.c Thu May 23 11:46:46 2002 +0000 @@ -231,7 +231,7 @@ if (wordend <= wordstart) return 0; - p = word = (Intbyte *) alloca (MAX_EMCHAR_LEN * (wordend - wordstart)); + p = word = (Intbyte *) ALLOCA (MAX_EMCHAR_LEN * (wordend - wordstart)); for (idx = wordstart; idx < wordend; idx++) { Emchar c = BUF_FETCH_CHAR (buf, idx);
--- a/src/alloc.c Tue May 21 23:47:40 2002 +0000 +++ b/src/alloc.c Thu May 23 11:46:46 2002 +0000 @@ -94,6 +94,10 @@ /* Number of bytes of consing done since the last gc */ static EMACS_INT consing_since_gc; int need_to_garbage_collect; +int need_to_check_c_alloca; +int funcall_allocation_flag; +Bytecount __temp_alloca_size__; +Bytecount funcall_alloca_count; /* Determine now whether we need to garbage collect or not, to make Ffuncall() faster */ @@ -401,6 +405,10 @@ esp. as the object are not large -- large stuff like buffer text and redisplay structures and allocated separately. */ memset (val, 0, size); + + if (need_to_check_c_alloca) + xemacs_c_alloca (0); + return val; } @@ -1909,7 +1917,7 @@ #endif /* You do NOT want to be calling this! (And if you do, you must call - XSET_STRING_ASCII_BEGIN() after modifying the string.) Use alloca() + XSET_STRING_ASCII_BEGIN() after modifying the string.) Use ALLOCA () instead and then call make_string() like the rest of the world. */ Lisp_Object @@ -3999,6 +4007,12 @@ return make_int (total_data_usage ()); } +void +recompute_funcall_allocation_flag (void) +{ + funcall_allocation_flag = need_to_garbage_collect || need_to_check_c_alloca; +} + /* True if it's time to garbage collect now. */ static void recompute_need_to_garbage_collect (void) @@ -4014,6 +4028,7 @@ gc_cons_percentage #endif /* 0 */ ); + recompute_funcall_allocation_flag (); } @@ -4219,6 +4234,9 @@ consing_since_gc = 0; need_to_garbage_collect = always_gc; + need_to_check_c_alloca = 0; + funcall_allocation_flag = 0; + funcall_alloca_count = 0; #if 1 gc_cons_threshold = 500000; /* XEmacs change */
--- a/src/alloca.c Tue May 21 23:47:40 2002 +0000 +++ b/src/alloca.c Thu May 23 11:46:46 2002 +0000 @@ -26,36 +26,16 @@ /* Authorship: FSF: A long time ago. - Very few changes for XEmacs. + Some cleanups for XEmacs. */ #ifdef HAVE_CONFIG_H #include <config.h> #endif -/* XEmacs: If compiling with GCC 2, this file is theoretically not needed. - However, alloca() is broken under GCC 2 on many machines: you - cannot put a call to alloca() as part of an argument to a function. - */ -/* If someone has defined alloca as a macro, - there must be some other way alloca is supposed to work. */ -/* XEmacs sometimes uses the C alloca even when a builtin alloca is available, - because it's safer. */ -#if defined (EMACS_WANTS_C_ALLOCA) || (!defined (alloca) && (!defined (__GNUC__) || __GNUC__ < 2)) - #ifdef emacs -#ifdef static -/* actually, only want this if static is defined as "" - -- this is for usg, in which emacs must undefine static - in order to make unexec workable - */ -#ifndef STACK_DIRECTION -you -lose --- must know STACK_DIRECTION at compile-time -#endif /* STACK_DIRECTION undefined */ -#endif /* static */ -#endif /* emacs */ +#include "lisp.h" +#endif /* If your stack is a linked list of frames, you have to provide an "address metric" ADDRESS_FUNCTION macro. */ @@ -67,48 +47,12 @@ #define ADDRESS_FUNCTION(arg) &(arg) #endif -#ifdef __STDC__ /* XEmacs change */ typedef void *pointer; -#else -typedef char *pointer; -#endif - -/* XEmacs: With ERROR_CHECK_MALLOC defined, there is no xfree -- it's - a macro that does some stuff to try and trap invalid frees, - and then calls xfree_1 to actually do the work. */ - -#ifdef emacs -# ifdef ERROR_CHECK_MALLOC -void xfree_1 (pointer); -# define xfree xfree_1 -# else -void xfree (pointer); -# endif -#endif #ifndef NULL #define NULL 0 #endif -/* Different portions of Emacs need to call different versions of - malloc. The Emacs executable needs alloca to call xmalloc, because - ordinary malloc isn't protected from input signals. On the other - hand, the utilities in lib-src need alloca to call malloc; some of - them are very simple, and don't have an xmalloc routine. - - Non-Emacs programs expect this to call use xmalloc. - - Callers below should use malloc. */ - -#ifdef emacs -#define malloc xmalloc -#endif -#ifndef WIN32_NATIVE -extern pointer malloc (); -#else -extern void *malloc(); -#endif - /* Define STACK_DIRECTION if you know the direction of stack growth for your system; otherwise it will be automatically deduced at run-time. @@ -161,13 +105,13 @@ It is very important that sizeof(header) agree with malloc alignment chunk size. The following default should work okay. */ -#ifndef ALIGN_SIZE -#define ALIGN_SIZE sizeof(double) +#ifndef ALIGNMENT_SIZE +#define ALIGNMENT_SIZE sizeof(double) #endif typedef union hdr { - char align[ALIGN_SIZE]; /* To force sizeof(header). */ + char align[ALIGNMENT_SIZE]; /* To force sizeof(header). */ struct { union hdr *next; /* For chaining headers. */ @@ -185,12 +129,7 @@ implementations of C, for example under Gould's UTX/32. */ pointer -#ifdef EMACS_WANTS_C_ALLOCA -c_alloca (size) -#else -alloca (size) -#endif - unsigned size; +xemacs_c_alloca (unsigned int size) { auto char probe; /* Probes stack depth: */ register char *depth = ADDRESS_FUNCTION (probe); @@ -212,7 +151,11 @@ { register header *np = hp->h.next; - free ((pointer) hp); /* Collect garbage. */ +#ifdef emacs + xfree (hp); /* Collect garbage. */ +#else + free (hp); /* Collect garbage. */ +#endif hp = np; /* -> next header. */ } @@ -222,13 +165,22 @@ last_alloca_header = hp; /* -> last valid storage. */ } +#ifdef emacs + need_to_check_c_alloca = size > 0 || last_alloca_header; + recompute_funcall_allocation_flag (); +#endif + if (size == 0) return NULL; /* No allocation required. */ /* Allocate combined header + user data storage. */ { +#ifdef emacs + register pointer new = xmalloc (sizeof (header) + size); +#else register pointer new = malloc (sizeof (header) + size); +#endif /* Address of header. */ ((header *) new)->h.next = last_alloca_header; @@ -509,5 +461,3 @@ #endif /* not CRAY2 */ #endif /* CRAY */ - -#endif /* complicated expression at top of file */
--- a/src/callint.c Tue May 21 23:47:40 2002 +0000 +++ b/src/callint.c Thu May 23 11:46:46 2002 +0000 @@ -390,7 +390,7 @@ goto lose; } - /* FSFmacs makes an alloca() copy of prompt_data here. + /* FSFmacs makes an ALLOCA () copy of prompt_data here. We're more intelligent about this and just reset prompt_data as necessary. */ /* If either specs or prompt_data is set to a string, use it. */
--- a/src/callproc.c Tue May 21 23:47:40 2002 +0000 +++ b/src/callproc.c Thu May 23 11:46:46 2002 +0000 @@ -434,7 +434,7 @@ if (bufsize < 64 * 1024 && total_read > 32 * bufsize) { bufsize *= 2; - bufptr = (char *) alloca (bufsize); + bufptr = (char *) ALLOCA (bufsize); } if (!NILP (display) && INTERACTIVE)
--- a/src/config.h.in Tue May 21 23:47:40 2002 +0000 +++ b/src/config.h.in Thu May 23 11:46:46 2002 +0000 @@ -624,6 +624,8 @@ #define XLIB_ILLEGAL_ACCESS 1 #endif +#define XEMACS_WANTS_C_ALLOCA + /* alloca twiddling. Because we might be #including alloca.h here, feature test macros such as _XOPEN_SOURCE must be defined above. */ @@ -649,8 +651,12 @@ /* AIX requires this before any "real" code in the translation unit. */ #pragma alloca #elif ! defined (alloca) +#ifdef C_ALLOCA +#define alloca xemacs_c_alloca +#else void *alloca (); -#endif +#endif /* C_ALLOCA */ +#endif /* !defined (alloca) */ #endif /* C code */ /* The configuration script may define `opsysfile' to be the name of
--- a/src/device-msw.c Tue May 21 23:47:40 2002 +0000 +++ b/src/device-msw.c Thu May 23 11:46:46 2002 +0000 @@ -438,7 +438,7 @@ return Qnil; /* this is destructive, but that's ok because the string is either in - name[] or alloca()ed */ + name[] or ALLOCA ()ed */ qxestrtok (nameint, ","); return build_intstring (nameint); @@ -1249,7 +1249,7 @@ if (GetLastError () != ERROR_INSUFFICIENT_BUFFER) signal_enum_printer_error (); - data_buf = (BYTE *) alloca (bytes_needed); + data_buf = (BYTE *) ALLOCA (bytes_needed); ok = qxeEnumPrinters (enum_flags, NULL, enum_level, data_buf, bytes_needed, &bytes_needed, &num_printers); if (!ok)
--- a/src/device-x.c Tue May 21 23:47:40 2002 +0000 +++ b/src/device-x.c Thu May 23 11:46:46 2002 +0000 @@ -644,7 +644,7 @@ { LISP_STRING_TO_EXTERNAL (Vx_app_defaults_directory, data_dir, Qfile_name); - path = (Extbyte *) alloca (strlen (data_dir) + strlen (locale) + + path = (Extbyte *) ALLOCA (strlen (data_dir) + strlen (locale) + 7); sprintf (path, "%s%s/Emacs", data_dir, locale); if (!access (path, R_OK)) @@ -653,7 +653,7 @@ else if (STRINGP (Vdata_directory) && XSTRING_LENGTH (Vdata_directory) > 0) { LISP_STRING_TO_EXTERNAL (Vdata_directory, data_dir, Qfile_name); - path = (Extbyte *) alloca (strlen (data_dir) + 13 + strlen (locale) + + path = (Extbyte *) ALLOCA (strlen (data_dir) + 13 + strlen (locale) + 7); sprintf (path, "%sapp-defaults/%s/Emacs", data_dir, locale); if (!access (path, R_OK))
--- a/src/dired.c Tue May 21 23:47:40 2002 +0000 +++ b/src/dired.c Thu May 23 11:46:46 2002 +0000 @@ -103,7 +103,7 @@ directory = Ffile_name_as_directory (directory); directorylen = XSTRING_LENGTH (directory); - statbuf = (Intbyte *) alloca (directorylen + MAXNAMLEN + 1); + statbuf = (Intbyte *) ALLOCA (directorylen + MAXNAMLEN + 1); memcpy (statbuf, XSTRING_DATA (directory), directorylen); statbuf_tail = statbuf + directorylen; @@ -250,7 +250,7 @@ Bytecount len = NAMLEN (dp); Bytecount pos = XSTRING_LENGTH (directory); int value; - Intbyte *fullname = (Intbyte *) alloca (len + pos + 2); + Intbyte *fullname = (Intbyte *) ALLOCA (len + pos + 2); memcpy (fullname, XSTRING_DATA (directory), pos); if (!IS_DIRECTORY_SEP (fullname[pos - 1]))
--- a/src/doc.c Tue May 21 23:47:40 2002 +0000 +++ b/src/doc.c Thu May 23 11:46:46 2002 +0000 @@ -249,7 +249,7 @@ if (purify_flag) { /* sizeof ("../lib-src/") == 12 */ - name_nonreloc = (Intbyte *) alloca (12 + XSTRING_LENGTH (file) + 8); + name_nonreloc = (Intbyte *) ALLOCA (12 + XSTRING_LENGTH (file) + 8); /* Preparing to dump; DOC file is probably not installed. So check in ../lib-src. */ qxestrcpy (name_nonreloc, (Intbyte *) "../lib-src/");
--- a/src/editfns.c Tue May 21 23:47:40 2002 +0000 +++ b/src/editfns.c Thu May 23 11:46:46 2002 +0000 @@ -1062,7 +1062,7 @@ while (1) { - Extbyte *buf = (Extbyte *) alloca (size); + Extbyte *buf = (Extbyte *) ALLOCA (size); Extbyte *formext; *buf = 1;
--- a/src/emacs.c Tue May 21 23:47:40 2002 +0000 +++ b/src/emacs.c Thu May 23 11:46:46 2002 +0000 @@ -2310,7 +2310,7 @@ The Right Thing on that system. Rumor has it, this must be called for GNU dld in temacs and xemacs. */ { - char *buf = (char *)alloca (XSTRING_LENGTH (Vinvocation_directory) + char *buf = (char *)ALLOCA (XSTRING_LENGTH (Vinvocation_directory) + XSTRING_LENGTH (Vinvocation_name) + 2); sprintf (buf, "%s/%s", XSTRING_DATA (Vinvocation_directory),
--- a/src/emodules.c Tue May 21 23:47:40 2002 +0000 +++ b/src/emodules.c Thu May 23 11:46:46 2002 +0000 @@ -333,7 +333,7 @@ /* This is to get around the fact that build_string() is not declared as taking a const char * as an argument. I HATE compiler warnings. */ - tmod = (char *)alloca (strlen (module) + 1); + tmod = (char *)ALLOCA (strlen (module) + 1); strcpy (tmod, module); GCPRO2(filename, foundname); @@ -345,7 +345,7 @@ if (fd < 0) signal_error (Qdll_error, "Cannot open dynamic module", filename); - soname = (char *)alloca (XSTRING_LENGTH (foundname) + 1); + soname = (char *)ALLOCA (XSTRING_LENGTH (foundname) + 1); strcpy (soname, (char *)XSTRING_DATA (foundname)); dlhandle = dll_open (soname); @@ -368,7 +368,7 @@ if ((f == (const char **)0) || (*f == (const char *)0)) signal_error (Qdll_error, "Invalid dynamic module: Missing symbol `emodule_name'", Qunbound); - mname = (char *)alloca (strlen (*f) + 1); + mname = (char *)ALLOCA (strlen (*f) + 1); strcpy (mname, *f); if (mname[0] == '\0') signal_error (Qdll_error, "Invalid dynamic module: Empty value for `emodule_name'", Qunbound); @@ -377,17 +377,17 @@ if ((f == (const char **)0) || (*f == (const char *)0)) signal_error (Qdll_error, "Missing symbol `emodule_version': Invalid dynamic module", Qunbound); - mver = (char *)alloca (strlen (*f) + 1); + mver = (char *)ALLOCA (strlen (*f) + 1); strcpy (mver, *f); f = (const char **)dll_variable (dlhandle, "emodule_title"); if ((f == (const char **)0) || (*f == (const char *)0)) signal_error (Qdll_error, "Invalid dynamic module: Missing symbol `emodule_title'", Qunbound); - mtitle = (char *)alloca (strlen (*f) + 1); + mtitle = (char *)ALLOCA (strlen (*f) + 1); strcpy (mtitle, *f); - symname = (char *)alloca (strlen (mname) + 15); + symname = (char *)ALLOCA (strlen (mname) + 15); strcpy (symname, "modules_of_"); strcat (symname, mname);
--- a/src/eval.c Tue May 21 23:47:40 2002 +0000 +++ b/src/eval.c Thu May 23 11:46:46 2002 +0000 @@ -3562,9 +3562,21 @@ Lisp_Object *fun_args = args + 1; QUIT; - if (need_to_garbage_collect) - /* Callers should gcpro lexpr args */ - garbage_collect_1 (); + + if (funcall_allocation_flag) + { + if (need_to_garbage_collect) + /* Callers should gcpro lexpr args */ + garbage_collect_1 (); + if (need_to_check_c_alloca) + { + if (++funcall_alloca_count >= MAX_FUNCALLS_BETWEEN_ALLOCA_CLEANUP) + { + xemacs_c_alloca (0); + funcall_alloca_count = 0; + } + } + } if (++lisp_eval_depth > max_lisp_eval_depth) {
--- a/src/event-Xt.c Tue May 21 23:47:40 2002 +0000 +++ b/src/event-Xt.c Thu May 23 11:46:46 2002 +0000 @@ -1083,7 +1083,7 @@ } case XLookupNone: return Qnil; case XBufferOverflow: - bufptr = (char *) alloca (len+1); + bufptr = (char *) ALLOCA (len+1); bufsiz = len+1; goto Lookup_String; }
--- a/src/event-msw.c Tue May 21 23:47:40 2002 +0000 +++ b/src/event-msw.c Thu May 23 11:46:46 2002 +0000 @@ -1741,7 +1741,7 @@ if (!DdeCmpStringHandles (hszTopic, mswindows_dde_topic_system)) { DWORD len = DdeGetData (hdata, NULL, 0, 0); - LPBYTE extcmd = (LPBYTE) alloca (len+1); + LPBYTE extcmd = (LPBYTE) ALLOCA (len+1); Intbyte *cmd; Intbyte *end; struct gcpro gcpro1, gcpro2; @@ -3334,7 +3334,7 @@ * 3.10 of rfc1738 because they're missing the //<host>/ part and * because they may contain reserved characters. But that's OK - * they just need to be good enough to keep dragdrop.el happy. */ - fname_ext = (Extbyte *) alloca ((len + 1) * XETCHAR_SIZE); + fname_ext = (Extbyte *) ALLOCA ((len + 1) * XETCHAR_SIZE); qxeDragQueryFile ((HDROP) wParam, i, fname_ext, len + 1); TO_INTERNAL_FORMAT (DATA, (fname_ext, len * XETCHAR_SIZE),
--- a/src/event-stream.c Tue May 21 23:47:40 2002 +0000 +++ b/src/event-stream.c Thu May 23 11:46:46 2002 +0000 @@ -2227,12 +2227,11 @@ status_notify (); /* Notice process change */ -#ifdef C_ALLOCA - alloca (0); /* Cause a garbage collection now */ /* Since we can free the most stuff here * (since this is typically called from * the command-loop top-level). */ -#endif /* C_ALLOCA */ + if (need_to_check_c_alloca) + xemacs_c_alloca (0); /* Cause a garbage collection now */ if (object_dead_p (XEVENT (event)->channel)) /* event_console_or_selected may crash if the channel is dead.
--- a/src/file-coding.c Tue May 21 23:47:40 2002 +0000 +++ b/src/file-coding.c Thu May 23 11:46:46 2002 +0000 @@ -1018,7 +1018,7 @@ setup_eol_coding_systems (Lisp_Object codesys) { int len = XSTRING_LENGTH (XSYMBOL (XCODING_SYSTEM_NAME (codesys))->name); - Intbyte *codesys_name = (Intbyte *) alloca (len + 7); + Intbyte *codesys_name = (Intbyte *) ALLOCA (len + 7); int mlen = -1; Intbyte *codesys_mnemonic = 0; Lisp_Object codesys_name_sym, sub_codesys; @@ -1030,7 +1030,7 @@ if (STRINGP (XCODING_SYSTEM_MNEMONIC (codesys))) { mlen = XSTRING_LENGTH (XCODING_SYSTEM_MNEMONIC (codesys)); - codesys_mnemonic = (Intbyte *) alloca (mlen + 7); + codesys_mnemonic = (Intbyte *) ALLOCA (mlen + 7); memcpy (codesys_mnemonic, XSTRING_DATA (XCODING_SYSTEM_MNEMONIC (codesys)), mlen); }
--- a/src/fileio.c Tue May 21 23:47:40 2002 +0000 +++ b/src/fileio.c Thu May 23 11:46:46 2002 +0000 @@ -574,7 +574,7 @@ handler = Ffind_file_name_handler (directory, Qdirectory_file_name); if (!NILP (handler)) return call2_check_string (handler, Qdirectory_file_name, directory); - buf = (Intbyte *) alloca (XSTRING_LENGTH (directory) + 20); + buf = (Intbyte *) ALLOCA (XSTRING_LENGTH (directory) + 20); directory_file_name (XSTRING_DATA (directory), buf); return build_intstring (buf); } @@ -976,7 +976,7 @@ { for (p = nm; *p && (!IS_DIRECTORY_SEP (*p)); p++) DO_NOTHING; - o = (Intbyte *) alloca (p - nm + 1); + o = (Intbyte *) ALLOCA (p - nm + 1); memcpy (o, nm, p - nm); o [p - nm] = 0; @@ -1046,7 +1046,7 @@ if (!newdir) { /* Either nm starts with /, or drive isn't mounted. */ - newdir = (Intbyte *) alloca (4); + newdir = (Intbyte *) ALLOCA (4); newdir[0] = DRIVE_LETTER (drive); newdir[1] = ':'; newdir[2] = '/'; @@ -1110,7 +1110,7 @@ } if (!IS_DIRECTORY_SEP (nm[0])) { - Intbyte *tmp = (Intbyte *) alloca (qxestrlen (newdir) + + Intbyte *tmp = (Intbyte *) ALLOCA (qxestrlen (newdir) + qxestrlen (nm) + 2); file_name_as_directory (tmp, newdir); qxestrcat (tmp, nm); @@ -1152,7 +1152,7 @@ { newdir = (Intbyte *) - qxestrcpy ((Intbyte *) alloca (qxestrlen (newdir) + 1), + qxestrcpy ((Intbyte *) ALLOCA (qxestrlen (newdir) + 1), newdir); p = newdir + 2; while (*p && !IS_DIRECTORY_SEP (*p)) p++; @@ -1177,7 +1177,7 @@ #endif ) { - Intbyte *temp = (Intbyte *) alloca (length); + Intbyte *temp = (Intbyte *) ALLOCA (length); memcpy (temp, newdir, length - 1); temp[length - 1] = 0; newdir = temp; @@ -1193,10 +1193,10 @@ /* Reserve space for drive specifier and escape prefix, since either or both may need to be inserted. (The Microsoft x86 compiler produces incorrect code if the following two lines are combined.) */ - target = (Intbyte *) alloca (tlen + 4); + target = (Intbyte *) ALLOCA (tlen + 4); target += 4; #else /* not WIN32_FILENAMES */ - target = (Intbyte *) alloca (tlen); + target = (Intbyte *) ALLOCA (tlen); #endif /* not WIN32_FILENAMES */ *target = 0; @@ -1550,7 +1550,7 @@ } /* Copy out the variable name */ - target = (Intbyte *) alloca (s - o + 1); + target = (Intbyte *) ALLOCA (s - o + 1); qxestrncpy (target, o, s - o); target[s - o] = 0; #ifdef WIN32_NATIVE @@ -1569,7 +1569,7 @@ /* If substitution required, recopy the filename and do it */ /* Make space in stack frame for the new copy */ - xnm = (Intbyte *) alloca (XSTRING_LENGTH (filename) + total + 1); + xnm = (Intbyte *) ALLOCA (XSTRING_LENGTH (filename) + total + 1); x = xnm; /* Copy the rest of the name through, replacing $ constructs with values */ @@ -1601,7 +1601,7 @@ } /* Copy out the variable name */ - target = (Intbyte *) alloca (s - o + 1); + target = (Intbyte *) ALLOCA (s - o + 1); qxestrncpy (target, o, s - o); target[s - o] = 0; #ifdef WIN32_NATIVE @@ -3663,13 +3663,13 @@ extra = XSTRING_LENGTH (string) % CRYPT_BLOCK_SIZE; rounded_size = XSTRING_LENGTH (string) + extra; - encrypted_string = alloca (rounded_size + 1); + encrypted_string = ALLOCA (rounded_size + 1); memcpy (encrypted_string, XSTRING_DATA (string), XSTRING_LENGTH (string)); memset (encrypted_string + rounded_size - extra, 0, extra + 1); key_size = min (CRYPT_KEY_SIZE, XSTRING_LENGTH (key)) - raw_key = alloca (CRYPT_KEY_SIZE + 1); + raw_key = ALLOCA (CRYPT_KEY_SIZE + 1); memcpy (raw_key, XSTRING_DATA (key), key_size); memset (raw_key + key_size, 0, (CRYPT_KEY_SIZE + 1) - key_size); @@ -3691,13 +3691,13 @@ CHECK_STRING (key); string_size = XSTRING_LENGTH (string) + 1; - decrypted_string = alloca (string_size); + decrypted_string = ALLOCA (string_size); memcpy (decrypted_string, XSTRING_DATA (string), string_size); decrypted_string[string_size - 1] = '\0'; key_size = min (CRYPT_KEY_SIZE, XSTRING_LENGTH (key)) - raw_key = alloca (CRYPT_KEY_SIZE + 1); + raw_key = ALLOCA (CRYPT_KEY_SIZE + 1); memcpy (raw_key, XSTRING_DATA (key), key_size); memset (raw_key + key_size, 0, (CRYPT_KEY_SIZE + 1) - key_size);
--- a/src/filelock.c Tue May 21 23:47:40 2002 +0000 +++ b/src/filelock.c Thu May 23 11:46:46 2002 +0000 @@ -93,7 +93,7 @@ /* Write the name of the lock file for FN into LFNAME. Length will be that of FN plus two more for the leading `.#' plus one for the null. */ #define MAKE_LOCK_NAME(lock, file) \ - (lock = (Intbyte *) alloca (XSTRING_LENGTH (file) + 2 + 1), \ + (lock = (Intbyte *) ALLOCA (XSTRING_LENGTH (file) + 2 + 1), \ fill_in_lock_file_name (lock, file)) static void @@ -138,7 +138,7 @@ host_name = (Intbyte *) ""; lock_info_str = - (Intbyte *) alloca (qxestrlen (user_name) + qxestrlen (host_name) + (Intbyte *) ALLOCA (qxestrlen (user_name) + qxestrlen (host_name) + LOCK_PID_MAX + 5); qxesprintf (lock_info_str, "%s@%s.%d", user_name, host_name, qxe_getpid ()); @@ -191,7 +191,7 @@ read it to determine return value, so allocate it. */ if (!owner) { - owner = (lock_info_type *) alloca (sizeof (lock_info_type)); + owner = (lock_info_type *) ALLOCA (sizeof (lock_info_type)); local_owner = 1; } @@ -346,7 +346,7 @@ goto done; /* Else consider breaking the lock */ - locker = (Intbyte *) alloca (qxestrlen (lock_info.user) + locker = (Intbyte *) ALLOCA (qxestrlen (lock_info.user) + qxestrlen (lock_info.host) + LOCK_PID_MAX + 9); qxesprintf (locker, "%s@%s (pid %d)", lock_info.user, lock_info.host,
--- a/src/fns.c Tue May 21 23:47:40 2002 +0000 +++ b/src/fns.c Thu May 23 11:46:46 2002 +0000 @@ -617,6 +617,7 @@ Intbyte *string_result = 0; Intbyte *string_result_ptr = 0; struct gcpro gcpro1; + int sdep = specpdl_depth (); /* The modus operandi in Emacs is "caller gc-protects args". However, concat is called many times in Emacs on freshly @@ -699,8 +700,11 @@ { case c_cons: if (total_length == 0) - /* In append, if all but last arg are nil, return last arg */ - RETURN_UNGCPRO (last_tail); + { + unbind_to (sdep); + /* In append, if all but last arg are nil, return last arg */ + RETURN_UNGCPRO (last_tail); + } val = Fmake_list (make_int (total_length), Qnil); break; case c_vector: @@ -720,7 +724,8 @@ realloc()ing in order to make the char fit properly. O(N^2) yuckage. */ val = Qnil; - string_result = (Intbyte *) alloca (total_length * MAX_EMCHAR_LEN); + string_result = + (Intbyte *) MALLOC_OR_ALLOCA (total_length * MAX_EMCHAR_LEN); string_result_ptr = string_result; break; default: @@ -838,6 +843,7 @@ if (!NILP (prev)) XCDR (prev) = last_tail; + unbind_to (sdep); RETURN_UNGCPRO (val); } @@ -3100,7 +3106,7 @@ results computed so far. if (vals == 0) we don't have any free space available and - don't want to eat up any more stack with alloca(). + don't want to eat up any more stack with ALLOCA (). So we use EXTERNAL_LIST_LOOP_3_NO_DECLARE and GCPRO the tail. */ if (vals) @@ -3756,39 +3762,6 @@ #undef ADVANCE_INPUT_IGNORE_NONBASE64 #undef STORE_BYTE -static Lisp_Object -free_malloced_ptr (Lisp_Object unwind_obj) -{ - void *ptr = (void *)get_opaque_ptr (unwind_obj); - xfree (ptr); - free_opaque_ptr (unwind_obj); - return Qnil; -} - -/* Don't use alloca for regions larger than this, lest we overflow - the stack. */ -#define MAX_ALLOCA 65536 - -/* We need to setup proper unwinding, because there is a number of - ways these functions can blow up, and we don't want to have memory - leaks in those cases. */ -#define XMALLOC_OR_ALLOCA(ptr, len, type) do { \ - Elemcount XOA_len = (len); \ - if (XOA_len > MAX_ALLOCA) \ - { \ - ptr = xnew_array (type, XOA_len); \ - record_unwind_protect (free_malloced_ptr, \ - make_opaque_ptr ((void *)ptr)); \ - } \ - else \ - ptr = alloca_array (type, XOA_len); \ -} while (0) - -#define XMALLOC_UNBIND(ptr, len, speccount) do { \ - if ((len) > MAX_ALLOCA) \ - unbind_to (speccount); \ -} while (0) - DEFUN ("base64-encode-region", Fbase64_encode_region, 2, 3, "r", /* Base64-encode the region between START and END. Return the length of the encoded text. @@ -3803,7 +3776,7 @@ struct buffer *buf = current_buffer; Charbpos begv, zv, old_pt = BUF_PT (buf); Lisp_Object input; - int speccount = specpdl_depth(); + int speccount = specpdl_depth (); get_buffer_range_char (buf, start, end, &begv, &zv, 0); barf_if_buffer_read_only (buf, begv, zv); @@ -3818,7 +3791,7 @@ input = make_lisp_buffer_input_stream (buf, begv, zv, 0); /* We needn't multiply allength with MAX_EMCHAR_LEN because all the base64 characters will be single-byte. */ - XMALLOC_OR_ALLOCA (encoded, allength, Intbyte); + encoded = (Intbyte *) MALLOC_OR_ALLOCA (allength); encoded_length = base64_encode_1 (XLSTREAM (input), encoded, NILP (no_line_break)); if (encoded_length > allength) @@ -3828,7 +3801,7 @@ /* Now we have encoded the region, so we insert the new contents and delete the old. (Insert first in order to preserve markers.) */ buffer_insert_raw_string_1 (buf, begv, encoded, encoded_length, 0); - XMALLOC_UNBIND (encoded, allength, speccount); + unbind_to (speccount); buffer_delete_range (buf, begv + encoded_length, zv + encoded_length, 0); /* Simulate FSF Emacs implementation of this function: if point was @@ -3860,14 +3833,14 @@ allength += allength / MIME_LINE_LENGTH + 1 + 6; input = make_lisp_string_input_stream (string, 0, -1); - XMALLOC_OR_ALLOCA (encoded, allength, Intbyte); + encoded = (Intbyte *) MALLOC_OR_ALLOCA (allength); encoded_length = base64_encode_1 (XLSTREAM (input), encoded, NILP (no_line_break)); if (encoded_length > allength) abort (); Lstream_delete (XLSTREAM (input)); result = make_string (encoded, encoded_length); - XMALLOC_UNBIND (encoded, allength, speccount); + unbind_to (speccount); return result; } @@ -3894,7 +3867,7 @@ input = make_lisp_buffer_input_stream (buf, begv, zv, 0); /* We need to allocate enough room for decoding the text. */ - XMALLOC_OR_ALLOCA (decoded, length * MAX_EMCHAR_LEN, Intbyte); + decoded = (Intbyte *) MALLOC_OR_ALLOCA (length * MAX_EMCHAR_LEN); decoded_length = base64_decode_1 (XLSTREAM (input), decoded, &cc_decoded_length); if (decoded_length > length * MAX_EMCHAR_LEN) abort (); @@ -3904,7 +3877,7 @@ and delete the old. (Insert first in order to preserve markers.) */ BUF_SET_PT (buf, begv); buffer_insert_raw_string_1 (buf, begv, decoded, decoded_length, 0); - XMALLOC_UNBIND (decoded, length * MAX_EMCHAR_LEN, speccount); + unbind_to (speccount); buffer_delete_range (buf, begv + cc_decoded_length, zv + cc_decoded_length, 0); @@ -3932,7 +3905,7 @@ length = string_char_length (string); /* We need to allocate enough room for decoding the text. */ - XMALLOC_OR_ALLOCA (decoded, length * MAX_EMCHAR_LEN, Intbyte); + decoded = (Intbyte *) MALLOC_OR_ALLOCA (length * MAX_EMCHAR_LEN); input = make_lisp_string_input_stream (string, 0, -1); decoded_length = base64_decode_1 (XLSTREAM (input), decoded, @@ -3942,7 +3915,7 @@ Lstream_delete (XLSTREAM (input)); result = make_string (decoded, decoded_length); - XMALLOC_UNBIND (decoded, length * MAX_EMCHAR_LEN, speccount); + unbind_to (speccount); return result; }
--- a/src/glyphs-gtk.c Tue May 21 23:47:40 2002 +0000 +++ b/src/glyphs-gtk.c Thu May 23 11:46:46 2002 +0000 @@ -1436,7 +1436,7 @@ if (emsg) gui_error_2 (emsg, data, Qimage); - bp = bits = (char *) alloca (PIXELS / 8); + bp = bits = (char *) ALLOCA (PIXELS / 8); /* the compface library exports char F[], which uses a single byte per pixel to represent a 48x48 bitmap. Yuck. */
--- a/src/glyphs-msw.c Tue May 21 23:47:40 2002 +0000 +++ b/src/glyphs-msw.c Thu May 23 11:46:46 2002 +0000 @@ -1674,7 +1674,7 @@ if (emsg) signal_image_error_2 (emsg, data, Qimage); - bp = bits = (UChar_Binary *) alloca (PIXELS / 8); + bp = bits = (UChar_Binary *) ALLOCA (PIXELS / 8); /* the compface library exports char F[], which uses a single byte per pixel to represent a 48x48 bitmap. Yuck. */ @@ -2804,7 +2804,7 @@ if (EQ (prop, Q_text)) { Charcount tchar_len = qxeSendMessage (wnd, WM_GETTEXTLENGTH, 0, 0); - Extbyte *buf = (Extbyte *) alloca (XETCHAR_SIZE * (tchar_len + 1)); + Extbyte *buf = (Extbyte *) ALLOCA (XETCHAR_SIZE * (tchar_len + 1)); qxeSendMessage (wnd, WM_GETTEXT, (WPARAM)tchar_len + 1, (LPARAM) buf); return build_tstr_string (buf); @@ -2841,7 +2841,7 @@ long item = qxeSendMessage (wnd, CB_GETCURSEL, 0, 0); Charcount tchar_len = qxeSendMessage (wnd, CB_GETLBTEXTLEN, (WPARAM)item, 0); - Extbyte *buf = (Extbyte *) alloca (XETCHAR_SIZE * (tchar_len + 1)); + Extbyte *buf = (Extbyte *) ALLOCA (XETCHAR_SIZE * (tchar_len + 1)); qxeSendMessage (wnd, CB_GETLBTEXT, (WPARAM)item, (LPARAM) buf); return build_tstr_string (buf); }
--- a/src/glyphs-x.c Tue May 21 23:47:40 2002 +0000 +++ b/src/glyphs-x.c Thu May 23 11:46:46 2002 +0000 @@ -1596,7 +1596,7 @@ if (emsg) gui_error_2 (emsg, data, Qimage); - bp = bits = (Char_Binary *) alloca (PIXELS / 8); + bp = bits = (Char_Binary *) ALLOCA (PIXELS / 8); /* the compface library exports char F[], which uses a single byte per pixel to represent a 48x48 bitmap. Yuck. */
--- a/src/gui-x.c Tue May 21 23:47:40 2002 +0000 +++ b/src/gui-x.c Thu May 23 11:46:46 2002 +0000 @@ -372,7 +372,7 @@ else { Bytecount namelen = XSTRING_LENGTH (string); - Intbyte *chars = (Intbyte *) alloca (namelen + 3); + Intbyte *chars = (Intbyte *) ALLOCA (namelen + 3); chars[0] = '%'; chars[1] = '_'; memcpy (chars + 2, name, namelen + 1);
--- a/src/input-method-xlib.c Tue May 21 23:47:40 2002 +0000 +++ b/src/input-method-xlib.c Thu May 23 11:46:46 2002 +0000 @@ -655,7 +655,7 @@ if (p->count_styles == 0) { /* No valid styles? */ - char *buf = (char *)alloca (strlen (fromVal->addr) + char *buf = (char *)ALLOCA (strlen (fromVal->addr) + strlen (DefaultXIMStyles) + 100); XrmValue new_from;
--- a/src/intl-win32.c Tue May 21 23:47:40 2002 +0000 +++ b/src/intl-win32.c Thu May 23 11:46:46 2002 +0000 @@ -1430,7 +1430,7 @@ ()) { int num_layouts = GetKeyboardLayoutList (0, NULL); - HKL * layouts = (HKL *) alloca (num_layouts * sizeof (HKL)); + HKL * layouts = (HKL *) ALLOCA (num_layouts * sizeof (HKL)); Lisp_Object obj = Qnil; if (GetKeyboardLayoutList (num_layouts, layouts) == num_layouts)
--- a/src/lisp.h Tue May 21 23:47:40 2002 +0000 +++ b/src/lisp.h Thu May 23 11:46:46 2002 +0000 @@ -939,8 +939,91 @@ #define xzero(lvalue) ((void) memset (&(lvalue), '\0', sizeof (lvalue))) #define xnew_array_and_zero(type, len) ((type *) xmalloc_and_zero ((len) * sizeof (type))) #define XREALLOC_ARRAY(ptr, type, len) ((void) (ptr = (type *) xrealloc (ptr, (len) * sizeof (type)))) -#define alloca_new(type) ((type *) alloca (sizeof (type))) -#define alloca_array(type, len) ((type *) alloca ((len) * sizeof (type))) +#define alloca_new(type) ((type *) ALLOCA (sizeof (type))) +#define alloca_array(type, len) ((type *) ALLOCA ((len) * sizeof (type))) + +void *xemacs_c_alloca (unsigned int size); + +int record_unwind_protect_freeing (void *ptr); + +DECLARE_INLINE_HEADER ( +void * +xmalloc_and_record_unwind (Bytecount size) +) +{ + void *ptr = xmalloc (size); + record_unwind_protect_freeing (ptr); + return ptr; +} + +/* Stack allocation. + + Allocating excessively large blocks on the stack can cause crashes. + We provide MALLOC_OR_ALLOCA() below for places where it's likely that + large amounts will be allocated; it mallocs the block if it's too big. + Unfortunately, that requires a call to unbind_to() at the end of the + function, and it's not feasible to rewrite all calls to alloca() this + way. + + Instead, we use the portable C alloca() substitute in alloca.c above a + certain size. This actually uses malloc(), but checks the current stack + pointer to see if data from previous alloca() calls needs to be freed. + However, this can lead to large heap sizes -- especially since cleanup + can only happen in a parent function, and will never happen if (as will + often be the case) it's the same function in the same place in the code + that keeps tripping the alloca() limit. + + So we set up a system to periodically force cleanup. Currently we + do cleanup: + + -- Only when there's C alloca() data, and then + -- Every stack alloca() or allocation of Lisp data, every call to + next_event_internal() [typically near the top of the stack], + or every 10th funcall + + This should not be a big penalty because + + (a) If there are few C alloca() chunks, checking them will be fast + (b) If not, we've allocated a huge amount of heap space (remember, each + chunk represents > 256K of heap), and we really want them gone +*/ + +/* We use a larger maximum when the choice is alloca() vs. the C alloca() + substitute than when the choice is vs. malloc(), because in the former + case, our alternative choice is less palatable because the memory may + not be freed for awhile. */ + +#define MAX_ALLOCA_VS_C_ALLOCA 262144 +#define MAX_ALLOCA_VS_MALLOC 65536 + +#define MAX_FUNCALLS_BETWEEN_ALLOCA_CLEANUP 10 + +extern Bytecount __temp_alloca_size__; +extern Bytecount funcall_alloca_count; + +/* Do stack or heap alloca() depending on size. + +NOTE: The use of a global temporary like this is unsafe if ALLOCA() occurs +twice anywhere in the same expression; but that seems highly unlikely. The +alternative is to force all callers to declare a local temporary if the +expression has side effects -- something easy to forget. */ + +#define ALLOCA(size) \ + (__temp_alloca_size__ = (size), \ + __temp_alloca_size__ > MAX_ALLOCA_VS_C_ALLOCA ? \ + xemacs_c_alloca (__temp_alloca_size__) : \ + (need_to_check_c_alloca ? xemacs_c_alloca (0) : 0, \ + alloca (__temp_alloca_size__))) + +/* WARNING: If you use this, you must unbind_to() at the end of your + function! */ + +#define MALLOC_OR_ALLOCA(size) \ + (__temp_alloca_size__ = (size), \ + __temp_alloca_size__ > MAX_ALLOCA_VS_MALLOC ? \ + xmalloc_and_record_unwind (__temp_alloca_size__) : \ + (need_to_check_c_alloca ? xemacs_c_alloca (0) : 0, \ + alloca (__temp_alloca_size__))) /* also generally useful if you want to avoid arbitrary size limits but don't need a full dynamic array. Assumes that BASEVAR points @@ -1929,7 +2012,7 @@ }; typedef struct Lisp_String Lisp_String; -#define MAX_STRING_ASCII_BEGIN ((2 << 21) - 1) +#define MAX_STRING_ASCII_BEGIN ((1 << 21) - 1) DECLARE_LRECORD (string, Lisp_String); #define XSTRING(x) XRECORD (x, string, Lisp_String) @@ -3121,7 +3204,10 @@ int object_dead_p (Lisp_Object); void mark_object (Lisp_Object obj); int marked_p (Lisp_Object obj); +extern int funcall_allocation_flag; extern int need_to_garbage_collect; +extern int need_to_check_c_alloca; +void recompute_funcall_allocation_flag (void); #ifdef MEMORY_USAGE_STATS Bytecount malloced_storage_size (void *, Bytecount, struct overhead_stats *); @@ -3591,7 +3677,6 @@ #define unbind_to(obj) unbind_to_1 (obj, Qnil) void specbind (Lisp_Object, Lisp_Object); int record_unwind_protect (Lisp_Object (*) (Lisp_Object), Lisp_Object); -int record_unwind_protect_freeing (void *ptr); int record_unwind_protect_freeing_dynarr (void *ptr); int internal_bind_int (int *addr, int newval); int internal_bind_lisp_object (Lisp_Object *addr, Lisp_Object newval);
--- a/src/lread.c Tue May 21 23:47:40 2002 +0000 +++ b/src/lread.c Thu May 23 11:46:46 2002 +0000 @@ -581,7 +581,7 @@ } } - foundstr = (Intbyte *) alloca (XSTRING_LENGTH (found) + 1); + foundstr = (Intbyte *) ALLOCA (XSTRING_LENGTH (found) + 1); qxestrcpy (foundstr, XSTRING_DATA (found)); foundlen = qxestrlen (foundstr); @@ -929,7 +929,7 @@ max = XSTRING_LENGTH (suffixes); fn_len = XSTRING_LENGTH (filename); - fn = (Intbyte *) alloca (max + fn_len + 1); + fn = (Intbyte *) ALLOCA (max + fn_len + 1); memcpy (fn, XSTRING_DATA (filename), fn_len); /* Loop over suffixes. */
--- a/src/menubar-gtk.c Tue May 21 23:47:40 2002 +0000 +++ b/src/menubar-gtk.c Thu May 23 11:46:46 2002 +0000 @@ -697,12 +697,12 @@ if (STRINGP (suffix) && XSTRING_LENGTH (suffix)) { - label_buffer = alloca (XSTRING_LENGTH (name) + 15 + XSTRING_LENGTH (suffix)); + label_buffer = ALLOCA (XSTRING_LENGTH (name) + 15 + XSTRING_LENGTH (suffix)); sprintf (label_buffer, "%s %s ", XSTRING_DATA (name), XSTRING_DATA (suffix)); } else { - label_buffer = alloca (XSTRING_LENGTH (name) + 15); + label_buffer = ALLOCA (XSTRING_LENGTH (name) + 15); sprintf (label_buffer, "%s ", XSTRING_DATA (name)); }
--- a/src/menubar-msw.c Tue May 21 23:47:40 2002 +0000 +++ b/src/menubar-msw.c Thu May 23 11:46:46 2002 +0000 @@ -138,7 +138,7 @@ mswindows_translate_menu_or_dialog_item (Lisp_Object item, Emchar *accel) { Bytecount len = XSTRING_LENGTH (item); - Intbyte *it = (Intbyte *) alloca (2 * len + 42), *ptr = it; + Intbyte *it = (Intbyte *) ALLOCA (2 * len + 42), *ptr = it; memcpy (ptr, XSTRING_DATA (item), len + 1); if (accel)
--- a/src/menubar.c Tue May 21 23:47:40 2002 +0000 +++ b/src/menubar.c Thu May 23 11:46:46 2002 +0000 @@ -342,7 +342,7 @@ end = string_char_length (name); name_data = XSTRING_DATA (name); - string_result = (Intbyte *) alloca (end * MAX_EMCHAR_LEN); + string_result = (Intbyte *) ALLOCA (end * MAX_EMCHAR_LEN); string_result_ptr = string_result; for (i = 0; i < end; i++) {
--- a/src/mule-wnnfns.c Tue May 21 23:47:40 2002 +0000 +++ b/src/mule-wnnfns.c Thu May 23 11:46:46 2002 +0000 @@ -361,7 +361,7 @@ return Qnil; } size = XSTRING_LENGTH (lname) > 1024 ? 1026 : XSTRING_LENGTH (lname) + 2; - envname = alloca (size); + envname = ALLOCA (size); strncpy (envname, (char *) XSTRING_DATA (lname), size-2); envname[size-2] = '\0'; if (NILP (hname)) hostname = ""; @@ -370,7 +370,7 @@ CHECK_STRING (hname); size = XSTRING_LENGTH(hname) > 1024 ? 1025 : XSTRING_LENGTH(hname) + 1; - hostname = alloca (size); + hostname = ALLOCA (size); strncpy (hostname, (char *) XSTRING_DATA (hname), size-1); hostname[size-1] = '\0'; }
--- a/src/nt.c Tue May 21 23:47:40 2002 +0000 +++ b/src/nt.c Thu May 23 11:46:46 2002 +0000 @@ -480,7 +480,7 @@ Charcount cch; cch = qxeExpandEnvironmentStrings ((Extbyte *) lpval, buf, 0); - buf = (Extbyte *) alloca (cch * XETCHAR_SIZE); + buf = (Extbyte *) ALLOCA (cch * XETCHAR_SIZE); qxeExpandEnvironmentStrings ((Extbyte *) lpval, buf, cch); TSTR_TO_C_STRING (buf, envval); eputenv (env_vars[i], envval);
--- a/src/objects-msw.c Tue May 21 23:47:40 2002 +0000 +++ b/src/objects-msw.c Thu May 23 11:46:46 2002 +0000 @@ -990,7 +990,7 @@ } else if (*name) /* Can't be an empty string */ { - Intbyte *nospaces = (Intbyte *) alloca (qxestrlen (name) + 1); + Intbyte *nospaces = (Intbyte *) ALLOCA (qxestrlen (name) + 1); Intbyte *c = nospaces; while (*name) if (*name != ' ') @@ -1729,7 +1729,7 @@ int nsep = 0; Intbyte *ptr = (Intbyte *) XSTRING_DATA (f->name); - Intbyte *name = (Intbyte *) alloca (XSTRING_LENGTH (f->name) + 19); + Intbyte *name = (Intbyte *) ALLOCA (XSTRING_LENGTH (f->name) + 19); qxestrcpy (name, ptr);
--- a/src/process-nt.c Tue May 21 23:47:40 2002 +0000 +++ b/src/process-nt.c Thu May 23 11:46:46 2002 +0000 @@ -908,7 +908,7 @@ while leaving the real app name as argv[0]. */ if (is_dos_app) { - cmdname = (Intbyte *) alloca (PATH_MAX); + cmdname = (Intbyte *) ALLOCA (PATH_MAX); if (egetenv ("CMDPROXY")) qxestrcpy (cmdname, egetenv ("CMDPROXY")); else
--- a/src/realpath.c Tue May 21 23:47:40 2002 +0000 +++ b/src/realpath.c Thu May 23 11:46:46 2002 +0000 @@ -164,7 +164,7 @@ /* The file may exist, but isn't a symlink. Try to find the right name. */ Intbyte *tmp = - (Intbyte *) alloca (cygwin_posix_to_win32_path_list_buf_size + (Intbyte *) ALLOCA (cygwin_posix_to_win32_path_list_buf_size ((char *) name)); cygwin_posix_to_win32_path_list ((char *) name, (char *) tmp); n = mswindows_readlink_and_correct_case (tmp, buf, size);
--- a/src/redisplay-gtk.c Tue May 21 23:47:40 2002 +0000 +++ b/src/redisplay-gtk.c Thu May 23 11:46:46 2002 +0000 @@ -105,7 +105,7 @@ al. (This means converting to one or two byte format, possibly tweaking the high bits, and possibly running a CCL program.) You must pre-allocate the space used and pass it in. (This is done so - you can alloca() the space.) You need to allocate (2 * len) bytes + you can ALLOCA () the space.) You need to allocate (2 * len) bytes of TEXT_STORAGE and (len * sizeof (struct textual_run)) bytes of RUN_STORAGE, where LEN is the length of the dynarr. @@ -244,7 +244,7 @@ Charcount len) { int width_so_far = 0; - unsigned char *text_storage = (unsigned char *) alloca (2 * len); + unsigned char *text_storage = (unsigned char *) ALLOCA (2 * len); struct textual_run *runs = alloca_array (struct textual_run, len); int nruns; int i; @@ -684,7 +684,7 @@ GdkGC *bgc, *gc; int height; int len = Dynarr_length (buf); - unsigned char *text_storage = (unsigned char *) alloca (2 * len); + unsigned char *text_storage = (unsigned char *) ALLOCA (2 * len); struct textual_run *runs = alloca_array (struct textual_run, len); int nruns; int i;
--- a/src/redisplay-output.c Tue May 21 23:47:40 2002 +0000 +++ b/src/redisplay-output.c Thu May 23 11:46:46 2002 +0000 @@ -305,6 +305,86 @@ return 1; } +#if 0 +void +compare_runes_2 (struct window *w, struct rune *crb, struct rune *drb) +{ + if (crb->type == DGLYPH) + { + if (!EQ (crb->object.dglyph.glyph, drb->object.dglyph.glyph) || + !EQ (crb->object.dglyph.extent, drb->object.dglyph.extent) || + crb->object.dglyph.xoffset != drb->object.dglyph.xoffset || + crb->object.dglyph.yoffset != drb->object.dglyph.yoffset || + crb->object.dglyph.ascent != drb->object.dglyph.ascent || + crb->object.dglyph.descent != drb->object.dglyph.descent) + return 0; + /* Only check dirtiness if we know something has changed. */ + else if (XGLYPH_DIRTYP (crb->object.dglyph.glyph) || + crb->findex != drb->findex) + { + /* We need some way of telling redisplay_output_layout () that the + only reason we are outputting it is because something has + changed internally. That way we can optimize whether we need + to clear the layout first and also only output the components + that have changed. The image_instance dirty flag and + display_hash are no good to us because these will invariably + have been set anyway if the layout has changed. So it looks + like we need yet another change flag that we can set here and + then clear in redisplay_output_layout (). */ + Lisp_Object window, image; + Lisp_Image_Instance* ii; + window = wrap_window (w); + image = glyph_image_instance (crb->object.dglyph.glyph, + window, crb->object.dglyph.matchspec, + ERROR_ME_DEBUG_WARN, 1); + + if (!IMAGE_INSTANCEP (image)) + return 0; + ii = XIMAGE_INSTANCE (image); + + if (TEXT_IMAGE_INSTANCEP (image) && + (crb->findex != drb->findex || + WINDOW_FACE_CACHEL_DIRTY (w, drb->findex))) + return 0; + + /* It is quite common for the two glyphs to be EQ since in many + cases they will actually be the same object. This does not + mean, however, that nothing has changed. We therefore need to + check the current hash of the glyph against the last recorded + display hash and the pending display items. See + update_widget () ^^#### which function?. */ + if (image_instance_changed (image) || + crb->findex != drb->findex || + WINDOW_FACE_CACHEL_DIRTY (w, drb->findex)) + { + /* Now we are going to re-output the glyph, but since + this is for some internal reason not related to geometry + changes, send a hint to the output routines that they can + take some short cuts. This is most useful for + layouts. This flag should get reset by the output + routines. + + #### It is possible for us to get here when the + face_cachel is dirty. I do not know what the implications + of this are.*/ + IMAGE_INSTANCE_OPTIMIZE_OUTPUT (ii) = 1; + return 0; + } + else + return 1; + } + else if (crb->findex != drb->findex || + WINDOW_FACE_CACHEL_DIRTY (w, drb->findex)) + return 0; + else + return 1; + } + else return !(memcmp (crb, drb, sizeof (*crb)) || + WINDOW_FACE_CACHEL_DIRTY (w, drb->findex)); +} +#endif + + /***************************************************************************** get_next_display_block
--- a/src/redisplay-x.c Tue May 21 23:47:40 2002 +0000 +++ b/src/redisplay-x.c Thu May 23 11:46:46 2002 +0000 @@ -118,7 +118,7 @@ al. (This means converting to one or two byte format, possibly tweaking the high bits, and possibly running a CCL program.) You must pre-allocate the space used and pass it in. (This is done so - you can alloca() the space.) You need to allocate (2 * len) bytes + you can ALLOCA () the space.) You need to allocate (2 * len) bytes of TEXT_STORAGE and (len * sizeof (struct textual_run)) bytes of RUN_STORAGE, where LEN is the length of the dynarr. @@ -249,7 +249,7 @@ Charcount len) { int width_so_far = 0; - unsigned char *text_storage = (unsigned char *) alloca (2 * len); + unsigned char *text_storage = (unsigned char *) ALLOCA (2 * len); struct textual_run *runs = alloca_array (struct textual_run, len); int nruns; int i; @@ -795,7 +795,7 @@ GC bgc, gc; int height; int len = Dynarr_length (buf); - unsigned char *text_storage = (unsigned char *) alloca (2 * len); + unsigned char *text_storage = (unsigned char *) ALLOCA (2 * len); struct textual_run *runs = alloca_array (struct textual_run, len); int nruns; int i;
--- a/src/redisplay.c Tue May 21 23:47:40 2002 +0000 +++ b/src/redisplay.c Thu May 23 11:46:46 2002 +0000 @@ -5235,10 +5235,12 @@ struct display_line *dlp; Charcount next_pos; int local; + int pos_of_dlp = -1; if (Dynarr_length (dla) < Dynarr_largest (dla)) { - dlp = Dynarr_atp (dla, Dynarr_length (dla)); + pos_of_dlp = Dynarr_length (dla); + dlp = Dynarr_atp (dla, pos_of_dlp); local = 0; } else @@ -5281,6 +5283,7 @@ else dlp->clip = 0; + assert (pos_of_dlp < 0 || pos_of_dlp == Dynarr_length (dla)); Dynarr_add (dla, *dlp); /* #### This type of check needs to be done down in the @@ -5380,10 +5383,12 @@ struct display_line dl; struct display_line *dlp; int local; + int pos_of_dlp = -1; if (Dynarr_length (dla) < Dynarr_largest (dla)) { - dlp = Dynarr_atp (dla, Dynarr_length (dla)); + pos_of_dlp = Dynarr_length (dla); + dlp = Dynarr_atp (dla, pos_of_dlp); local = 0; } else @@ -5463,6 +5468,7 @@ if (dlp->num_chars > w->max_line_len) w->max_line_len = dlp->num_chars; + assert (pos_of_dlp < 0 || pos_of_dlp == Dynarr_length (dla)); Dynarr_add (dla, *dlp); /* #### This isn't right, but it is close enough for now. */
--- a/src/search.c Tue May 21 23:47:40 2002 +0000 +++ b/src/search.c Thu May 23 11:46:46 2002 +0000 @@ -1983,7 +1983,7 @@ /* The following value is an upper bound on the amount of storage we need. In non-Mule, it is exact. */ Intbyte *storage = - (Intbyte *) alloca (XSTRING_LENGTH (string) - punct_count + + (Intbyte *) ALLOCA (XSTRING_LENGTH (string) - punct_count + 5 * (word_count - 1) + 4); Intbyte *o = storage; @@ -2968,7 +2968,7 @@ CHECK_STRING (string); - temp = (Intbyte *) alloca (XSTRING_LENGTH (string) * 2); + temp = (Intbyte *) ALLOCA (XSTRING_LENGTH (string) * 2); /* Now copy the data into the new string, inserting escapes. */
--- a/src/select-msw.c Tue May 21 23:47:40 2002 +0000 +++ b/src/select-msw.c Thu May 23 11:46:46 2002 +0000 @@ -314,7 +314,7 @@ else /* we do NOT append a zero byte. we don't know whether we're dealing with regular text, unicode text, binary data, etc. */ - TO_EXTERNAL_FORMAT (LISP_STRING, data, ALLOCA, (src, size), + TO_EXTERNAL_FORMAT (LISP_STRING, data, MALLOC, (src, size), Qbinary); /* Allocate memory */ @@ -324,6 +324,7 @@ { CloseClipboard (); + xfree (src); return Qnil; } @@ -334,10 +335,12 @@ GlobalFree (hValue); CloseClipboard (); + xfree (src); return Qnil; } memcpy (dst, src, size); + xfree (src); GlobalUnlock (hValue);
--- a/src/sysdep.c Tue May 21 23:47:40 2002 +0000 +++ b/src/sysdep.c Thu May 23 11:46:46 2002 +0000 @@ -589,7 +589,7 @@ dir = Funhandled_file_name_directory (dir); dir = expand_and_dir_to_file (dir, Qnil); - str = (Intbyte *) alloca (XSTRING_LENGTH (dir) + 2); + str = (Intbyte *) ALLOCA (XSTRING_LENGTH (dir) + 2); len = XSTRING_LENGTH (dir); memcpy (str, XSTRING_DATA (dir), len); if (!IS_ANY_SEP (str[len - 1])) @@ -2236,7 +2236,7 @@ Vsystem_name = build_string (uts.nodename); #else /* HAVE_GETHOSTNAME */ int hostname_size = 256; - char *hostname = (char *) alloca (hostname_size); + char *hostname = (char *) ALLOCA (hostname_size); /* Try to get the host name; if the buffer is too short, try again. Apparently, the only indication gethostname gives of @@ -2252,7 +2252,7 @@ break; hostname_size <<= 1; - hostname = (char *) alloca (hostname_size); + hostname = (char *) ALLOCA (hostname_size); } # if defined( HAVE_SOCKETS) /* Turn the hostname into the official, fully-qualified hostname. @@ -2295,7 +2295,7 @@ if (*alias) fqdn = *alias; } - hostname = (char *) alloca (strlen (fqdn) + 1); + hostname = (char *) ALLOCA (strlen (fqdn) + 1); strcpy (hostname, fqdn); } # else /* !(HAVE_GETADDRINFO && HAVE_GETNAMEINFO) */ @@ -2312,7 +2312,7 @@ hints.ai_protocol = 0; if (!getaddrinfo (hostname, NULL, &hints, &res)) { - hostname = (char *) alloca (strlen (res->ai_canonname) + 1); + hostname = (char *) ALLOCA (strlen (res->ai_canonname) + 1); strcpy (hostname, res->ai_canonname); freeaddrinfo (res);
--- a/src/syswindows.h Tue May 21 23:47:40 2002 +0000 +++ b/src/syswindows.h Thu May 23 11:46:46 2002 +0000 @@ -861,7 +861,7 @@ { \ int ltwff2 = \ cygwin_posix_to_win32_path_list_buf_size ((char *) ltwffp); \ - pathout = (Intbyte *) alloca (ltwff2); \ + pathout = (Intbyte *) ALLOCA (ltwff2); \ cygwin_posix_to_win32_path_list ((char *) ltwffp, (char *) pathout); \ } \ } while (0) @@ -878,7 +878,7 @@ Intbyte *wtlff1 = (path); \ int wtlff2 = \ cygwin_win32_to_posix_path_list_buf_size ((char *) wtlff1); \ - Intbyte *wtlff3 = (Intbyte *) alloca (wtlff2); \ + Intbyte *wtlff3 = (Intbyte *) ALLOCA (wtlff2); \ cygwin_win32_to_posix_path_list ((char *) wtlff1, (char *) wtlff3); \ (pathout) = wtlff3; \ } while (0)
--- a/src/text.c Tue May 21 23:47:40 2002 +0000 +++ b/src/text.c Thu May 23 11:46:46 2002 +0000 @@ -1042,7 +1042,7 @@ Bytecount *len_out) { /* Damn zero-termination. */ - Intbyte *str = (Intbyte *) alloca (nels * MAX_EMCHAR_LEN + 1); + Intbyte *str = (Intbyte *) ALLOCA (nels * MAX_EMCHAR_LEN + 1); Intbyte *strorig = str; Bytecount len;
--- a/src/text.h Tue May 21 23:47:40 2002 +0000 +++ b/src/text.h Thu May 23 11:46:46 2002 +0000 @@ -1097,6 +1097,7 @@ memcpy (*_bsta_, _bsta_2, 1 + _bsta_3); \ } while (0) + #define alloca_intbytes(num) alloca_array (Intbyte, num) #define alloca_extbytes(num) alloca_array (Extbyte, num) @@ -1272,7 +1273,7 @@ (a) it is Mule-correct (b) it does dynamic allocation so you never have to worry about size restrictions - (c) it comes in an alloca() variety (all allocation is stack-local, + (c) it comes in an ALLOCA() variety (all allocation is stack-local, so there is no need to explicitly clean up) as well as a malloc() variety (d) it knows its own length, so it does not suffer from standard null @@ -1316,7 +1317,7 @@ is declared as an Eistring *, and its storage declared on the stack. DECLARE_EISTRING_MALLOC (name); - Declare a new Eistring, which uses malloc()ed instead of alloca()ed + Declare a new Eistring, which uses malloc()ed instead of ALLOCA()ed data. This is a standard local variable declaration and can go anywhere in the variable declaration section. Once you initialize the Eistring, you will have to free it using eifree() to avoid @@ -1427,12 +1428,12 @@ void eicpyout_alloca (Eistring *eistr, LVALUE: Intbyte *ptr_out, LVALUE: Bytecount len_out); - Make an alloca() copy of the data in the Eistring, using the - default internal format. Due to the nature of alloca(), this + Make an ALLOCA() copy of the data in the Eistring, using the + default internal format. Due to the nature of ALLOCA(), this must be a macro, with all lvalues passed in as parameters. (More specifically, not all compilers correctly handle using - alloca() as the argument to a function call -- GCC on x86 - didn't used to, for example.) A pointer to the alloca()ed data + ALLOCA() as the argument to a function call -- GCC on x86 + didn't used to, for example.) A pointer to the ALLOCA()ed data is stored in PTR_OUT, and the length of the data (not including the terminating zero) is stored in LEN_OUT. @@ -1710,7 +1711,7 @@ /* Principles for writing Eistring functions: (1) Unfortunately, we have to write most of the Eistring functions - as macros, because of the use of alloca(). The principle used + as macros, because of the use of ALLOCA(). The principle used below to assure no conflict in local variables is to prefix all local variables with "ei" plus a number, which should be unique among macros. In practice, when finding a new number, find the @@ -1767,8 +1768,8 @@ temporary variable for all access to the Eistring. Essentially, we want it to appear as if these Eistring macros are functions -- we would like to declare them as functions but - they use alloca(), so we can't (and we can't make them inline - functions either -- alloca() is explicitly disallowed in inline + they use ALLOCA(), so we can't (and we can't make them inline + functions either -- ALLOCA() is explicitly disallowed in inline functions.) (7) Note that our rules regarding multiple evaluation are *more* @@ -1872,10 +1873,10 @@ (ei)->data_ = (Intbyte *) xrealloc ((ei)->data_, ei1newsize); \ else \ { \ - /* We don't have realloc, so alloca() more space and copy the \ + /* We don't have realloc, so ALLOCA() more space and copy the \ data into it. */ \ Intbyte *ei1oldeidata = (ei)->data_; \ - (ei)->data_ = (Intbyte *) alloca (ei1newsize); \ + (ei)->data_ = (Intbyte *) ALLOCA (ei1newsize); \ if (ei1oldeidata) \ memcpy ((ei)->data_, ei1oldeidata, ei1oldeibytelen + 1); \ } \ @@ -2091,7 +2092,7 @@ \ (ei)->max_size_allocated_ = \ eifind_large_enough_buffer (0, (ei)->bytelen_ + 1); \ - ei13newdata = (Intbyte *) alloca ((ei)->max_size_allocated_); \ + ei13newdata = (Intbyte *) ALLOCA ((ei)->max_size_allocated_); \ memcpy (ei13newdata, (ei)->data_, (ei)->bytelen_ + 1); \ xfree ((ei)->data_); \ (ei)->data_ = ei13newdata; \ @@ -2099,7 +2100,7 @@ \ if ((ei)->extdata_) \ { \ - Extbyte *ei13newdata = (Extbyte *) alloca ((ei)->extlen_ + 2); \ + Extbyte *ei13newdata = (Extbyte *) ALLOCA ((ei)->extlen_ + 2); \ \ memcpy (ei13newdata, (ei)->extdata_, (ei)->extlen_); \ /* Double null-terminate in case of Unicode data */ \ @@ -2422,8 +2423,8 @@ #define EI_CASECHANGE(ei, downp) \ do { \ int ei11new_allocmax = (ei)->charlen_ * MAX_EMCHAR_LEN + 1; \ - Intbyte *ei11storage = (Intbyte *) alloca_array (Intbyte, \ - ei11new_allocmax); \ + Intbyte *ei11storage = \ + (Intbyte *) alloca_array (Intbyte, ei11new_allocmax); \ int ei11newlen = eistr_casefiddle_1 ((ei)->data_, (ei)->bytelen_, \ ei11storage, downp); \ \ @@ -2466,7 +2467,7 @@ The source or sink can be specified in one of these ways: DATA, (ptr, len), // input data is a fixed buffer of size len - ALLOCA, (ptr, len), // output data is in a alloca()ed buffer of size len + ALLOCA, (ptr, len), // output data is in a ALLOCA()ed buffer of size len MALLOC, (ptr, len), // output data is in a malloc()ed buffer of size len C_STRING_ALLOCA, ptr, // equivalent to ALLOCA (ptr, len_ignored) on output C_STRING_MALLOC, ptr, // equivalent to MALLOC (ptr, len_ignored) on output @@ -2726,7 +2727,7 @@ /* + 2 because we double zero-extended to account for Unicode conversion */ typedef union { char c; void *p; } *dfc_aliasing_voidpp; #define DFC_ALLOCA_USE_CONVERTED_DATA(sink) do { \ - void * dfc_sink_ret = alloca (dfc_sink.data.len + 2); \ + void * dfc_sink_ret = ALLOCA (dfc_sink.data.len + 2); \ memcpy (dfc_sink_ret, dfc_sink.data.ptr, dfc_sink.data.len + 2); \ ((dfc_aliasing_voidpp) &(DFC_CPP_CAR sink))->p = dfc_sink_ret; \ (DFC_CPP_CDR sink) = dfc_sink.data.len; \ @@ -2738,7 +2739,7 @@ (DFC_CPP_CDR sink) = dfc_sink.data.len; \ } while (0) #define DFC_C_STRING_ALLOCA_USE_CONVERTED_DATA(sink) do { \ - void * dfc_sink_ret = alloca (dfc_sink.data.len + 2); \ + void * dfc_sink_ret = ALLOCA (dfc_sink.data.len + 2); \ memcpy (dfc_sink_ret, dfc_sink.data.ptr, dfc_sink.data.len + 2); \ ((dfc_aliasing_voidpp) &(sink))->p = dfc_sink_ret; \ } while (0) @@ -2803,7 +2804,7 @@ \ if (!__gserr__) \ { \ - var = alloca_intbytes (99); \ + var = alloca_intbytes (99); \ qxesprintf (var, "Unknown error %d", __gsnum__); \ } \ else \
--- a/src/ui-byhand.c Tue May 21 23:47:40 2002 +0000 +++ b/src/ui-byhand.c Thu May 23 11:46:46 2002 +0000 @@ -348,7 +348,7 @@ wtaerror ("Object is not a GtkCurve", curve); } - vector = (gfloat *) alloca (sizeof (gfloat) * XINT (length)); + vector = (gfloat *) ALLOCA (sizeof (gfloat) * XINT (length)); gtk_curve_get_vector (GTK_CURVE (XGTK_OBJECT (curve)->object), XINT (length), vector); lisp_vector = make_vector (XINT (length), Qnil); @@ -380,7 +380,7 @@ wtaerror ("Object is not a GtkCurve", curve); } - c_vector = (gfloat *) alloca (sizeof (gfloat) * vec_length); + c_vector = (gfloat *) ALLOCA (sizeof (gfloat) * vec_length); for (i = 0; i < vec_length; i++) {