April 2018 - XEmacs-commits - XEmacs Mailing List Archives

commit/cc-mode: acm: Purge obsolete file and tidy up Makefile. 6 years, 8 months

Bitbucket

1 new commit in cc-mode: https://bitbucket.org/xemacs/cc-mode/commits/72d6f4557fdb/ Changeset: 72d6f4557fdb User: acm Date: 2018-04-07 15:59:42+00:00 Summary: Purge obsolete file and tidy up Makefile. * cc-fix.el: Remove * cc-defs.el: Remove page which tested for various former conditions which used to need cc-fix to fix them. * Makefile: Remove the reference to cc-fix.el. Affected #: 3 files diff -r f0b818bdcd90 -r 72d6f4557fdb Makefile --- a/Makefile +++ b/Makefile ＠＠ -26,7 +26,7 ＠＠ CATEGORY = standard ELCS = cc-align.elc cc-awk.elc cc-bytecomp.elc cc-cmds.elc \ - cc-defs.elc cc-engine.elc cc-fix.elc cc-fonts.elc cc-guess.elc \ + cc-defs.elc cc-engine.elc cc-fonts.elc cc-guess.elc \ cc-langs.elc cc-menus.elc cc-mode.elc cc-styles.elc \ cc-subword.elc cc-vars.elc diff -r f0b818bdcd90 -r 72d6f4557fdb cc-defs.el --- a/cc-defs.el +++ b/cc-defs.el ＠＠ -69,25 +69,6 ＠＠ (cc-bytecomp-defun string-to-syntax) ; Emacs 21 -;; cc-fix.el contains compatibility macros that should be used if -;; needed. -(cc-conditional-require - 'cc-fix (or (/= (regexp-opt-depth "\$\\(\$\\)") 2) - (not (fboundp 'push)) - ;; XEmacs 21.4 doesn't have `delete-dups'. - (not (fboundp 'delete-dups)))) - -(cc-conditional-require-after-load - 'cc-fix "font-lock" - (and - (featurep 'xemacs) - (progn - (require 'font-lock) - (let (font-lock-keywords) - (font-lock-compile-keywords '("a\\`")) ; doesn't match anything. - font-lock-keywords)))) - - ;;; Variables also used at compile time. (defconst c-version "5.33" diff -r f0b818bdcd90 -r 72d6f4557fdb cc-fix.el --- a/cc-fix.el +++ /dev/null ＠＠ -1,159 +0,0 ＠＠ -;;; cc-fix.el --- compatibility library for old (X)Emacs versions - -;; Copyright (C) 1985,1987,1992-2003, 2004, 2005, 2006, 2007, 2008, -;; 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc. - -;; Authors: 2003- Alan Mackenzie -;; 1998- Martin Stjernholm -;; 1997-1999 Barry A. Warsaw -;; Maintainer: bug-cc-mode(a)gnu.org -;; Created: 03-Jul-1997 (as cc-mode-19.el) -;; Version: See cc-mode.el -;; Keywords: c languages oop - -;; This file is not part of GNU Emacs. - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program; see the file COPYING. If not, see -;; <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; This file is necessary in order to run CC Mode in older (X)Emacs -;; versions. It's not needed at all for the latest versions of Emacs -;; and XEmacs. - -;;; Code: - -(eval-when-compile - (let ((load-path - (if (and (boundp 'byte-compile-dest-file) - (stringp byte-compile-dest-file)) - (cons (file-name-directory byte-compile-dest-file) load-path) - load-path))) - (load "cc-bytecomp" nil t))) - -;; Silence the compiler (in case this file is compiled by other -;; Emacsen even though it isn't used by them). -(cc-bytecomp-obsolete-fun byte-code-function-p) -(cc-bytecomp-defun regexp-opt-depth) - -(cc-external-require 'advice) - -;; Emacs 20.n doesn't have the macros push and pop. Here're the Emacs 21 -;; definitions. -(or (fboundp 'push) - (defmacro push (newelt listname) - "Add NEWELT to the list stored in the symbol LISTNAME. -This is equivalent to (setq LISTNAME (cons NEWELT LISTNAME)). -LISTNAME must be a symbol." - (list 'setq listname - (list 'cons newelt listname)))) - -(or (fboundp 'pop) - (defmacro pop (listname) - "Return the first element of LISTNAME's value, and remove it from the list. -LISTNAME must be a symbol whose value is a list. -If the value is nil, `pop' returns nil but does not actually -change the list." - (list 'prog1 (list 'car listname) - (list 'setq listname (list 'cdr listname))))) - - -(if (/= (regexp-opt-depth "\$\\(\$\\)") 2) - (progn - ;; Emacs 21.1 has a buggy regexp-opt-depth which prevents CC - ;; Mode building. Those in Emacs 21.[23] are not entirely - ;; accurate. The following definition comes from Emacs's - ;; regexp-opt.el CVS version 1.25 and is believed to be a - ;; rigorously correct implementation. - (defconst regexp-opt-not-groupie*-re - (let* ((harmless-ch "[^\\\\[]") - (esc-pair-not-lp "\\\\[^(]") - (class-harmless-ch "[^][]") - (class-lb-harmless "[^]:]") - (class-lb-colon-maybe-charclass ":\$[a-z]+:]\$?") - (class-lb (concat "\\[\$" class-lb-harmless - "\\|" class-lb-colon-maybe-charclass "\$")) - (class - (concat "\\[^?]?" - "\$" class-harmless-ch - "\\|" class-lb "\$*" - "\\[?]")) ; special handling for bare [ at end of re - (shy-lp "\\\$\\?:")) - (concat "\\(" harmless-ch "\\|" esc-pair-not-lp - "\\|" class "\\|" shy-lp "\$*")) - "Matches any part of a regular expression EXCEPT for non-shy \"\\\\(\"s") - - (defun regexp-opt-depth (regexp) - "Return the depth of REGEXP. -This means the number of regexp grouping constructs (parenthesised expressions) -in REGEXP." - (save-match-data - ;; Hack to signal an error if REGEXP does not have balanced - ;; parentheses. - (string-match regexp "") - ;; Count the number of open parentheses in REGEXP. - (let ((count 0) start) - (while - (progn - (string-match regexp-opt-not-groupie*-re regexp start) - (setq start ( + (match-end 0) 2)) ; +2 for "\\(" after match-end. - (<= start (length regexp))) - (setq count (1+ count))) - count))) - )) - -;; Some XEmacs versions have a bug in which font-lock-compile-keywords -;; overwrites the variable font-lock-keywords with its result. This causes -;; havoc when what the function is compiling is font-lock-SYNTACTIC-keywords, -;; hence.... -(eval-after-load "font-lock" - '(when (and (featurep 'xemacs) ; There is now (2005/12) code in GNU Emacs CVS - ; to make the call to f-l-c-k throw an error. - (let (font-lock-keywords) - (font-lock-compile-keywords '("a\\`")) ; Doesn't match anything. - font-lock-keywords)) ; did the previous call foul this up? - (defun font-lock-compile-keywords (keywords) - "Compile KEYWORDS (a list) and return the list of compiled keywords. -Each keyword has the form (MATCHER HIGHLIGHT ...). See `font-lock-keywords'." - (if (eq (car-safe keywords) t) - keywords - (cons t (mapcar 'font-lock-compile-keyword keywords)))) - (defadvice font-lock-fontify-keywords-region (before c-compile-font-lock-keywords - activate preactivate) - (unless (eq (car-safe font-lock-keywords) t) - (setq font-lock-keywords - (font-lock-compile-keywords font-lock-keywords)))) - )) - -;; XEmacs 21.4 doesn't have `delete-dups'. -(if (not (fboundp 'delete-dups)) - (defun delete-dups (list) - "Destructively remove `equal' duplicates from LIST. -Store the result in LIST and return it. LIST must be a proper list. -Of several `equal' occurrences of an element in LIST, the first -one is kept." - (let ((tail list)) - (while tail - (setcdr tail (delete (car tail) (cdr tail))) - (setq tail (cdr tail)))) - list)) - - -(cc-provide 'cc-fix) -;;; Local Variables: -;;; indent-tabs-mode: t -;;; tab-width: 8 -;;; End: -;;; cc-fix.el ends here Repository URL: https://bitbucket.org/xemacs/cc-mode/ -- This is a commit notification from bitbucket.org. You are receiving this because you have the service enabled, addressing the recipient of this email.

1 participants
0 comments

commit/XEmacs: kehoea: Avoid blowing the ARG_MAX limit on environment size, os-tests.el 6 years, 8 months

Bitbucket

1 new commit in XEmacs: https://bitbucket.org/xemacs/xemacs/commits/3e52d0a8ca3d/ Changeset: 3e52d0a8ca3d User: kehoea Date: 2018-04-06 13:14:46+00:00 Summary: Avoid blowing the ARG_MAX limit on environment size, os-tests.el src/ChangeLog addition: 2018-04-06 Aidan Kehoe <kehoea(a)parhasard.net> * process-unix.c: * process-unix.c (child_setup): When execve() fails, print the associated error message. tests/ChangeLog addition: 2018-04-06 Aidan Kehoe <kehoea(a)parhasard.net> * automated/os-tests.el (handle-call-process-cases): New. * automated/os-tests.el : Rework the call-process-region tests, making the Assert messages on failure more helpful, and not depending on #'executable-find. Be polite after the #'substitute-in-file-name tests, remove our unreasonably large values from the process environment. Affected #: 4 files diff -r eb122f8fba85 -r 3e52d0a8ca3d src/ChangeLog --- a/src/ChangeLog +++ b/src/ChangeLog ＠＠ -1,3 +1,9 ＠＠ +2018-04-06 Aidan Kehoe <kehoea(a)parhasard.net> + + * process-unix.c: + * process-unix.c (child_setup): + When execve() fails, print the associated error message. + 2018-01-04 Aidan Kehoe <kehoea(a)parhasard.net> Move the X GC cache to using the Lisp hash table structure (as diff -r eb122f8fba85 -r 3e52d0a8ca3d src/process-unix.c --- a/src/process-unix.c +++ b/src/process-unix.c ＠＠ -896,7 +896,7 ＠＠ Lisp_Object current_dir) { Ibyte **env; - Ibyte *pwd; + Ibyte *pwd, *errmess; #ifdef SET_EMACS_PRIORITY if (emacs_priority != 0) ＠＠ -1033,7 +1033,9 ＠＠ /* we've wrapped execve; it translates its arguments */ qxe_execve (new_argv[0], new_argv, env); - stdout_out ("Can't exec program %s\n", new_argv[0]); + GET_STRERROR (errmess, errno); + + stdout_out ("Can't exec program %s: %s\n", new_argv[0], errmess); _exit (1); } diff -r eb122f8fba85 -r 3e52d0a8ca3d tests/ChangeLog --- a/tests/ChangeLog +++ b/tests/ChangeLog ＠＠ -1,3 +1,12 ＠＠ +2018-04-06 Aidan Kehoe <kehoea(a)parhasard.net> + + * automated/os-tests.el (handle-call-process-cases): New. + * automated/os-tests.el : + Rework the call-process-region tests, making the Assert messages + on failure more helpful, and not depending on #'executable-find. + Be polite after the #'substitute-in-file-name tests, remove our + unreasonably large values from the process environment. + 2017-12-24 Aidan Kehoe <kehoea(a)parhasard.net> * automated/mule-tests.el: diff -r eb122f8fba85 -r 3e52d0a8ca3d tests/automated/os-tests.el --- a/tests/automated/os-tests.el +++ b/tests/automated/os-tests.el ＠＠ -34,60 +34,45 ＠＠ ;; in <b9yoeipvwn0.fsf(a)jpl.org>. ;; tac works by lines, unfortunately -;; #### The contortions around `executable-find' gag me, but I don't have time -;; to deal today. If we have `executable-find', we should use its value! -(let* ((original-string "a\nb\nc\nd\n") - ;; `executable-find' is in a package and may be unavailable. - (tac-cases (if (and (fboundp 'executable-find) (executable-find "tac")) - '((1 . "c\nb\na\nd\n") - (3 . "a\nc\nb\nd\n") - (5 . "a\nc\nb\nd\n") - (7 . "a\nc\nb\nd\n") - (9 . "a\nd\nc\nb\n")) - nil)) - (cat-cases (if (and (fboundp 'executable-find) (executable-find "cat")) - '((1 . "b\nc\na\nd\n") - (3 . "a\nb\nc\nd\n") - (5 . "a\nb\nc\nd\n") - (7 . "a\nb\nc\nd\n") - (9 . "a\nd\nb\nc\n")) - nil)) - cases case) - (with-temp-buffer - (Skip-Test-Unless tac-cases - "tac executable not found" - "Tests of call-process-region with region deleted after inserting +(macrolet + ((handle-call-process-cases (program &rest cases) + (cons + 'progn + (loop for (pos . result) in cases + nconc `((erase-buffer) + (insert "a\nb\nc\nd\n") + (goto-char ,pos) + (Assert (eql (call-process-region 3 7 ,program t t) 0) + ,(concat "failed calling " program)) + (goto-char (point-min)) + (Assert (equal (buffer-string) ,result) + ,(format "test call-process-region, %s, pos %d, " + program pos))))))) + (with-temp-buffer + (Skip-Test-Unless + (condition-case nil (call-process "tac") (process-error nil)) + "tac executable not found" + "Tests of call-process-region with region deleted after inserting tac process output." - (setq cases tac-cases) - (while cases - (setq case (car cases) - cases (cdr cases)) - (labels ((do-test (pos result) - (erase-buffer) - (insert original-string) - (goto-char pos) - (call-process-region 3 7 "tac" t t) - (goto-char (point-min)) - (Assert (looking-at result)))) - (do-test (car case) (cdr case))))) + (handle-call-process-cases "tac" + (1 . "c\nb\na\nd\n") + (3 . "a\nc\nb\nd\n") + (5 . "a\nc\nb\nd\n") + (7 . "a\nc\nb\nd\n") + (9 . "a\nd\nc\nb\n"))) ;; if you're in that much of a hurry you can blow cat off ;; if you've done tac, but I'm not going to bother - (Skip-Test-Unless cat-cases - "cat executable not found" - "Tests of call-process-region with region deleted after inserting + (Skip-Test-Unless + (condition-case nil (call-process "cat") (process-error nil)) + "cat executable not found" + "Tests of call-process-region with region deleted after inserting cat process output." - (setq cases cat-cases) - (while cases - (setq case (car cases) - cases (cdr cases)) - (labels ((do-test (pos result) - (erase-buffer) - (insert original-string) - (goto-char pos) - (call-process-region 3 7 "cat" t t) - (goto-char (point-min)) - (Assert (looking-at result)))) - (do-test (car case) (cdr case))))))) + (handle-call-process-cases "cat" + (1 . "b\nc\na\nd\n") + (3 . "a\nb\nc\nd\n") + (5 . "a\nb\nc\nd\n") + (7 . "a\nb\nc\nd\n") + (9 . "a\nd\nb\nc\n"))))) (loop with envvar-not-existing = (symbol-name (gensym "whatever")) ＠＠ -120,8 +105,10 ＠＠ (setenv envvar-existing envvar-existing-val)) for (pre post) in examples - do - (Assert (string= post (substitute-in-file-name pre)))) + do (Assert (string= post (substitute-in-file-name pre))) + ;; Be polite and don't overrun ARG_MAX for any processes called down + ;; the line. + finally (setenv envvar-existing nil t)) ;; Check some restrictions introduced to the ZONE argument to #'encode-time. Repository URL: https://bitbucket.org/xemacs/xemacs/ -- This is a commit notification from bitbucket.org. You are receiving this because you have the service enabled, addressing the recipient of this email.

1 participants
0 comments

commit/XEmacs: kehoea: Use Lisp hash table implementation, gccache-x.c 6 years, 8 months

Bitbucket

1 new commit in XEmacs: https://bitbucket.org/xemacs/xemacs/commits/eb122f8fba85/ Changeset: eb122f8fba85 User: kehoea Date: 2018-01-04 21:27:22+00:00 Summary: Use Lisp hash table implementation, gccache-x.c src/ChangeLog addition: 2018-01-04 Aidan Kehoe <kehoea(a)parhasard.net> Move the X GC cache to using the Lisp hash table structure (as part of a more general approach to remove hash.c). Improve its hashing algorithm, giving better performance. Incorporate it directly into the x_device struct, don't allocate it separately. * console-x-impl.h: * console-x-impl.h (struct x_device): Incorporate the x_gc_cache directly here, not a pointer to it. * console-x-impl.h (DEVICE_X_GC_CACHE): Update the macro to reflect this. * device-x.c: Provide a new gc-cache hash table test object. * device-x.c (x_data_device_description): Document that the GC cache hash table is reachable from the X device for the new GC. * device-x.c (x_init_device): Init the already-allocate X GC ccache. * device-x.c (x_mark_device): Mark the table. No need to mark the other fields of the GC cache struct. * device-x.c (x_delete_device): Free the GC cache on deletion. * device-x.c (syms_of_device_x): Init the hash table test object. * device-x.c (reinit_console_type_create_device_x): * elhash.c (vars_of_elhash): Can't make the assertion about the number of built-in hash table tests any more. * gccache-x.c: Rework this file to use the Lisp hash table infrastructure and a better hashing algorithm. * gccache-x.c (gc_cache_eql): Rework this to use the Lisp hash table calling conventtion. * gccache-x.c (gc_cache_hash): Ditto. * gccache-x.c (define_gc_cache_hash_table_test): New. Provide the gc-cache Lisp hash table test. * gccache-x.c (init_x_gc_cache): Replacement for make_gc_cache. * gccache-x.c (free_x_gc_cache_entries): Renamed; Nil out the hash table. * gccache-x.c (x_gc_cache_lookup): Rename to emphasise this is the X-specific cache. * gccache-x.c (describe_gc_cache): Adjust to reflect new structures. * gccache-x.h: Move the gc cache structure here, since it's now included in the X device structure. * gccache-x.h (GC_CACHE_SIZE): This is now here and remains 100. * redisplay-x.c (x_bevel_area): * redisplay-x.c (x_output_vertical_divider): * redisplay-x.c (x_flash): * redisplay-x.c (x_output_xlike_pixmap): Call x_gc_cache_lookup() in this file, rather than gc_cache_lookup(). * redisplay-xlike-inc.c (XLIKE_get_gc): Ditto. Affected #: 8 files diff -r d6fdd3ac1276 -r eb122f8fba85 src/ChangeLog --- a/src/ChangeLog +++ b/src/ChangeLog ＠＠ -1,3 +1,62 ＠＠ +2018-01-04 Aidan Kehoe <kehoea(a)parhasard.net> + + Move the X GC cache to using the Lisp hash table structure (as + part of a more general approach to remove hash.c). + Improve its hashing algorithm, giving better performance. + Incorporate it directly into the x_device struct, don't allocate + it separately. + * console-x-impl.h: + * console-x-impl.h (struct x_device): + Incorporate the x_gc_cache directly here, not a pointer to it. + * console-x-impl.h (DEVICE_X_GC_CACHE): + Update the macro to reflect this. + * device-x.c: + Provide a new gc-cache hash table test object. + * device-x.c (x_data_device_description): + Document that the GC cache hash table is reachable from the X + device for the new GC. + * device-x.c (x_init_device): + Init the already-allocate X GC ccache. + * device-x.c (x_mark_device): + Mark the table. No need to mark the other fields of the GC cache + struct. + * device-x.c (x_delete_device): + Free the GC cache on deletion. + * device-x.c (syms_of_device_x): + Init the hash table test object. + * device-x.c (reinit_console_type_create_device_x): + * elhash.c (vars_of_elhash): + Can't make the assertion about the number of built-in hash table + tests any more. + * gccache-x.c: + Rework this file to use the Lisp hash table infrastructure and a + better hashing algorithm. + * gccache-x.c (gc_cache_eql): Rework this to use the Lisp hash + table calling conventtion. + * gccache-x.c (gc_cache_hash): Ditto. + * gccache-x.c (define_gc_cache_hash_table_test): New. Provide the + gc-cache Lisp hash table test. + * gccache-x.c (init_x_gc_cache): + Replacement for make_gc_cache. + * gccache-x.c (free_x_gc_cache_entries): + Renamed; Nil out the hash table. + * gccache-x.c (x_gc_cache_lookup): + Rename to emphasise this is the X-specific cache. + * gccache-x.c (describe_gc_cache): + Adjust to reflect new structures. + * gccache-x.h: + Move the gc cache structure here, since it's now included in the X + device structure. + * gccache-x.h (GC_CACHE_SIZE): + This is now here and remains 100. + * redisplay-x.c (x_bevel_area): + * redisplay-x.c (x_output_vertical_divider): + * redisplay-x.c (x_flash): + * redisplay-x.c (x_output_xlike_pixmap): + Call x_gc_cache_lookup() in this file, rather than gc_cache_lookup(). + * redisplay-xlike-inc.c (XLIKE_get_gc): + Ditto. + 2017-12-30 Stephen J. Turnbull <stephen(a)xemacs.org> * glyphs.c (print_image_instance): Use %p for subwindow id. diff -r d6fdd3ac1276 -r eb122f8fba85 src/console-x-impl.h --- a/src/console-x-impl.h +++ b/src/console-x-impl.h ＠＠ -36,6 +36,7 ＠＠ #include "console-impl.h" #include "console-x.h" +#include "gccache-x.h" DECLARE_CONSOLE_TYPE (x); ＠＠ -55,9 +56,6 ＠＠ /* Xt application info. */ Widget Xt_app_shell; - /* Cache of GC's for frames on this device. */ - struct gc_cache *gc_cache; - /* Selected visual, depth and colormap for this device */ Visual *visual; int depth; ＠＠ -161,6 +159,9 ＠＠ KeyCode last_downkey; Time release_time; Time modifier_release_time; + + /* Cache of GCs for frames on this device. */ + struct x_gc_cache gc_cache; }; #ifdef NEW_GC ＠＠ -183,7 +184,7 ＠＠ #define DEVICE_X_DEPTH(d) (DEVICE_X_DATA (d)->depth) #define DEVICE_X_COLORMAP(d) (DEVICE_X_DATA (d)->device_cmap) #define DEVICE_XT_APP_SHELL(d) (DEVICE_X_DATA (d)->Xt_app_shell) -#define DEVICE_X_GC_CACHE(d) (DEVICE_X_DATA (d)->gc_cache) +#define DEVICE_X_GC_CACHE(d) (&(DEVICE_X_DATA (d)->gc_cache)) #define DEVICE_X_GRAY_PIXMAP(d) (DEVICE_X_DATA (d)->gray_pixmap) #define DEVICE_X_WM_COMMAND_FRAME(d) (DEVICE_X_DATA (d)->WM_COMMAND_frame) #define DEVICE_X_MOUSE_TIMESTAMP(d) (DEVICE_X_DATA (d)->mouse_timestamp) diff -r d6fdd3ac1276 -r eb122f8fba85 src/device-x.c --- a/src/device-x.c +++ b/src/device-x.c ＠＠ -73,6 +73,8 ＠＠ Lisp_Object Vx_initial_argv_list; /* #### ugh! */ +Lisp_Object Vgc_cache_hash_table_test; + /* Shut up G++ 4.3. */ #define Xrm_ODR(option,resource,type,default) \ { (String) option, (String) resource, type, default } ＠＠ -105,6 +107,9 ＠＠ static const struct memory_description x_device_data_description_1 [] = { { XD_LISP_OBJECT, offsetof (struct x_device, x_keysym_map_hash_table) }, { XD_LISP_OBJECT, offsetof (struct x_device, WM_COMMAND_frame) }, + { XD_LISP_OBJECT, offsetof (struct x_device, WM_COMMAND_frame) }, + { XD_LISP_OBJECT, offsetof (struct x_device, gc_cache) + + offsetof (struct x_gc_cache, table) }, { XD_END } }; ＠＠ -904,7 +909,8 ＠＠ init_baud_rate (d); init_one_device (d); - DEVICE_X_GC_CACHE (d) = make_gc_cache (dpy, XtWindow (app_shell)); + init_x_gc_cache (d); + DEVICE_X_GRAY_PIXMAP (d) = None; Xatoms_of_device_x (d); Xatoms_of_select_x (d); ＠＠ -923,6 +929,7 ＠＠ { mark_object (DEVICE_X_WM_COMMAND_FRAME (d)); mark_object (DEVICE_X_DATA (d)->x_keysym_map_hash_table); + mark_object (DEVICE_X_GC_CACHE (d)->table); } ＠＠ -959,7 +966,7 ＠＠ disable_strict_free_check (); #endif - free_gc_cache (DEVICE_X_GC_CACHE (d)); + free_x_gc_cache_entries (d); if (DEVICE_X_DATA (d)->x_modifier_keymap) XFreeModifiermap (DEVICE_X_DATA (d)->x_modifier_keymap); if (DEVICE_X_DATA (d)->x_keysym_map) ＠＠ -2079,6 +2086,9 ＠＠ #ifdef MULE DEFSYMBOL (Qget_coding_system_from_locale); #endif + + Vgc_cache_hash_table_test = define_gc_cache_hash_table_test (); + staticpro (&Vgc_cache_hash_table_test); } void diff -r d6fdd3ac1276 -r eb122f8fba85 src/elhash.c --- a/src/elhash.c +++ b/src/elhash.c ＠＠ -2960,7 +2960,6 ＠＠ assert (!NILP (Fassq (Qeql, weak_list_list))); assert (!NILP (Fassq (Qequal, weak_list_list))); assert (!NILP (Fassq (Qequalp, weak_list_list))); - assert (4 == XFIXNUM (Flength (weak_list_list))); Vhash_table_test_weak_list = make_weak_list (WEAK_LIST_KEY_ASSOC); XWEAK_LIST_LIST (Vhash_table_test_weak_list) = weak_list_list; diff -r d6fdd3ac1276 -r eb122f8fba85 src/gccache-x.c --- a/src/gccache-x.c +++ b/src/gccache-x.c ＠＠ -55,194 +55,258 ＠＠ #include "hash.h" #include "gccache-x.h" +#include "device-impl.h" +#include "console-x-impl.h" +#include "elhash.h" -#define GC_CACHE_SIZE 100 - -#define GCCACHE_HASH +static int +gc_cache_eql (const Hash_Table_Test * UNUSED (http), + Lisp_Object arg1, Lisp_Object arg2) +{ + return !memcmp (GET_VOID_FROM_LISP (arg1), GET_VOID_FROM_LISP (arg2), + sizeof (struct gcv_and_mask)); +} -struct gcv_and_mask { - XGCValues gcv; - unsigned long mask; -}; +static Hashcode +gc_cache_hash (const Hash_Table_Test * UNUSED (http), Lisp_Object arg) +{ + const struct gcv_and_mask *gcvm = GET_VOID_FROM_LISP (arg); + EMACS_UINT *longs = (EMACS_UINT *) &gcvm->gcv; + Hashcode hash = gcvm->mask; + unsigned i; -struct gc_cache_cell { - GC gc; - struct gcv_and_mask gcvm; - struct gc_cache_cell *prev, *next; -}; + /* Starting from the end of the XGCValues and moving to the beginning has + eliminated collisions on my machine as of 20170417, since the foreground + and background pixels are closest to the beginning, and they vary so much + more than the dash_offset, the dashes, the clip_x_origin and so on. -struct gc_cache { - Display *dpy; /* used only as arg to XCreateGC/XFreeGC */ - Window window; /* used only as arg to XCreateGC */ - int size; - struct gc_cache_cell *head; - struct gc_cache_cell *tail; -#ifdef GCCACHE_HASH - struct hash_table *table; + There was an old comment here, from revision zero, about possibly looking + at the mask and only hashing based on the used fields. That doesn't make + sense in today's world, where branches are relatively expensive. The + below (technically a use of Duff's device, but note the initial loop + counter is a compile-time constant, and so the usual criticisms don't + apply) translates into compile-time branchless inline code as of April + 2017 with -Ofast on GCC. I don't see any faster, or, really, smaller + alternative. Aidan Kehoe, 20170417. */ + switch ((i = (unsigned) (sizeof (gcvm->gcv) / SIZEOF_EMACS_INT)) + % SIZEOF_EMACS_INT) + { + do + { + case 0: + hash = (hash << 1) ^ longs[--i]; + /* FALLTHROUGH */ +#if SIZEOF_EMACS_INT > 16 +#error "unimplemented, look at the below code and copy it" #endif - - int create_count; - int delete_count; -}; +#if SIZEOF_EMACS_INT > 8 + case 15: + hash = (hash << 1) ^ longs[--i]; + /* FALLTHROUGH */ + case 14: + hash = (hash << 1) ^ longs[--i]; + /* FALLTHROUGH */ + case 13: + hash = (hash << 1) ^ longs[--i]; + /* FALLTHROUGH */ + case 12: + hash = (hash << 1) ^ longs[--i]; + /* FALLTHROUGH */ + case 11: + hash = (hash << 1) ^ longs[--i]; + /* FALLTHROUGH */ + case 10: + hash = (hash << 1) ^ longs[--i]; + /* FALLTHROUGH */ + case 9: + hash = (hash << 1) ^ longs[--i]; + /* FALLTHROUGH */ + case 8: + hash = (hash << 1) ^ longs[--i]; + /* FALLTHROUGH */ +#endif +#if SIZEOF_EMACS_INT > 4 + case 7: + hash = (hash << 1) ^ longs[--i]; + /* FALLTHROUGH */ + case 6: + hash = (hash << 1) ^ longs[--i]; + /* FALLTHROUGH */ + case 5: + hash = (hash << 1) ^ longs[--i]; + /* FALLTHROUGH */ + case 4: + hash = (hash << 1) ^ longs[--i]; + /* FALLTHROUGH */ +#endif + case 3: + hash = (hash << 1) ^ longs[--i]; + /* FALLTHROUGH */ + case 2: + hash = (hash << 1) ^ longs[--i]; + /* FALLTHROUGH */ + case 1: + hash = (hash << 1) ^ longs[--i]; + /* FALLTHROUGH */ + } while (i); + } -#ifdef GCCACHE_HASH -static Hashcode -gc_cache_hash (const void *arg) -{ - const struct gcv_and_mask *gcvm = (const struct gcv_and_mask *) arg; - unsigned long *longs = (unsigned long *) &gcvm->gcv; - Hashcode hash = gcvm->mask; - int i; - /* This could look at the mask and only use the used slots in the - hash code. That would win in that we wouldn't have to initialize - every slot of the gcv when calling gc_cache_lookup. But we need - the hash function to be as fast as possible; some timings should - be done. */ - for (i = 0; i < (int) (sizeof (XGCValues) / sizeof (unsigned long)); i++) - hash = (hash << 1) ^ *longs++; return hash; } -#endif /* GCCACHE_HASH */ - -static int -gc_cache_eql (const void *arg1, const void *arg2) +Lisp_Object +define_gc_cache_hash_table_test () { - /* See comment in gc_cache_hash */ - return !memcmp (arg1, arg2, sizeof (struct gcv_and_mask)); + return define_hash_table_test (Qunbound, gc_cache_eql, gc_cache_hash, + Qnil, Qnil); } -struct gc_cache * -make_gc_cache (Display *dpy, Window window) +void +init_x_gc_cache (struct device *d) { - struct gc_cache *cache = xnew (struct gc_cache); - cache->dpy = dpy; - cache->window = window; - cache->size = 0; - cache->head = cache->tail = 0; - cache->create_count = cache->delete_count = 0; -#ifdef GCCACHE_HASH - cache->table = - make_general_hash_table (GC_CACHE_SIZE, gc_cache_hash, gc_cache_eql); -#endif - return cache; + struct x_gc_cache *cache = DEVICE_X_GC_CACHE (d); + xzero (*cache); + cache->table = make_general_lisp_hash_table (Vgc_cache_hash_table_test, + GC_CACHE_SIZE, -1.0, -1.0, + /* Don't mark the keys and + values, don't process them + for GC. Note that this + object is marked in + x_mark_device(). */ + HASH_TABLE_WEAK); } void -free_gc_cache (struct gc_cache *cache) +free_x_gc_cache_entries (struct device *d) { - struct gc_cache_cell *rest, *next; - rest = cache->head; - while (rest) + struct x_gc_cache *cache = DEVICE_X_GC_CACHE (d); + Display *dpy = DEVICE_X_DISPLAY (d); + unsigned ii = 0; + + while (ii < cache->count) { - XFreeGC (cache->dpy, rest->gc); - next = rest->next; - xfree (rest); - rest = next; + XFreeGC (dpy, cache->cells[ii++].gc); } -#ifdef GCCACHE_HASH - free_hash_table (cache->table); -#endif - xfree (cache); + + cache->table = Qnil; /* Let the entries be GC'd, there's no value to freeing + them explicitly, they are just fixnums. */ } -GC -gc_cache_lookup (struct gc_cache *cache, XGCValues *gcv, unsigned long mask) -{ - struct gc_cache_cell *cell, *next, *prev; - struct gcv_and_mask gcvm; +/* The hotspots of this function are (in decreasing order of frequency of call): + + a) When the requested GCV and MASK reflect the most-recently-used GC. + b) When the requested GCV and MASK reflect a recently-used, but not *the* + most-recently-used GC. + c) When the requested GCV and MASK require that an old GC be evicted and a + new GC be created, since the cache is full. -#ifdef DEBUG_XEMACS - (void) describe_gc_cache (cache, DGCCFLAG_DISABLE); -#endif - - assert ((!!cache->head) == (!!cache->tail)); - assert (!(cache->head && (cache->head->prev || cache->tail->next))); + Case B) could be made faster by using a tick counter and not bothering to + adjust the LRU list for the most recent GC_CACHE_SIZE / 2 items. I don't + seee any evident possible wins for the other two cases. */ +GC +x_gc_cache_lookup (struct device *d, XGCValues *gcv, unsigned long mask) +{ + struct x_gc_cache *cache = DEVICE_X_GC_CACHE (d); + struct gc_cache_cell *cell = NULL; + struct gcv_and_mask gcvm; + htentry *e; + int next_index, prev_index; gcvm.mask = mask; gcvm.gcv = *gcv; /* this copies... */ -#ifdef GCCACHE_HASH - - /* The intermediate cast fools gcc into not outputting strict-aliasing - complaints */ - if (gethash (&gcvm, cache->table, (const void **) (void *) &cell)) - -#else /* !GCCACHE_HASH */ - - cell = cache->tail; /* start at the end (most recently used) */ - while (cell) + e = find_htentry (STORE_VOID_IN_LISP (&gcvm), XHASH_TABLE (cache->table)); + if (!HTENTRY_CLEAR_P (e)) { - if (gc_cache_eql (&gcvm, &cell->gcvm)) - break; - else - cell = cell->prev; - } + cell = GET_VOID_FROM_LISP (e->value); - /* #### This whole file needs some serious overhauling. */ - if (!(mask | GCTile) && cell->gc->values.tile) - cell = 0; - else if (!(mask | GCStipple) && cell->gc->values.stipple) - cell = 0; + /* Found a cell. */ +#ifdef DEBUG_GC_CACHE + stderr_out ("Returning %scached GC: %08lx\n", + cell == cache->tail ? "most recently used " : "", + XE_GCONTEXT(cell)); +#endif - if (cell) + if (cell == cache->tail) + return cell->gc; /* Case a) above. */ -#endif /* !GCCACHE_HASH */ - - { - /* Found a cell. Move this cell to the end of the list, so that it - will be less likely to be collected than a cell that was accessed - less recently. - */ -#if 0 - debug_out ("Returning cached GC: %08lx\n", XE_GCONTEXT(cell)); -#endif - if (cell == cache->tail) - return cell->gc; + /* Case b) above. */ + /* Move this cell to the end of the list, so that it will be less likely + to be collected than a cell that was accessed less recently. */ + next_index = cell->next_index; + prev_index = cell->prev_index; + if (prev_index != -1) + { + cache->cells[prev_index].next_index = next_index; + } + if (next_index != -1) + { + cache->cells[next_index].prev_index = prev_index; + } + if (cache->head == cell) + { + cache->head = &((cache->cells)[next_index]); + } - next = cell->next; - prev = cell->prev; - if (prev) prev->next = next; - if (next) next->prev = prev; - if (cache->head == cell) cache->head = next; - cell->next = 0; - cell->prev = cache->tail; - cache->tail->next = cell; + cell->next_index = -1; + if (cache->tail) + { + assert (cache->tail >= cache->cells); + assert ((cache->tail - cache->cells) < GC_CACHE_SIZE); + cell->prev_index = (cache->tail - cache->cells); + } + else + { + cell->prev_index = -1; + } + + assert ((cell - cache->cells) < GC_CACHE_SIZE); + + cache->tail->next_index = cell - cache->cells; cache->tail = cell; + assert (cache->head != cell); - assert (!cell->next); - assert (!cache->head->prev); - assert (!cache->tail->next); + assert (cache->head->prev_index == -1); + assert (cache->tail->next_index == -1); + return cell->gc; } + assert ((!!cache->head) == (!!cache->tail)); + assert (!(cache->head && (cache->head->prev_index != -1 + || cache->tail->next_index != -1))); + +#ifdef DEBUG_GC_CACHE + (void) describe_gc_cache (cache, + DGCCFLAG_SUMMARY | DGCCFLAG_LIST_CELLS); +#endif + /* else, cache miss. */ - if (cache->size == GC_CACHE_SIZE) + if (cache->count == GC_CACHE_SIZE) /* Reuse the first cell on the list (least-recently-used). - Remove it from the list, and unhash it from the table. - */ + Remove it from the list, and unhash it from the table. */ { cell = cache->head; - cache->head = cell->next; - cache->head->prev = 0; + cache->head = &((cache->cells)[cell->next_index]); + cache->head->prev_index = -1; if (cache->tail == cell) cache->tail = 0; /* only one */ -#if 0 - debug_out ("Cache full, freeing GC: %08lx\n ", XE_GCONTEXT(cell)); +#ifdef DEBUG_XEMACS +#ifdef DEBUG_GC_CACHE + stderr_out ("Cache full, freeing GC: %08lx\n ", XE_GCONTEXT(cell)); #endif - XFreeGC (cache->dpy, cell->gc); cache->delete_count++; -#ifdef GCCACHE_HASH - remhash (&cell->gcvm, cache->table); #endif + XFreeGC (DEVICE_X_DISPLAY (d), cell->gc); + + Fremhash (STORE_VOID_IN_LISP (&gcvm), cache->table); } - else if (cache->size > GC_CACHE_SIZE) - ABORT (); else { - /* Allocate a new cell (don't put it in the list or table yet). */ - cell = xnew (struct gc_cache_cell); - cache->size++; + assert (cache->count < GC_CACHE_SIZE); + + /* Reserve a new cell (don't put it in the list or table yet). */ + cell = &(cache->cells[cache->count++]); } /* Now we've got a cell (new or reused). Fill it in. */ ＠＠ -250,26 +314,32 ＠＠ cell->gcvm.mask = mask; /* Put the cell on the end of the list. */ - cell->next = 0; - cell->prev = cache->tail; - if (cache->tail) cache->tail->next = cell; + cell->next_index = -1; + cell->prev_index = cache->tail ? (cache->tail - cache->cells) : -1; + if (cache->tail) cache->tail->next_index = (cell - cache->cells); cache->tail = cell; - if (! cache->head) cache->head = cell; + if (! (cache->head)) cache->head = cell; +#ifdef DEBUG_XEMACS cache->create_count++; -#ifdef GCCACHE_HASH - /* Hash it in the table */ - puthash (&cell->gcvm, cell, cache->table); #endif + /* Hash it in the table. */ + Fputhash (STORE_VOID_IN_LISP (&cell->gcvm), STORE_VOID_IN_LISP (cell), + cache->table); + /* Now make and return the GC. */ - cell->gc = XCreateGC (cache->dpy, cache->window, mask, gcv); + cell->gc = XCreateGC (DEVICE_X_DISPLAY (d), + XtWindow (DEVICE_XT_APP_SHELL (d)), + mask, gcv); +#ifdef DEBUG_XEMACS /* debug */ - assert (cell->gc == gc_cache_lookup (cache, gcv, mask)); + assert (cell->gc == x_gc_cache_lookup (d, gcv, mask)); -#if 0 - debug_out ("Returning new GC: %08lx\n ", XE_GCONTEXT(cell)); +#ifdef DEBUG_GC_CACHE + stderr_out ("Returning new GC: %08lx\n ", XE_GCONTEXT (cell)); +#endif #endif return cell->gc; } ＠＠ -289,30 +359,33 ＠＠ maintainers are currently interested in seeing. */ void -describe_gc_cache (struct gc_cache *cache, int flags) +describe_gc_cache (struct x_gc_cache *cache, int flags) { - int count = 0; + unsigned count = 0; struct gc_cache_cell *cell = cache->head; if (!(flags & DGCCFLAG_SUMMARY)) return; - stderr_out ("\nsize: %d", cache->size); - stderr_out ("\ncreated: %d", cache->create_count); - stderr_out ("\ndeleted: %d", cache->delete_count); + stderr_out ("\nsize: %u", cache->count); + stderr_out ("\ncreated: %u", cache->create_count); + stderr_out ("\ndeleted: %u", cache->delete_count); if (flags & DGCCFLAG_LIST_CELLS) while (cell) { struct gc_cache_cell *cell2; - int i = 0; - stderr_out ("\n%d:\t0x%lx GC: 0x%08lx hash: 0x%08lx\n", - count, (long) cell, (long) XE_GCONTEXT(cell), - gc_cache_hash (&cell->gcvm)); + unsigned i = 0; + stderr_out ("\n%u:\t%p GC: 0x%08lx hash: 0x%08lx\n", + count, cell, XE_GCONTEXT (cell), + gc_cache_hash (NULL, STORE_VOID_IN_LISP (&cell->gcvm))); - for (cell2 = cache->head; cell2; cell2 = cell2->next, i++) + for (cell2 = cache->head; cell2; + (cell2 = ((cell2->next_index == -1) ? NULL : + &(cache->cells[cell2->next_index]))), i++) if (count != i && - gc_cache_hash (&cell->gcvm) == gc_cache_hash (&cell2->gcvm)) - stderr_out ("\tHASH COLLISION with cell %d\n", i); + gc_cache_hash (NULL, STORE_VOID_IN_LISP (&cell->gcvm)) + == gc_cache_hash (NULL, STORE_VOID_IN_LISP (&cell2->gcvm))) + stderr_out ("\tHASH COLLISION with cell %u\n", i); stderr_out ("\tmask: %8lx\n", cell->gcvm.mask); if (flags & DGCCFLAG_CELL_DETAILS) ＠＠ -347,15 +420,16 ＠＠ } count++; - if (cell->next && cell == cache->tail) + if (cell->next_index != -1 && cell == cache->tail) stderr_out ("\nERROR! tail is here!\n\n"); - else if (!cell->next && cell != cache->tail) + else if (cell->next_index == -1 && cell != cache->tail) stderr_out ("\nERROR! tail is not at the end\n\n"); - cell = cell->next; + cell = (cell->next_index == -1) ? NULL : + &(cache->cells[cell->next_index]); } /* while (cell) */ - if (count != cache->size) - stderr_out ("\nERROR! count should be %d\n\n", cache->size); + if (count != cache->count) + stderr_out ("\nERROR! count should be %u\n\n", cache->count); } #endif /* DEBUG_XEMACS */ diff -r d6fdd3ac1276 -r eb122f8fba85 src/gccache-x.h --- a/src/gccache-x.h +++ b/src/gccache-x.h ＠＠ -26,16 +26,51 ＠＠ #include <X11/Xlib.h> -struct gc_cache; -struct gc_cache *make_gc_cache (Display *, Window); -void free_gc_cache (struct gc_cache *cache); -GC gc_cache_lookup (struct gc_cache *, XGCValues *, unsigned long mask); +#define GC_CACHE_SIZE 100 + +struct gcv_and_mask { + XGCValues gcv; + unsigned long mask; +}; + +struct gc_cache_cell { + struct gcv_and_mask gcvm; + GC gc; + INT_16_BIT prev_index, next_index; +}; + +struct x_gc_cache { + /* This is marked in x_mark_device(). */ + Lisp_Object table; + + struct gc_cache_cell *head; + struct gc_cache_cell *tail; + + Display *dpy; + Window window; + + UINT_16_BIT count; + +#ifdef DEBUG_XEMACS + UINT_16_BIT create_count; + UINT_16_BIT delete_count; +#endif + + struct gc_cache_cell cells[GC_CACHE_SIZE]; +}; + +void init_x_gc_cache (struct device *); +void free_x_gc_cache_entries (struct device *); +GC x_gc_cache_lookup (struct device *, XGCValues *, unsigned long mask); #define XE_GCONTEXT(cell) (XGContextFromGC(cell->gc)) +extern Lisp_Object Vgc_cache_hash_table_test; +extern Lisp_Object define_gc_cache_hash_table_test (void); + #ifdef DEBUG_XEMACS -void describe_gc_cache (struct gc_cache *cache, int flags); +void describe_gc_cache (struct x_gc_cache *, int flags); #define DGCCFLAG_DISABLE 0 #define DGCCFLAG_SUMMARY 1 << 0 ＠＠ -43,6 +78,7 ＠＠ #define DGCCFLAG_CELL_DETAILS 1 << 2 /* A combination of the flags above. */ #define DGCCFLAG_DEFAULT DGCCFLAG_SUMMARY | DGCCFLAG_LIST_CELLS -#endif + +#endif /* DEBUG_XEMACS */ #endif /* INCLUDED_gccache_x_h_ */ diff -r d6fdd3ac1276 -r eb122f8fba85 src/redisplay-x.c --- a/src/redisplay-x.c +++ b/src/redisplay-x.c ＠＠ -654,8 +654,8 ＠＠ /* this is needed because the GC draws with a pixmap here */ gcv.fill_style = FillOpaqueStippled; gcv.stipple = DEVICE_X_GRAY_PIXMAP (d); - top_shadow_gc = gc_cache_lookup (DEVICE_X_GC_CACHE (d), &gcv, - (mask | GCStipple | GCFillStyle)); + top_shadow_gc = x_gc_cache_lookup (d, &gcv, + (mask | GCStipple | GCFillStyle)); tmp_pixel = WINDOW_FACE_CACHEL_FOREGROUND (w, findex); tmp_color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (tmp_pixel)); ＠＠ -667,11 +667,11 ＠＠ else { gcv.foreground = top_shadow_pixel; - top_shadow_gc = gc_cache_lookup (DEVICE_X_GC_CACHE (d), &gcv, mask); + top_shadow_gc = x_gc_cache_lookup (d, &gcv, mask); } gcv.foreground = bottom_shadow_pixel; - bottom_shadow_gc = gc_cache_lookup (DEVICE_X_GC_CACHE (d), &gcv, mask); + bottom_shadow_gc = x_gc_cache_lookup (d, &gcv, mask); if (use_pixmap && flip_gcs) { ＠＠ -681,7 +681,7 ＠＠ } gcv.foreground = background_pixel; - background_gc = gc_cache_lookup (DEVICE_X_GC_CACHE (d), &gcv, mask); + background_gc = x_gc_cache_lookup (d, &gcv, mask); /* possibly revert the GC's This will give a depressed look to the divider */ ＠＠ -958,7 +958,7 ＠＠ gcv.graphics_exposures = False; mask = XLIKE_GC_FOREGROUND | XLIKE_GC_BACKGROUND | XLIKE_GC_EXPOSURES; - background_gc = gc_cache_lookup (DEVICE_XLIKE_GC_CACHE (d), &gcv, mask); + background_gc = x_gc_cache_lookup (d, &gcv, mask); /* Clear the divider area first. This needs to be done when a window split occurs. */ ＠＠ -1046,7 +1046,7 ＠＠ XLIKE_SET_GC_PIXEL (gcv.foreground, tmp_fcolor ^ tmp_bcolor); gcv.function = XLIKE_GX_XOR; gcv.graphics_exposures = False; - gc = gc_cache_lookup (DEVICE_XLIKE_GC_CACHE (XDEVICE (f->device)), &gcv, + gc = x_gc_cache_lookup (XDEVICE (f->device), &gcv, XLIKE_GC_FOREGROUND | XLIKE_GC_FUNCTION | XLIKE_GC_EXPOSURES); default_face_width_and_height (frame, 0, &flash_height); ＠＠ -1322,7 +1322,7 ＠＠ */ } - gc = gc_cache_lookup (DEVICE_XLIKE_GC_CACHE (d), &gcv, pixmap_mask); + gc = x_gc_cache_lookup (d, &gcv, pixmap_mask); /* depth of 0 means it's a bitmap, not a pixmap, and we should use XCopyPlane (1 = current foreground color, 0 = background) instead diff -r d6fdd3ac1276 -r eb122f8fba85 src/redisplay-xlike-inc.c --- a/src/redisplay-xlike-inc.c +++ b/src/redisplay-xlike-inc.c ＠＠ -552,7 +552,7 ＠＠ #if 0 debug_out ("\nx_get_gc: calling gc_cache_lookup\n"); #endif - return gc_cache_lookup (DEVICE_XLIKE_GC_CACHE (d), &gcv, mask); + return x_gc_cache_lookup (d, &gcv, mask); } #endif Repository URL: https://bitbucket.org/xemacs/xemacs/ -- This is a commit notification from bitbucket.org. You are receiving this because you have the service enabled, addressing the recipient of this email.

1 participants
0 comments

commit/cc-mode: acm: Optimize c-syntactic-skip-backward, c-determine-limit for large comment blocks 6 years, 8 months

Bitbucket

1 new commit in cc-mode: https://bitbucket.org/xemacs/cc-mode/commits/be69314add85/ Changeset: be69314add85 User: acm Date: 2018-04-02 11:07:48+00:00 Summary: Optimize c-syntactic-skip-backward, c-determine-limit for large comment blocks * cc-engine.el (c-ssb-lit-begin): Remove. (c-syntactic-skip-backward): Remove the surrounding c-self-bind-state-cache. Use the standard function c-literal-start in place of the special purpose c-ssb-lit-begin. With a suitable skip-chars argument (the usual case), optimize by invoking c-backward-syntactic-ws to move back over comment blocks. (c-determine-limit-get-base): Inovke an early c-backward-syntactic-ws. (c-determine-limit): Use c-forward-comment whilst moving forward. Cope with an empty position stack whilst looking for non-literals (bug fix). In the recursive call, double try-size to prevent Lisp stack overflow. Affected #: 1 file diff -r 948df39cfb8a -r be69314add85 cc-engine.el --- a/cc-engine.el +++ b/cc-engine.el ＠＠ -4742,57 +4742,6 ＠＠ nil))) -(cc-bytecomp-defvar safe-pos-list) -(defsubst c-ssb-lit-begin () - ;; Return the start of the literal point is in, or nil. - ;; We read and write the variables `safe-pos', `safe-pos-list', `state' - ;; bound in the caller. - - ;; Use `parse-partial-sexp' from a safe position down to the point to check - ;; if it's outside comments and strings. - (save-excursion - (let ((pos (point)) safe-pos state) - ;; Pick a safe position as close to the point as possible. - ;; - ;; FIXME: Consult `syntax-ppss' here if our cache doesn't give a good - ;; position. - - (while (and safe-pos-list - (> (car safe-pos-list) (point))) - (setq safe-pos-list (cdr safe-pos-list))) - (unless (setq safe-pos (car-safe safe-pos-list)) - (setq safe-pos (max (or (c-safe-position - (point) (c-parse-state)) - 0) - (point-min)) - safe-pos-list (list safe-pos))) - - ;; Cache positions along the way to use if we have to back up more. We - ;; cache every closing paren on the same level. If the paren cache is - ;; relevant in this region then we're typically already on the same - ;; level as the target position. Note that we might cache positions - ;; after opening parens in case safe-pos is in a nested list. That's - ;; both uncommon and harmless. - (while (progn - (setq state (parse-partial-sexp - safe-pos pos 0)) - (< (point) pos)) - (setq safe-pos (point) - safe-pos-list (cons safe-pos safe-pos-list))) - - ;; If the state contains the start of the containing sexp we cache that - ;; position too, so that parse-partial-sexp in the next run has a bigger - ;; chance of starting at the same level as the target position and thus - ;; will get more good safe positions into the list. - (if (elt state 1) - (setq safe-pos (1+ (elt state 1)) - safe-pos-list (cons safe-pos safe-pos-list))) - - (if (or (elt state 3) (elt state 4)) - ;; Inside string or comment. Continue search at the - ;; beginning of it. - (elt state 8))))) - (defun c-syntactic-skip-backward (skip-chars &optional limit paren-level) "Like `skip-chars-backward' but only look at syntactically relevant chars, i.e. don't stop at positions inside syntactic whitespace or string ＠＠ -4809,108 +4758,110 ＠＠ Note that this function might do hidden buffer changes. See the comment at the start of cc-engine.el for more info." - - (c-self-bind-state-cache - (let ((start (point)) - ;; A list of syntactically relevant positions in descending - ;; order. It's used to avoid scanning repeatedly over - ;; potentially large regions with `parse-partial-sexp' to verify - ;; each position. Used in `c-ssb-lit-begin' - safe-pos-list + (let* ((start (point)) ;; The result from `c-beginning-of-macro' at the start position or the - ;; start position itself if it isn't within a macro. Evaluated on - ;; demand. - start-macro-beg + ;; start position itself if it isn't within a macro. + (start-macro-beg + (save-excursion + (goto-char start) + (c-beginning-of-macro limit) + (point))) + lit-beg ;; The earliest position after the current one with the same paren ;; level. Used only when `paren-level' is set. - lit-beg - (paren-level-pos (point))) - - (while - (progn - ;; The next loop "tries" to find the end point each time round, - ;; loops when it hasn't succeeded. - (while - (and - (let ((pos (point))) - (while (and - (< (skip-chars-backward skip-chars limit) 0) - ;; Don't stop inside a literal. - (when (setq lit-beg (c-ssb-lit-begin)) + (paren-level-pos (point)) + ;; Whether we can optimize with an early `c-backward-syntactic-ws'. + (opt-ws (string-match "^\\^[^ \t\n\r]+$" skip-chars))) + + ;; In the next while form, we only loop when `skip-chars' is something + ;; like "^/" and we've stopped at the end of a block comment. + (while + (progn + ;; The next loop "tries" to find the end point each time round, + ;; loops when it's ended up at the wrong level of nesting. + (while + (and + ;; Optimize for, in particular, large blocks of comments from + ;; `comment-region'. + (progn (when opt-ws + (c-backward-syntactic-ws) + (setq paren-level-pos (point))) + t) + ;; Move back to a candidate end point which isn't in a literal + ;; or in a macro we didn't start in. + (let ((pos (point)) + macro-start) + (while (and + (< (skip-chars-backward skip-chars limit) 0) + (or + (when (setq lit-beg (c-literal-start)) (goto-char lit-beg) - t))) - (< (point) pos)) - - (let ((pos (point)) state-2 pps-end-pos) - - (cond - ((and paren-level - (save-excursion - (setq state-2 (parse-partial-sexp - pos paren-level-pos -1) - pps-end-pos (point)) - (/= (car state-2) 0))) - ;; Not at the right level. - - (if (and (< (car state-2) 0) - ;; We stop above if we go out of a paren. - ;; Now check whether it precedes or is - ;; nested in the starting sexp. - (save-excursion - (setq state-2 - (parse-partial-sexp - pps-end-pos paren-level-pos - nil nil state-2)) - (< (car state-2) 0))) - - ;; We've stopped short of the starting position - ;; so the hit was inside a nested list. Go up - ;; until we are at the right level. - (condition-case nil - (progn - (goto-char (scan-lists pos -1 - (- (car state-2)))) - (setq paren-level-pos (point)) - (if (and limit (>= limit paren-level-pos)) - (progn - (goto-char limit) - nil) - t)) - (error - (goto-char (or limit (point-min))) - nil)) - - ;; The hit was outside the list at the start - ;; position. Go to the start of the list and exit. - (goto-char (1+ (elt state-2 1))) - nil)) - - ((c-beginning-of-macro limit) - ;; Inside a macro. - (if (< (point) - (or start-macro-beg - (setq start-macro-beg - (save-excursion - (goto-char start) - (c-beginning-of-macro limit) - (point))))) - t - - ;; It's inside the same macro we started in so it's - ;; a relevant match. - (goto-char pos) - nil)))))) - - (> (point) - (progn - ;; Skip syntactic ws afterwards so that we don't stop at the - ;; end of a comment if `skip-chars' is something like "^/". - (c-backward-syntactic-ws) - (point))))) - - ;; We might want to extend this with more useful return values in - ;; the future. - (/= (point) start)))) + t) + ;; Don't stop inside a macro we didn't start in. + (when + (save-excursion + (and (c-beginning-of-macro limit) + (< (point) start-macro-beg) + (setq macro-start (point)))) + (goto-char macro-start)))) + (when opt-ws + (c-backward-syntactic-ws))) + (< (point) pos)) + + ;; Check whether we're at the wrong level of nesting (when + ;; `paren-level' is non-nil). + (let ((pos (point)) state-2 pps-end-pos) + (when + (and paren-level + (save-excursion + (setq state-2 (parse-partial-sexp + pos paren-level-pos -1) + pps-end-pos (point)) + (/= (car state-2) 0))) + ;; Not at the right level. + (if (and (< (car state-2) 0) + ;; We stop above if we go out of a paren. + ;; Now check whether it precedes or is + ;; nested in the starting sexp. + (save-excursion + (setq state-2 + (parse-partial-sexp + pps-end-pos paren-level-pos + nil nil state-2)) + (< (car state-2) 0))) + + ;; We've stopped short of the starting position + ;; so the hit was inside a nested list. Go up + ;; until we are at the right level. + (condition-case nil + (progn + (goto-char (scan-lists pos -1 + (- (car state-2)))) + (setq paren-level-pos (point)) + (if (and limit (>= limit paren-level-pos)) + (progn + (goto-char limit) + nil) + t)) + (error + (goto-char (or limit (point-min))) + nil)) + + ;; The hit was outside the list at the start + ;; position. Go to the start of the list and exit. + (goto-char (1+ (elt state-2 1))) + nil))))) + + (> (point) + (progn + ;; Skip syntactic ws afterwards so that we don't stop at the + ;; end of a comment if `skip-chars' is something like "^/". + (c-backward-syntactic-ws) + (point))))) + + ;; We might want to extend this with more useful return values in + ;; the future. + (/= (point) start))) ;; The following is an alternative implementation of ;; `c-syntactic-skip-backward' that uses backward movement to keep ＠＠ -5196,6 +5147,9 ＠＠ (defsubst c-determine-limit-get-base (start try-size) ;; Get a "safe place" approximately TRY-SIZE characters before START. ;; This defsubst doesn't preserve point. + (goto-char start) + (c-backward-syntactic-ws) + (setq start (point)) (let* ((pos (max (- start try-size) (point-min))) (s (c-state-semi-pp-to-literal pos)) (cand (or (car (cddr s)) pos))) ＠＠ -5205,9 +5159,9 ＠＠ (point)))) (defun c-determine-limit (how-far-back &optional start try-size) - ;; Return a buffer position HOW-FAR-BACK non-literal characters from - ;; START (default point). The starting position, either point or - ;; START may not be in a comment or string. + ;; Return a buffer position approximately HOW-FAR-BACK non-literal + ;; characters from START (default point). The starting position, either + ;; point or START may not be in a comment or string. ;; ;; The position found will not be before POINT-MIN and won't be in a ;; literal. ＠＠ -5225,6 +5179,12 ＠＠ (s (parse-partial-sexp pos pos)) ; null state. stack elt size (count 0)) + ;; Optimization for large blocks of comments, particularly those being + ;; created by `comment-region'. + (goto-char pos) + (forward-comment try-size) + (setq pos (point)) + (while (< pos start) ;; Move forward one literal each time round this loop. ;; Move forward to the start of a comment or string. ＠＠ -5267,6 +5227,10 ＠＠ ;; Have we found enough yet? (cond + ((null elt) ; No non-literal characters found. + (if (> base (point-min)) + (c-determine-limit how-far-back base (* 2 try-size)) + (point-min))) ((>= count how-far-back) (+ (car elt) (- count how-far-back))) ((eq base (point-min)) ＠＠ -5274,7 +5238,7 ＠＠ ((> base (- start try-size)) ; Can only happen if we hit point-min. (car elt)) (t - (c-determine-limit (- how-far-back count) base try-size)))))) + (c-determine-limit (- how-far-back count) base (* 2 try-size))))))) (defun c-determine-+ve-limit (how-far &optional start-pos) ;; Return a buffer position about HOW-FAR non-literal characters forward Repository URL: https://bitbucket.org/xemacs/cc-mode/ -- This is a commit notification from bitbucket.org. You are receiving this because you have the service enabled, addressing the recipient of this email.

1 participants
0 comments

2024

2023

2022

2021

2020

2019

2018

2017

XEmacs-commits April 2018