Mercurial > hg > xemacs-beta
annotate src/gccache-x.c @ 5882:bbe4146603db
Reduce regexp usage, now CL-oriented non-regexp code available, core Lisp
lisp/ChangeLog addition:
2015-04-01 Aidan Kehoe <kehoea@parhasard.net>
When calling #'string-match with a REGEXP without regular
expression special characters, call #'search, #'mismatch, #'find,
etc. instead, making our code less likely to side-effect other
functions' match data and a little faster.
* apropos.el (apropos-command):
* apropos.el (apropos):
Call (position ?\n ...) rather than (string-match "\n" ...) here.
* buff-menu.el:
* buff-menu.el (buffers-menu-omit-invisible-buffers):
Don't fire up the regexp engine just to check if a string starts
with a space.
* buff-menu.el (select-buffers-tab-buffers-by-mode):
Don't fire up the regexp engine just to compare mode basenames.
* buff-menu.el (format-buffers-tab-line):
* buff-menu.el (build-buffers-tab-internal): Moved to being a
label within the following.
* buff-menu.el (buffers-tab-items): Use the label.
* bytecomp.el (byte-compile-log-1):
Don't fire up the regexp engine just to look for a newline.
* cus-edit.el (get):
Ditto.
* cus-edit.el (custom-variable-value-create):
Ditto, but for a colon.
* descr-text.el (describe-text-sexp):
Ditto.
* descr-text.el (describe-char-unicode-data):
Use #'split-string-by-char given that we're just looking for a
semicolon.
* descr-text.el (describe-char):
Don't fire up the regexp engine just to look for a newline.
* disass.el (disassemble-internal):
Ditto.
* files.el (file-name-sans-extension):
Implement this using #'position.
* files.el (file-name-extension):
Correct this function's docstring, implement it in terms of
#'position.
* files.el (insert-directory):
Don't fire up the regexp engine to split a string by space; don't
reverse the list of switches, this is actually a longstand bug as
far as I can see.
* gnuserv.el (gnuserv-process-filter):
Use #'position here, instead of consing inside #'split-string
needlessly.
* gtk-file-dialog.el (gtk-file-dialog-update-dropdown):
Use #'split-string-by-char here, don't fire up #'split-string for
directory-sep-char.
* gtk-font-menu.el (hack-font-truename):
Implement this more cheaply in terms of #'find,
#'split-string-by-char, #'equal, rather than #'string-match,
#'split-string, #'string-equal.
* hyper-apropos.el (hyper-apropos-grok-functions):
* hyper-apropos.el (hyper-apropos-grok-variables):
Look for a newline using #'position rather than #'string-match in
these functions.
* info.el (Info-insert-dir):
* info.el (Info-insert-file-contents):
* info.el (Info-follow-reference):
* info.el (Info-extract-menu-node-name):
* info.el (Info-menu):
Look for fixed strings using #'position or #'search as appropriate
in this file.
* ldap.el (ldap-decode-string):
* ldap.el (ldap-encode-string):
#'encode-coding-string, #'decode-coding-string are always
available, don't check if they're fboundp.
* ldap.el (ldap-decode-address):
* ldap.el (ldap-encode-address):
Use #'split-string-by-char in these functions.
* lisp-mnt.el (lm-creation-date):
* lisp-mnt.el (lm-last-modified-date):
Don't fire up the regexp engine just to look for spaces in this file.
* menubar-items.el (default-menubar):
Use (not (mismatch ...)) rather than #'string-match here, for
simple regexp.
Use (search "beta" ...) rather than (string-match "beta" ...)
* menubar-items.el (sort-buffers-menu-alphabetically):
* menubar-items.el (sort-buffers-menu-by-mode-then-alphabetically):
* menubar-items.el (group-buffers-menu-by-mode-then-alphabetically):
Don't fire up the regexp engine to check if a string starts with
a space or an asterisk.
Use the more fine-grained results of #'compare-strings; compare
case-insensitively for the buffer menu.
* menubar-items.el (list-all-buffers):
* menubar-items.el (tutorials-menu-filter):
Use #'equal rather than #'string-equal, which, in this context,
has the drawback of not having a bytecode, and no redeeming
features.
* minibuf.el:
* minibuf.el (un-substitute-in-file-name):
Use #'count, rather than counting the occurences of $ using the
regexp engine.
* minibuf.el (read-file-name-internal-1):
Don't fire up the regexp engine to search for ?=.
* mouse.el (mouse-eval-sexp):
Check for newline with #'find.
* msw-font-menu.el (mswindows-reset-device-font-menus):
Split a string by newline with #'split-string-by-char.
* mule/japanese.el:
* mule/japanese.el ("Japanese"):
Use #'search rather than #'string-match; canoncase before
comparing; fix a bug I had introduced where I had been making case
insensitive comparisons where the case mattered.
* mule/korea-util.el (default-korean-keyboard):
Look for ?3 using #'find, not #'string-march.
* mule/korea-util.el (quail-hangul-switch-hanja):
Search for a fixed string using #'search.
* mule/mule-cmds.el (set-locale-for-language-environment):
#'position, #'substitute rather than #'string-match,
#'replace-in-string.
* newcomment.el (comment-make-extra-lines):
Use #'search rather than #'string-match for a simple string.
* package-get.el (package-get-remote-filename):
Use #'position when looking for ?@
* process.el (setenv):
* process.el (read-envvar-name):
Use #'position when looking for ?=.
* replace.el (map-query-replace-regexp):
Use #'split-string-by-char instead of using an inline
implementation of it.
* select.el (select-convert-from-cf-text):
* select.el (select-convert-from-cf-unicodetext):
Use #'position rather than #'string-match in these functions.
* setup-paths.el (paths-emacs-data-root-p):
Use #'search when looking for simple string.
* sound.el (load-sound-file):
Use #'split-string-by-char rather than an inline reimplementation
of same.
* startup.el (splash-screen-window-body):
* startup.el (splash-screen-tty-body):
Search for simple strings using #'search.
* version.el (emacs-version):
Ditto.
* x-font-menu.el (hack-font-truename):
Implement this more cheaply in terms of #'find,
#'split-string-by-char, #'equal, rather than #'string-match,
#'split-string, #'string-equal.
* x-font-menu.el (x-reset-device-font-menus-core):
Use #'split-string-by-char here.
* x-init.el (x-initialize-keyboard):
Search for a simple string using #'search.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Wed, 01 Apr 2015 14:28:20 +0100 |
parents | 308d34e9f07d |
children |
rev | line source |
---|---|
2587 | 1 /* Efficient caching of X GCs (graphics contexts). |
2 Copyright (C) 1993 Free Software Foundation, Inc. | |
3 Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. | |
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
4 Copyright (C) 2010 Ben Wing. |
2587 | 5 |
6 This file is part of XEmacs. | |
7 | |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5050
diff
changeset
|
8 XEmacs is free software: you can redistribute it and/or modify it |
2587 | 9 under the terms of the GNU General Public License as published by the |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5050
diff
changeset
|
10 Free Software Foundation, either version 3 of the License, or (at your |
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5050
diff
changeset
|
11 option) any later version. |
2587 | 12 |
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
16 for more details. | |
17 | |
18 You should have received a copy of the GNU General Public License | |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5050
diff
changeset
|
19 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
2587 | 20 |
21 /* Synched up with: Not in FSF. */ | |
22 | |
23 /* Emacs uses a lot of different display attributes; for example, assume | |
24 that only four fonts are in use (normal, bold, italic, and bold-italic). | |
25 Then assume that one stipple or background is used for text selections, | |
26 and another is used for highlighting mousable regions. That makes 16 | |
27 GCs already. Add in the fact that another GC may be needed to display | |
28 the text cursor in any of those regions, and you've got 32. Add in | |
29 more fonts, and it keeps increasing exponentially. | |
30 | |
31 We used to keep these GCs in a cache of merged (fully qualified) faces. | |
32 However, a lot of other code in xterm.c used XChangeGC of existing GCs, | |
33 which is kind of slow and kind of random. Also, managing the face cache | |
34 was tricky because it was hard to know when a face was no longer visible | |
35 on the frame -- we had to mark all frames as garbaged whenever a face | |
36 was changed, which caused an unpleasant amount of flicker (since faces are | |
37 created/destroyed (= changed) whenever a frame is created/destroyed. | |
38 | |
39 So this code maintains a cache at the GC level instead of at the face | |
40 level. There is an upper limit on the size of the cache, after which we | |
41 will stop creating GCs and start reusing them (reusing the least-recently- | |
42 used ones first). So if faces get changed, their GCs will eventually be | |
43 recycled. Also more sharing of GCs is possible. | |
44 | |
45 This code uses hash tables. It could be that, if the cache size is small | |
46 enough, a linear search might be faster; but I doubt it, since we need | |
47 `equal' comparisons, not `eq', and I expect that the optimal cache size | |
48 will be ~100. | |
49 | |
50 Written by jwz, 14 jun 93 | |
51 */ | |
52 | |
53 #include <config.h> | |
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
3243
diff
changeset
|
54 #include "lisp.h" |
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
3243
diff
changeset
|
55 #include "hash.h" |
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
3243
diff
changeset
|
56 |
4917 | 57 #include "gccache-x.h" |
2587 | 58 |
59 #define GC_CACHE_SIZE 100 | |
60 | |
61 #define GCCACHE_HASH | |
62 | |
63 struct gcv_and_mask { | |
64 XGCValues gcv; | |
65 unsigned long mask; | |
66 }; | |
67 | |
68 struct gc_cache_cell { | |
69 GC gc; | |
70 struct gcv_and_mask gcvm; | |
71 struct gc_cache_cell *prev, *next; | |
72 }; | |
73 | |
74 struct gc_cache { | |
75 Display *dpy; /* used only as arg to XCreateGC/XFreeGC */ | |
76 Window window; /* used only as arg to XCreateGC */ | |
77 int size; | |
78 struct gc_cache_cell *head; | |
79 struct gc_cache_cell *tail; | |
80 #ifdef GCCACHE_HASH | |
81 struct hash_table *table; | |
82 #endif | |
83 | |
84 int create_count; | |
85 int delete_count; | |
86 }; | |
87 | |
88 #ifdef GCCACHE_HASH | |
89 static Hashcode | |
90 gc_cache_hash (const void *arg) | |
91 { | |
92 const struct gcv_and_mask *gcvm = (const struct gcv_and_mask *) arg; | |
93 unsigned long *longs = (unsigned long *) &gcvm->gcv; | |
94 Hashcode hash = gcvm->mask; | |
95 int i; | |
96 /* This could look at the mask and only use the used slots in the | |
97 hash code. That would win in that we wouldn't have to initialize | |
98 every slot of the gcv when calling gc_cache_lookup. But we need | |
99 the hash function to be as fast as possible; some timings should | |
100 be done. */ | |
101 for (i = 0; i < (int) (sizeof (XGCValues) / sizeof (unsigned long)); i++) | |
102 hash = (hash << 1) ^ *longs++; | |
103 return hash; | |
104 } | |
105 | |
106 #endif /* GCCACHE_HASH */ | |
107 | |
108 static int | |
109 gc_cache_eql (const void *arg1, const void *arg2) | |
110 { | |
111 /* See comment in gc_cache_hash */ | |
112 return !memcmp (arg1, arg2, sizeof (struct gcv_and_mask)); | |
113 } | |
114 | |
115 struct gc_cache * | |
116 make_gc_cache (Display *dpy, Window window) | |
117 { | |
118 struct gc_cache *cache = xnew (struct gc_cache); | |
119 cache->dpy = dpy; | |
120 cache->window = window; | |
121 cache->size = 0; | |
122 cache->head = cache->tail = 0; | |
123 cache->create_count = cache->delete_count = 0; | |
124 #ifdef GCCACHE_HASH | |
125 cache->table = | |
126 make_general_hash_table (GC_CACHE_SIZE, gc_cache_hash, gc_cache_eql); | |
127 #endif | |
128 return cache; | |
129 } | |
130 | |
131 void | |
132 free_gc_cache (struct gc_cache *cache) | |
133 { | |
134 struct gc_cache_cell *rest, *next; | |
135 rest = cache->head; | |
136 while (rest) | |
137 { | |
138 XFreeGC (cache->dpy, rest->gc); | |
139 next = rest->next; | |
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4917
diff
changeset
|
140 xfree (rest); |
2587 | 141 rest = next; |
142 } | |
143 #ifdef GCCACHE_HASH | |
144 free_hash_table (cache->table); | |
145 #endif | |
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4917
diff
changeset
|
146 xfree (cache); |
2587 | 147 } |
148 | |
149 GC | |
150 gc_cache_lookup (struct gc_cache *cache, XGCValues *gcv, unsigned long mask) | |
151 { | |
152 struct gc_cache_cell *cell, *next, *prev; | |
153 struct gcv_and_mask gcvm; | |
154 | |
3094 | 155 #ifdef DEBUG_XEMACS |
156 (void) describe_gc_cache (cache, DGCCFLAG_DISABLE); | |
157 #endif | |
158 | |
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
159 assert ((!!cache->head) == (!!cache->tail)); |
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
160 assert (!(cache->head && (cache->head->prev || cache->tail->next))); |
2587 | 161 |
162 gcvm.mask = mask; | |
163 gcvm.gcv = *gcv; /* this copies... */ | |
164 | |
165 #ifdef GCCACHE_HASH | |
166 | |
167 /* The intermediate cast fools gcc into not outputting strict-aliasing | |
168 complaints */ | |
169 if (gethash (&gcvm, cache->table, (const void **) (void *) &cell)) | |
170 | |
171 #else /* !GCCACHE_HASH */ | |
172 | |
173 cell = cache->tail; /* start at the end (most recently used) */ | |
174 while (cell) | |
175 { | |
176 if (gc_cache_eql (&gcvm, &cell->gcvm)) | |
177 break; | |
178 else | |
179 cell = cell->prev; | |
180 } | |
181 | |
182 /* #### This whole file needs some serious overhauling. */ | |
183 if (!(mask | GCTile) && cell->gc->values.tile) | |
184 cell = 0; | |
185 else if (!(mask | GCStipple) && cell->gc->values.stipple) | |
186 cell = 0; | |
187 | |
188 if (cell) | |
189 | |
190 #endif /* !GCCACHE_HASH */ | |
191 | |
192 { | |
193 /* Found a cell. Move this cell to the end of the list, so that it | |
194 will be less likely to be collected than a cell that was accessed | |
195 less recently. | |
196 */ | |
3094 | 197 #if 0 |
198 debug_out ("Returning cached GC: %08lx\n", XE_GCONTEXT(cell)); | |
199 #endif | |
2587 | 200 if (cell == cache->tail) |
201 return cell->gc; | |
202 | |
203 next = cell->next; | |
204 prev = cell->prev; | |
205 if (prev) prev->next = next; | |
206 if (next) next->prev = prev; | |
207 if (cache->head == cell) cache->head = next; | |
208 cell->next = 0; | |
209 cell->prev = cache->tail; | |
210 cache->tail->next = cell; | |
211 cache->tail = cell; | |
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
212 assert (cache->head != cell); |
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
213 assert (!cell->next); |
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
214 assert (!cache->head->prev); |
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
215 assert (!cache->tail->next); |
2587 | 216 return cell->gc; |
217 } | |
218 | |
219 /* else, cache miss. */ | |
220 | |
221 if (cache->size == GC_CACHE_SIZE) | |
222 /* Reuse the first cell on the list (least-recently-used). | |
223 Remove it from the list, and unhash it from the table. | |
224 */ | |
225 { | |
226 cell = cache->head; | |
227 cache->head = cell->next; | |
228 cache->head->prev = 0; | |
229 if (cache->tail == cell) cache->tail = 0; /* only one */ | |
3243 | 230 #if 0 |
3094 | 231 debug_out ("Cache full, freeing GC: %08lx\n ", XE_GCONTEXT(cell)); |
3243 | 232 #endif |
2587 | 233 XFreeGC (cache->dpy, cell->gc); |
234 cache->delete_count++; | |
235 #ifdef GCCACHE_HASH | |
236 remhash (&cell->gcvm, cache->table); | |
237 #endif | |
238 } | |
239 else if (cache->size > GC_CACHE_SIZE) | |
240 ABORT (); | |
241 else | |
242 { | |
243 /* Allocate a new cell (don't put it in the list or table yet). */ | |
244 cell = xnew (struct gc_cache_cell); | |
245 cache->size++; | |
246 } | |
247 | |
248 /* Now we've got a cell (new or reused). Fill it in. */ | |
249 memcpy (&cell->gcvm.gcv, gcv, sizeof (XGCValues)); | |
250 cell->gcvm.mask = mask; | |
251 | |
252 /* Put the cell on the end of the list. */ | |
253 cell->next = 0; | |
254 cell->prev = cache->tail; | |
255 if (cache->tail) cache->tail->next = cell; | |
256 cache->tail = cell; | |
257 if (! cache->head) cache->head = cell; | |
258 | |
259 cache->create_count++; | |
260 #ifdef GCCACHE_HASH | |
261 /* Hash it in the table */ | |
262 puthash (&cell->gcvm, cell, cache->table); | |
263 #endif | |
264 | |
265 /* Now make and return the GC. */ | |
266 cell->gc = XCreateGC (cache->dpy, cache->window, mask, gcv); | |
267 | |
268 /* debug */ | |
269 assert (cell->gc == gc_cache_lookup (cache, gcv, mask)); | |
270 | |
3094 | 271 #if 0 |
272 debug_out ("Returning new GC: %08lx\n ", XE_GCONTEXT(cell)); | |
273 #endif | |
2587 | 274 return cell->gc; |
275 } | |
276 | |
277 | |
278 #ifdef DEBUG_XEMACS | |
279 | |
3094 | 280 /* FLAGS |
281 The flags argument is a bitwise or of any of the following: | |
282 | |
283 DGCCFLAG_SUMMARY Summary statistics for cache | |
284 DGCCFLAG_LIST_CELLS If summary is being printed, print cell IDs too. | |
285 DGCCFLAG_CELL_DETAILS If cell IDs are being printed, additionally | |
286 print the internal fields used and values. | |
287 | |
288 DGCCFLAG_DEFAULT A predefined combination giving whatever the | |
289 maintainers are currently interested in seeing. | |
290 */ | |
2587 | 291 void |
3094 | 292 describe_gc_cache (struct gc_cache *cache, int flags) |
2587 | 293 { |
294 int count = 0; | |
295 struct gc_cache_cell *cell = cache->head; | |
3094 | 296 |
297 if (! flags & DGCCFLAG_SUMMARY) return; | |
298 | |
2587 | 299 stderr_out ("\nsize: %d", cache->size); |
300 stderr_out ("\ncreated: %d", cache->create_count); | |
301 stderr_out ("\ndeleted: %d", cache->delete_count); | |
302 | |
3094 | 303 if (flags & DGCCFLAG_LIST_CELLS) |
304 while (cell) | |
305 { | |
306 struct gc_cache_cell *cell2; | |
307 int i = 0; | |
308 stderr_out ("\n%d:\t0x%lx GC: 0x%08lx hash: 0x%08lx\n", | |
309 count, (long) cell, (long) XE_GCONTEXT(cell), | |
310 gc_cache_hash (&cell->gcvm)); | |
311 | |
312 for (cell2 = cache->head; cell2; cell2 = cell2->next, i++) | |
313 if (count != i && | |
314 gc_cache_hash (&cell->gcvm) == gc_cache_hash (&cell2->gcvm)) | |
315 stderr_out ("\tHASH COLLISION with cell %d\n", i); | |
316 stderr_out ("\tmask: %8lx\n", cell->gcvm.mask); | |
317 | |
318 if (flags & DGCCFLAG_CELL_DETAILS) | |
319 { | |
2587 | 320 #define FROB(field) do { \ |
321 if ((int)cell->gcvm.gcv.field != (~0)) \ | |
322 stderr_out ("\t%-12s%8x\n", #field ":", (int)cell->gcvm.gcv.field); \ | |
323 } while (0) | |
3094 | 324 FROB (function); |
325 FROB (plane_mask); | |
326 FROB (foreground); | |
327 FROB (background); | |
328 FROB (line_width); | |
329 FROB (line_style); | |
330 FROB (cap_style); | |
331 FROB (join_style); | |
332 FROB (fill_style); | |
333 FROB (fill_rule); | |
334 FROB (arc_mode); | |
335 FROB (tile); | |
336 FROB (stipple); | |
337 FROB (ts_x_origin); | |
338 FROB (ts_y_origin); | |
339 FROB (font); | |
340 FROB (subwindow_mode); | |
341 FROB (graphics_exposures); | |
342 FROB (clip_x_origin); | |
343 FROB (clip_y_origin); | |
344 FROB (clip_mask); | |
345 FROB (dash_offset); | |
2587 | 346 #undef FROB |
3094 | 347 } |
2587 | 348 |
3094 | 349 count++; |
350 if (cell->next && cell == cache->tail) | |
351 stderr_out ("\nERROR! tail is here!\n\n"); | |
352 else if (!cell->next && cell != cache->tail) | |
353 stderr_out ("\nERROR! tail is not at the end\n\n"); | |
354 cell = cell->next; | |
355 } /* while (cell) */ | |
356 | |
2587 | 357 if (count != cache->size) |
358 stderr_out ("\nERROR! count should be %d\n\n", cache->size); | |
359 } | |
360 | |
361 #endif /* DEBUG_XEMACS */ |