Mercurial > hg > xemacs-beta
annotate src/rangetab.c @ 5139:a48ef26d87ee
Clean up prototypes for Lisp variables/symbols. Put decls for them with
the other stuff related to the file they're in. In the process, fix a few
places with incorrect initialization of symbols and variables.
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-03-12 Ben Wing <ben@xemacs.org>
* lisp.h:
* lisp.h (redo-symbols): Removed.
Put the Lisp variables and symbols where they belong, with other
stuff related to the file they're in.
* event-Xt.c (THIS_IS_X):
* event-Xt.c (syms_of_event_Xt):
* event-Xt.c (reinit_vars_of_event_Xt):
* event-gtk.c:
* event-gtk.c (syms_of_event_gtk):
* event-gtk.c (reinit_vars_of_event_gtk):
* event-stream.c:
* event-stream.c (syms_of_event_stream):
* event-stream.c (reinit_vars_of_event_stream):
* events.c (reinit_vars_of_events):
* events.c (vars_of_events):
`sans-modifiers' was defsymbol'ed more than once. Move it to
events-stream.c. `self-insert-command' was defsymbol'ed more than once.
Vevent_resource should be staticpro_nodump()ed as it's declared in
a reinit_*() method.
* lread.c (vars_of_lread):
Vfile_domain wasn't staticpro'ed.
* minibuf.c:
* minibuf.c (reinit_complex_vars_of_minibuf):
Vminibuffer_zero and Vecho_area_buffer weren't staticpro'ed.
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Fri, 12 Mar 2010 20:23:50 -0600 |
parents | 0d4c9d0f6a8d |
children | b5df3737028a |
rev | line source |
---|---|
428 | 1 /* XEmacs routines to deal with range tables. |
2 Copyright (C) 1995 Sun Microsystems, Inc. | |
4831
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
3 Copyright (C) 1995, 2002, 2004, 2005, 2010 Ben Wing. |
428 | 4 |
5 This file is part of XEmacs. | |
6 | |
7 XEmacs is free software; you can redistribute it and/or modify it | |
8 under the terms of the GNU General Public License as published by the | |
9 Free Software Foundation; either version 2, or (at your option) any | |
10 later version. | |
11 | |
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
15 for more details. | |
16 | |
17 You should have received a copy of the GNU General Public License | |
18 along with XEmacs; see the file COPYING. If not, write to | |
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
20 Boston, MA 02111-1307, USA. */ | |
21 | |
22 /* Synched up with: Not in FSF. */ | |
23 | |
24 /* Written by Ben Wing, August 1995. */ | |
25 | |
26 #include <config.h> | |
27 #include "lisp.h" | |
28 #include "rangetab.h" | |
29 | |
30 Lisp_Object Qrange_tablep; | |
31 Lisp_Object Qrange_table; | |
32 | |
2421 | 33 Lisp_Object Qstart_closed_end_open; |
34 Lisp_Object Qstart_open_end_open; | |
35 Lisp_Object Qstart_closed_end_closed; | |
36 Lisp_Object Qstart_open_end_closed; | |
37 | |
428 | 38 |
39 /************************************************************************/ | |
40 /* Range table object */ | |
41 /************************************************************************/ | |
42 | |
2421 | 43 static enum range_table_type |
44 range_table_symbol_to_type (Lisp_Object symbol) | |
45 { | |
46 if (NILP (symbol)) | |
47 return RANGE_START_CLOSED_END_OPEN; | |
48 | |
49 CHECK_SYMBOL (symbol); | |
50 if (EQ (symbol, Qstart_closed_end_open)) | |
51 return RANGE_START_CLOSED_END_OPEN; | |
52 if (EQ (symbol, Qstart_closed_end_closed)) | |
53 return RANGE_START_CLOSED_END_CLOSED; | |
54 if (EQ (symbol, Qstart_open_end_open)) | |
55 return RANGE_START_OPEN_END_OPEN; | |
56 if (EQ (symbol, Qstart_open_end_closed)) | |
57 return RANGE_START_OPEN_END_CLOSED; | |
58 | |
59 invalid_constant ("Unknown range table type", symbol); | |
60 RETURN_NOT_REACHED (RANGE_START_CLOSED_END_OPEN); | |
61 } | |
62 | |
63 static Lisp_Object | |
64 range_table_type_to_symbol (enum range_table_type type) | |
65 { | |
66 switch (type) | |
67 { | |
68 case RANGE_START_CLOSED_END_OPEN: | |
69 return Qstart_closed_end_open; | |
70 case RANGE_START_CLOSED_END_CLOSED: | |
71 return Qstart_closed_end_closed; | |
72 case RANGE_START_OPEN_END_OPEN: | |
73 return Qstart_open_end_open; | |
74 case RANGE_START_OPEN_END_CLOSED: | |
75 return Qstart_open_end_closed; | |
76 } | |
77 | |
2500 | 78 ABORT (); |
2421 | 79 return Qnil; |
80 } | |
81 | |
428 | 82 /* We use a sorted array of ranges. |
83 | |
84 #### We should be using the gap array stuff from extents.c. This | |
85 is not hard but just requires moving that stuff out of that file. */ | |
86 | |
87 static Lisp_Object | |
88 mark_range_table (Lisp_Object obj) | |
89 { | |
440 | 90 Lisp_Range_Table *rt = XRANGE_TABLE (obj); |
428 | 91 int i; |
92 | |
93 for (i = 0; i < Dynarr_length (rt->entries); i++) | |
94 mark_object (Dynarr_at (rt->entries, i).val); | |
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4391
diff
changeset
|
95 |
428 | 96 return Qnil; |
97 } | |
98 | |
99 static void | |
2286 | 100 print_range_table (Lisp_Object obj, Lisp_Object printcharfun, |
101 int UNUSED (escapeflag)) | |
428 | 102 { |
440 | 103 Lisp_Range_Table *rt = XRANGE_TABLE (obj); |
428 | 104 int i; |
105 | |
2421 | 106 if (print_readably) |
107 write_fmt_string_lisp (printcharfun, "#s(range-table type %s data (", | |
108 1, range_table_type_to_symbol (rt->type)); | |
109 else | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4831
diff
changeset
|
110 write_ascstring (printcharfun, "#<range-table "); |
428 | 111 for (i = 0; i < Dynarr_length (rt->entries); i++) |
112 { | |
113 struct range_table_entry *rte = Dynarr_atp (rt->entries, i); | |
2421 | 114 int so, ec; |
428 | 115 if (i > 0) |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4831
diff
changeset
|
116 write_ascstring (printcharfun, " "); |
2421 | 117 switch (rt->type) |
118 { | |
119 case RANGE_START_CLOSED_END_OPEN: so = 0, ec = 0; break; | |
120 case RANGE_START_CLOSED_END_CLOSED: so = 0, ec = 1; break; | |
121 case RANGE_START_OPEN_END_OPEN: so = 1, ec = 0; break; | |
122 case RANGE_START_OPEN_END_CLOSED: so = 1; ec = 1; break; | |
2500 | 123 default: ABORT (); so = 0, ec = 0; break; |
2421 | 124 } |
125 write_fmt_string (printcharfun, "%c%ld %ld%c ", | |
126 print_readably ? '(' : so ? '(' : '[', | |
127 (long) (rte->first - so), | |
128 (long) (rte->last - ec), | |
129 print_readably ? ')' : ec ? ']' : ')' | |
130 ); | |
428 | 131 print_internal (rte->val, printcharfun, 1); |
132 } | |
2421 | 133 if (print_readably) |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4831
diff
changeset
|
134 write_ascstring (printcharfun, "))"); |
2421 | 135 else |
136 write_fmt_string (printcharfun, " 0x%x>", rt->header.uid); | |
428 | 137 } |
138 | |
139 static int | |
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4831
diff
changeset
|
140 range_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, int foldcase) |
428 | 141 { |
440 | 142 Lisp_Range_Table *rt1 = XRANGE_TABLE (obj1); |
143 Lisp_Range_Table *rt2 = XRANGE_TABLE (obj2); | |
428 | 144 int i; |
145 | |
146 if (Dynarr_length (rt1->entries) != Dynarr_length (rt2->entries)) | |
147 return 0; | |
148 | |
149 for (i = 0; i < Dynarr_length (rt1->entries); i++) | |
150 { | |
151 struct range_table_entry *rte1 = Dynarr_atp (rt1->entries, i); | |
152 struct range_table_entry *rte2 = Dynarr_atp (rt2->entries, i); | |
153 | |
154 if (rte1->first != rte2->first | |
155 || rte1->last != rte2->last | |
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4831
diff
changeset
|
156 || !internal_equal_0 (rte1->val, rte2->val, depth + 1, foldcase)) |
428 | 157 return 0; |
158 } | |
159 | |
160 return 1; | |
161 } | |
162 | |
2515 | 163 static Hashcode |
428 | 164 range_table_entry_hash (struct range_table_entry *rte, int depth) |
165 { | |
166 return HASH3 (rte->first, rte->last, internal_hash (rte->val, depth + 1)); | |
167 } | |
168 | |
2515 | 169 static Hashcode |
428 | 170 range_table_hash (Lisp_Object obj, int depth) |
171 { | |
440 | 172 Lisp_Range_Table *rt = XRANGE_TABLE (obj); |
428 | 173 int i; |
174 int size = Dynarr_length (rt->entries); | |
2515 | 175 Hashcode hash = size; |
428 | 176 |
177 /* approach based on internal_array_hash(). */ | |
178 if (size <= 5) | |
179 { | |
180 for (i = 0; i < size; i++) | |
181 hash = HASH2 (hash, | |
182 range_table_entry_hash (Dynarr_atp (rt->entries, i), | |
183 depth)); | |
184 return hash; | |
185 } | |
186 | |
187 /* just pick five elements scattered throughout the array. | |
188 A slightly better approach would be to offset by some | |
189 noise factor from the points chosen below. */ | |
190 for (i = 0; i < 5; i++) | |
191 hash = HASH2 (hash, range_table_entry_hash (Dynarr_atp (rt->entries, | |
192 i*size/5), | |
193 depth)); | |
194 return hash; | |
195 } | |
196 | |
1204 | 197 static const struct memory_description rte_description_1[] = { |
440 | 198 { XD_LISP_OBJECT, offsetof (range_table_entry, val) }, |
428 | 199 { XD_END } |
200 }; | |
201 | |
1204 | 202 static const struct sized_memory_description rte_description = { |
440 | 203 sizeof (range_table_entry), |
428 | 204 rte_description_1 |
205 }; | |
206 | |
1204 | 207 static const struct memory_description rted_description_1[] = { |
440 | 208 XD_DYNARR_DESC (range_table_entry_dynarr, &rte_description), |
428 | 209 { XD_END } |
210 }; | |
211 | |
1204 | 212 static const struct sized_memory_description rted_description = { |
440 | 213 sizeof (range_table_entry_dynarr), |
428 | 214 rted_description_1 |
215 }; | |
216 | |
1204 | 217 static const struct memory_description range_table_description[] = { |
2551 | 218 { XD_BLOCK_PTR, offsetof (Lisp_Range_Table, entries), 1, |
219 { &rted_description } }, | |
428 | 220 { XD_END } |
221 }; | |
222 | |
934 | 223 DEFINE_LRECORD_IMPLEMENTATION ("range-table", range_table, |
224 1, /*dumpable-flag*/ | |
225 mark_range_table, print_range_table, 0, | |
226 range_table_equal, range_table_hash, | |
227 range_table_description, | |
228 Lisp_Range_Table); | |
428 | 229 |
230 /************************************************************************/ | |
231 /* Range table operations */ | |
232 /************************************************************************/ | |
233 | |
800 | 234 #ifdef ERROR_CHECK_STRUCTURES |
428 | 235 |
236 static void | |
440 | 237 verify_range_table (Lisp_Range_Table *rt) |
428 | 238 { |
239 int i; | |
240 | |
241 for (i = 0; i < Dynarr_length (rt->entries); i++) | |
242 { | |
243 struct range_table_entry *rte = Dynarr_atp (rt->entries, i); | |
244 assert (rte->last >= rte->first); | |
245 if (i > 0) | |
2421 | 246 assert (Dynarr_at (rt->entries, i - 1).last <= rte->first); |
428 | 247 } |
248 } | |
249 | |
250 #else | |
251 | |
252 #define verify_range_table(rt) | |
253 | |
254 #endif | |
255 | |
256 /* Look up in a range table without the Dynarr wrapper. | |
257 Used also by the unified range table format. */ | |
258 | |
259 static Lisp_Object | |
260 get_range_table (EMACS_INT pos, int nentries, struct range_table_entry *tab, | |
261 Lisp_Object default_) | |
262 { | |
263 int left = 0, right = nentries; | |
264 | |
265 /* binary search for the entry. Based on similar code in | |
266 extent_list_locate(). */ | |
267 while (left != right) | |
268 { | |
269 /* RIGHT might not point to a valid entry (i.e. it's at the end | |
270 of the list), so NEWPOS must round down. */ | |
647 | 271 int newpos = (left + right) >> 1; |
428 | 272 struct range_table_entry *entry = tab + newpos; |
2421 | 273 if (pos >= entry->last) |
274 left = newpos + 1; | |
428 | 275 else if (pos < entry->first) |
276 right = newpos; | |
277 else | |
278 return entry->val; | |
279 } | |
280 | |
281 return default_; | |
282 } | |
283 | |
284 DEFUN ("range-table-p", Frange_table_p, 1, 1, 0, /* | |
285 Return non-nil if OBJECT is a range table. | |
286 */ | |
287 (object)) | |
288 { | |
289 return RANGE_TABLEP (object) ? Qt : Qnil; | |
290 } | |
291 | |
2421 | 292 DEFUN ("range-table-type", Frange_table_type, 1, 1, 0, /* |
4713
312503644bc3
Correct the docstring for #'range-table-type.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4690
diff
changeset
|
293 Return the type of RANGE-TABLE. |
312503644bc3
Correct the docstring for #'range-table-type.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4690
diff
changeset
|
294 |
312503644bc3
Correct the docstring for #'range-table-type.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4690
diff
changeset
|
295 This will be a symbol describing how ranges in RANGE-TABLE function at their |
312503644bc3
Correct the docstring for #'range-table-type.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4690
diff
changeset
|
296 ends; see `make-range-table'. |
2421 | 297 */ |
298 (range_table)) | |
299 { | |
300 CHECK_RANGE_TABLE (range_table); | |
301 return range_table_type_to_symbol (XRANGE_TABLE (range_table)->type); | |
302 } | |
303 | |
304 DEFUN ("make-range-table", Fmake_range_table, 0, 1, 0, /* | |
428 | 305 Return a new, empty range table. |
306 You can manipulate it using `put-range-table', `get-range-table', | |
307 `remove-range-table', and `clear-range-table'. | |
2421 | 308 Range tables allow you to efficiently set values for ranges of integers. |
309 | |
310 TYPE is a symbol indicating how ranges are assumed to function at their | |
311 ends. It can be one of | |
312 | |
313 SYMBOL RANGE-START RANGE-END | |
314 ------ ----------- --------- | |
315 `start-closed-end-open' (the default) closed open | |
316 `start-closed-end-closed' closed closed | |
317 `start-open-end-open' open open | |
318 `start-open-end-closed' open closed | |
319 | |
320 A `closed' endpoint of a range means that the number at that end is included | |
321 in the range. For an `open' endpoint, the number would not be included. | |
322 | |
323 For example, a closed-open range from 5 to 20 would be indicated as [5, | |
324 20) where a bracket indicates a closed end and a parenthesis an open end, | |
325 and would mean `all the numbers between 5 and 20', including 5 but not 20. | |
326 This seems a little strange at first but is in fact extremely common in | |
327 the outside world as well as in computers and makes things work sensibly. | |
328 For example, if I say "there are seven days between today and next week | |
329 today", I'm including today but not next week today; if I included both, | |
330 there would be eight days. Similarly, there are 15 (= 20 - 5) elements in | |
331 the range [5, 20), but 16 in the range [5, 20]. | |
428 | 332 */ |
2421 | 333 (type)) |
428 | 334 { |
3017 | 335 Lisp_Range_Table *rt = ALLOC_LCRECORD_TYPE (Lisp_Range_Table, |
440 | 336 &lrecord_range_table); |
428 | 337 rt->entries = Dynarr_new (range_table_entry); |
2421 | 338 rt->type = range_table_symbol_to_type (type); |
793 | 339 return wrap_range_table (rt); |
428 | 340 } |
341 | |
342 DEFUN ("copy-range-table", Fcopy_range_table, 1, 1, 0, /* | |
444 | 343 Return a new range table which is a copy of RANGE-TABLE. |
344 It will contain the same values for the same ranges as RANGE-TABLE. | |
345 The values will not themselves be copied. | |
428 | 346 */ |
444 | 347 (range_table)) |
428 | 348 { |
440 | 349 Lisp_Range_Table *rt, *rtnew; |
428 | 350 |
444 | 351 CHECK_RANGE_TABLE (range_table); |
352 rt = XRANGE_TABLE (range_table); | |
428 | 353 |
3017 | 354 rtnew = ALLOC_LCRECORD_TYPE (Lisp_Range_Table, &lrecord_range_table); |
428 | 355 rtnew->entries = Dynarr_new (range_table_entry); |
2421 | 356 rtnew->type = rt->type; |
428 | 357 |
4967 | 358 Dynarr_add_many (rtnew->entries, Dynarr_begin (rt->entries), |
428 | 359 Dynarr_length (rt->entries)); |
793 | 360 return wrap_range_table (rtnew); |
428 | 361 } |
362 | |
363 DEFUN ("get-range-table", Fget_range_table, 2, 3, 0, /* | |
444 | 364 Find value for position POS in RANGE-TABLE. |
428 | 365 If there is no corresponding value, return DEFAULT (defaults to nil). |
366 */ | |
444 | 367 (pos, range_table, default_)) |
428 | 368 { |
440 | 369 Lisp_Range_Table *rt; |
428 | 370 |
444 | 371 CHECK_RANGE_TABLE (range_table); |
372 rt = XRANGE_TABLE (range_table); | |
428 | 373 |
374 CHECK_INT_COERCE_CHAR (pos); | |
375 | |
376 return get_range_table (XINT (pos), Dynarr_length (rt->entries), | |
4967 | 377 Dynarr_begin (rt->entries), default_); |
428 | 378 } |
379 | |
4831
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
380 static void |
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
381 external_to_internal_adjust_ends (enum range_table_type type, |
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
382 EMACS_INT *first, EMACS_INT *last) |
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
383 { |
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
384 /* Fix up the numbers in accordance with the open/closedness to make |
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
385 them behave like default open/closed. */ |
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
386 switch (type) |
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
387 { |
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
388 case RANGE_START_CLOSED_END_OPEN: break; |
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
389 case RANGE_START_CLOSED_END_CLOSED: (*last)++; break; |
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
390 case RANGE_START_OPEN_END_OPEN: (*first)++; break; |
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
391 case RANGE_START_OPEN_END_CLOSED: (*first)++, (*last)++; break; |
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
392 } |
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
393 } |
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
394 |
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
395 static void |
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
396 internal_to_external_adjust_ends (enum range_table_type type, |
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
397 EMACS_INT *first, EMACS_INT *last) |
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
398 { |
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
399 /* Reverse the changes made in external_to_internal_adjust_ends(). |
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
400 */ |
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
401 switch (type) |
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
402 { |
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
403 case RANGE_START_CLOSED_END_OPEN: break; |
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
404 case RANGE_START_CLOSED_END_CLOSED: (*last)--; break; |
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
405 case RANGE_START_OPEN_END_OPEN: (*first)--; break; |
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
406 case RANGE_START_OPEN_END_CLOSED: (*first)--, (*last)--; break; |
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
407 } |
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
408 } |
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
409 |
428 | 410 void |
411 put_range_table (Lisp_Object table, EMACS_INT first, | |
412 EMACS_INT last, Lisp_Object val) | |
413 { | |
414 int i; | |
415 int insert_me_here = -1; | |
440 | 416 Lisp_Range_Table *rt = XRANGE_TABLE (table); |
428 | 417 |
4831
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
418 external_to_internal_adjust_ends (rt->type, &first, &last); |
2421 | 419 if (first == last) |
420 return; | |
421 if (first > last) | |
422 /* This will happen if originally first == last and both ends are | |
423 open. #### Should we signal an error? */ | |
424 return; | |
425 | |
428 | 426 /* Now insert in the proper place. This gets tricky because |
427 we may be overlapping one or more existing ranges and need | |
428 to fix them up. */ | |
429 | |
430 /* First delete all sections of any existing ranges that overlap | |
431 the new range. */ | |
432 for (i = 0; i < Dynarr_length (rt->entries); i++) | |
433 { | |
434 struct range_table_entry *entry = Dynarr_atp (rt->entries, i); | |
435 /* We insert before the first range that begins at or after the | |
436 new range. */ | |
437 if (entry->first >= first && insert_me_here < 0) | |
438 insert_me_here = i; | |
439 if (entry->last < first) | |
440 /* completely before the new range. */ | |
441 continue; | |
442 if (entry->first > last) | |
443 /* completely after the new range. No more possibilities of | |
444 finding overlapping ranges. */ | |
445 break; | |
2421 | 446 /* At this point the existing ENTRY overlaps or touches the new one. */ |
428 | 447 if (entry->first < first && entry->last <= last) |
448 { | |
449 /* looks like: | |
450 | |
2421 | 451 [ NEW ) |
452 [ EXISTING ) | |
453 | |
454 or | |
455 | |
456 [ NEW ) | |
457 [ EXISTING ) | |
428 | 458 |
459 */ | |
460 /* truncate the end off of it. */ | |
2421 | 461 entry->last = first; |
428 | 462 } |
463 else if (entry->first < first && entry->last > last) | |
464 /* looks like: | |
465 | |
2421 | 466 [ NEW ) |
467 [ EXISTING ) | |
428 | 468 |
469 */ | |
470 /* need to split this one in two. */ | |
471 { | |
472 struct range_table_entry insert_me_too; | |
473 | |
2421 | 474 insert_me_too.first = last; |
428 | 475 insert_me_too.last = entry->last; |
476 insert_me_too.val = entry->val; | |
2421 | 477 entry->last = first; |
428 | 478 Dynarr_insert_many (rt->entries, &insert_me_too, 1, i + 1); |
479 } | |
2421 | 480 else if (entry->last >= last) |
428 | 481 { |
482 /* looks like: | |
483 | |
2421 | 484 [ NEW ) |
485 [ EXISTING ) | |
486 | |
487 or | |
488 | |
489 [ NEW ) | |
490 [ EXISTING ) | |
428 | 491 |
492 */ | |
493 /* truncate the start off of it. */ | |
2421 | 494 entry->first = last; |
428 | 495 } |
496 else | |
497 { | |
498 /* existing is entirely within new. */ | |
499 Dynarr_delete_many (rt->entries, i, 1); | |
500 i--; /* back up since everything shifted one to the left. */ | |
501 } | |
502 } | |
503 | |
504 /* Someone asked us to delete the range, not insert it. */ | |
505 if (UNBOUNDP (val)) | |
506 return; | |
507 | |
508 /* Now insert the new entry, maybe at the end. */ | |
509 | |
510 if (insert_me_here < 0) | |
511 insert_me_here = i; | |
512 | |
513 { | |
514 struct range_table_entry insert_me; | |
515 | |
516 insert_me.first = first; | |
517 insert_me.last = last; | |
518 insert_me.val = val; | |
519 | |
520 Dynarr_insert_many (rt->entries, &insert_me, 1, insert_me_here); | |
521 } | |
522 | |
523 /* Now see if we can combine this entry with adjacent ones just | |
524 before or after. */ | |
525 | |
526 if (insert_me_here > 0) | |
527 { | |
528 struct range_table_entry *entry = Dynarr_atp (rt->entries, | |
529 insert_me_here - 1); | |
2421 | 530 if (EQ (val, entry->val) && entry->last == first) |
428 | 531 { |
532 entry->last = last; | |
533 Dynarr_delete_many (rt->entries, insert_me_here, 1); | |
534 insert_me_here--; | |
535 /* We have morphed into a larger range. Update our records | |
536 in case we also combine with the one after. */ | |
537 first = entry->first; | |
538 } | |
539 } | |
540 | |
541 if (insert_me_here < Dynarr_length (rt->entries) - 1) | |
542 { | |
543 struct range_table_entry *entry = Dynarr_atp (rt->entries, | |
544 insert_me_here + 1); | |
2421 | 545 if (EQ (val, entry->val) && entry->first == last) |
428 | 546 { |
547 entry->first = first; | |
548 Dynarr_delete_many (rt->entries, insert_me_here, 1); | |
549 } | |
550 } | |
551 } | |
552 | |
553 DEFUN ("put-range-table", Fput_range_table, 4, 4, 0, /* | |
2421 | 554 Set the value for range START .. END to be VALUE in RANGE-TABLE. |
428 | 555 */ |
444 | 556 (start, end, value, range_table)) |
428 | 557 { |
558 EMACS_INT first, last; | |
559 | |
444 | 560 CHECK_RANGE_TABLE (range_table); |
428 | 561 CHECK_INT_COERCE_CHAR (start); |
562 first = XINT (start); | |
563 CHECK_INT_COERCE_CHAR (end); | |
564 last = XINT (end); | |
565 if (first > last) | |
563 | 566 invalid_argument_2 ("start must be <= end", start, end); |
428 | 567 |
444 | 568 put_range_table (range_table, first, last, value); |
569 verify_range_table (XRANGE_TABLE (range_table)); | |
428 | 570 return Qnil; |
571 } | |
572 | |
573 DEFUN ("remove-range-table", Fremove_range_table, 3, 3, 0, /* | |
2421 | 574 Remove the value for range START .. END in RANGE-TABLE. |
428 | 575 */ |
444 | 576 (start, end, range_table)) |
428 | 577 { |
444 | 578 return Fput_range_table (start, end, Qunbound, range_table); |
428 | 579 } |
580 | |
581 DEFUN ("clear-range-table", Fclear_range_table, 1, 1, 0, /* | |
444 | 582 Flush RANGE-TABLE. |
428 | 583 */ |
444 | 584 (range_table)) |
428 | 585 { |
444 | 586 CHECK_RANGE_TABLE (range_table); |
587 Dynarr_reset (XRANGE_TABLE (range_table)->entries); | |
428 | 588 return Qnil; |
589 } | |
590 | |
591 DEFUN ("map-range-table", Fmap_range_table, 2, 2, 0, /* | |
444 | 592 Map FUNCTION over entries in RANGE-TABLE, calling it with three args, |
428 | 593 the beginning and end of the range and the corresponding value. |
442 | 594 |
595 Results are guaranteed to be correct (i.e. each entry processed | |
596 exactly once) if FUNCTION modifies or deletes the current entry | |
444 | 597 \(i.e. passes the current range to `put-range-table' or |
4391
cbf129b005df
Clarify #'map-range-table docstring.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3017
diff
changeset
|
598 `remove-range-table'). If FUNCTION modifies or deletes any other entry, |
cbf129b005df
Clarify #'map-range-table docstring.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3017
diff
changeset
|
599 this guarantee doesn't hold. |
428 | 600 */ |
444 | 601 (function, range_table)) |
428 | 602 { |
442 | 603 Lisp_Range_Table *rt; |
604 int i; | |
605 | |
444 | 606 CHECK_RANGE_TABLE (range_table); |
442 | 607 CHECK_FUNCTION (function); |
608 | |
444 | 609 rt = XRANGE_TABLE (range_table); |
442 | 610 |
611 /* Do not "optimize" by pulling out the length computation below! | |
612 FUNCTION may have changed the table. */ | |
613 for (i = 0; i < Dynarr_length (rt->entries); i++) | |
614 { | |
615 struct range_table_entry *entry = Dynarr_atp (rt->entries, i); | |
616 EMACS_INT first, last; | |
617 Lisp_Object args[4]; | |
618 int oldlen; | |
619 | |
620 again: | |
621 first = entry->first; | |
622 last = entry->last; | |
623 oldlen = Dynarr_length (rt->entries); | |
624 args[0] = function; | |
2952 | 625 /* Fix up the numbers in accordance with the open/closedness of the |
626 table. */ | |
627 { | |
628 EMACS_INT premier = first, dernier = last; | |
4831
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
629 internal_to_external_adjust_ends (rt->type, &premier, &dernier); |
2952 | 630 args[1] = make_int (premier); |
631 args[2] = make_int (dernier); | |
632 } | |
442 | 633 args[3] = entry->val; |
634 Ffuncall (countof (args), args); | |
635 /* Has FUNCTION removed the entry? */ | |
636 if (oldlen > Dynarr_length (rt->entries) | |
637 && i < Dynarr_length (rt->entries) | |
638 && (first != entry->first || last != entry->last)) | |
639 goto again; | |
640 } | |
641 | |
428 | 642 return Qnil; |
643 } | |
644 | |
645 | |
646 /************************************************************************/ | |
647 /* Range table read syntax */ | |
648 /************************************************************************/ | |
649 | |
650 static int | |
2421 | 651 rangetab_type_validate (Lisp_Object UNUSED (keyword), Lisp_Object value, |
652 Error_Behavior UNUSED (errb)) | |
653 { | |
654 /* #### should deal with ERRB */ | |
655 range_table_symbol_to_type (value); | |
656 return 1; | |
657 } | |
658 | |
659 static int | |
2286 | 660 rangetab_data_validate (Lisp_Object UNUSED (keyword), Lisp_Object value, |
661 Error_Behavior UNUSED (errb)) | |
428 | 662 { |
2367 | 663 /* #### should deal with ERRB */ |
664 EXTERNAL_PROPERTY_LIST_LOOP_3 (range, data, value) | |
428 | 665 { |
666 if (!INTP (range) && !CHARP (range) | |
667 && !(CONSP (range) && CONSP (XCDR (range)) | |
668 && NILP (XCDR (XCDR (range))) | |
669 && (INTP (XCAR (range)) || CHARP (XCAR (range))) | |
670 && (INTP (XCAR (XCDR (range))) || CHARP (XCAR (XCDR (range)))))) | |
563 | 671 sferror ("Invalid range format", range); |
428 | 672 } |
673 | |
674 return 1; | |
675 } | |
676 | |
677 static Lisp_Object | |
2421 | 678 rangetab_instantiate (Lisp_Object plist) |
428 | 679 { |
2425 | 680 Lisp_Object data = Qnil, type = Qnil, rangetab; |
428 | 681 |
2421 | 682 PROPERTY_LIST_LOOP_3 (key, value, plist) |
428 | 683 { |
2421 | 684 if (EQ (key, Qtype)) type = value; |
685 else if (EQ (key, Qdata)) data = value; | |
686 else | |
2500 | 687 ABORT (); |
2421 | 688 } |
689 | |
2425 | 690 rangetab = Fmake_range_table (type); |
428 | 691 |
2421 | 692 { |
693 PROPERTY_LIST_LOOP_3 (range, val, data) | |
694 { | |
695 if (CONSP (range)) | |
696 Fput_range_table (Fcar (range), Fcar (Fcdr (range)), val, | |
697 rangetab); | |
698 else | |
699 Fput_range_table (range, range, val, rangetab); | |
700 } | |
701 } | |
428 | 702 |
703 return rangetab; | |
704 } | |
705 | |
706 | |
707 /************************************************************************/ | |
708 /* Unified range tables */ | |
709 /************************************************************************/ | |
710 | |
711 /* A "unified range table" is a format for storing range tables | |
712 as contiguous blocks of memory. This is used by the regexp | |
713 code, which needs to use range tables to properly handle [] | |
714 constructs in the presence of extended characters but wants to | |
715 store an entire compiled pattern as a contiguous block of memory. | |
716 | |
717 Unified range tables are designed so that they can be placed | |
718 at an arbitrary (possibly mis-aligned) place in memory. | |
719 (Dealing with alignment is a pain in the ass.) | |
720 | |
721 WARNING: No provisions for garbage collection are currently made. | |
722 This means that there must not be any Lisp objects in a unified | |
723 range table that need to be marked for garbage collection. | |
724 Good candidates for objects that can go into a range table are | |
725 | |
726 -- numbers and characters (do not need to be marked) | |
727 -- nil, t (marked elsewhere) | |
728 -- charsets and coding systems (automatically marked because | |
729 they are in a marked list, | |
730 and can't be removed) | |
731 | |
732 Good but slightly less so: | |
733 | |
734 -- symbols (could be uninterned, but that is not likely) | |
735 | |
736 Somewhat less good: | |
737 | |
738 -- buffers, frames, devices (could get deleted) | |
739 | |
740 | |
741 It is expected that you work with range tables in the normal | |
742 format and then convert to unified format when you are done | |
743 making modifications. As such, no functions are provided | |
744 for modifying a unified range table. The only operations | |
745 you can do to unified range tables are | |
746 | |
747 -- look up a value | |
748 -- retrieve all the ranges in an iterative fashion | |
749 | |
750 */ | |
751 | |
752 /* The format of a unified range table is as follows: | |
753 | |
754 -- The first byte contains the number of bytes to skip to find the | |
755 actual start of the table. This deals with alignment constraints, | |
756 since the table might want to go at any arbitrary place in memory. | |
757 -- The next three bytes contain the number of bytes to skip (from the | |
758 *first* byte) to find the stuff after the table. It's stored in | |
759 little-endian format because that's how God intended things. We don't | |
760 necessarily start the stuff at the very end of the table because | |
761 we want to have at least ALIGNOF (EMACS_INT) extra space in case | |
762 we have to move the range table around. (It appears that some | |
763 architectures don't maintain alignment when reallocing.) | |
764 -- At the prescribed offset is a struct unified_range_table, containing | |
765 some number of `struct range_table_entry' entries. */ | |
766 | |
767 struct unified_range_table | |
768 { | |
769 int nentries; | |
4831
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
770 enum range_table_type type; |
428 | 771 struct range_table_entry first; |
772 }; | |
773 | |
774 /* Return size in bytes needed to store the data in a range table. */ | |
775 | |
776 int | |
777 unified_range_table_bytes_needed (Lisp_Object rangetab) | |
778 { | |
779 return (sizeof (struct range_table_entry) * | |
780 (Dynarr_length (XRANGE_TABLE (rangetab)->entries) - 1) + | |
781 sizeof (struct unified_range_table) + | |
782 /* ALIGNOF a struct may be too big. */ | |
783 /* We have four bytes for the size numbers, and an extra | |
784 four or eight bytes for making sure we get the alignment | |
785 OK. */ | |
786 ALIGNOF (EMACS_INT) + 4); | |
787 } | |
788 | |
789 /* Convert a range table into unified format and store in DEST, | |
790 which must be able to hold the number of bytes returned by | |
791 range_table_bytes_needed(). */ | |
792 | |
793 void | |
794 unified_range_table_copy_data (Lisp_Object rangetab, void *dest) | |
795 { | |
796 /* We cast to the above structure rather than just casting to | |
797 char * and adding sizeof(int), because that will lead to | |
798 mis-aligned data on the Alpha machines. */ | |
799 struct unified_range_table *un; | |
800 range_table_entry_dynarr *rted = XRANGE_TABLE (rangetab)->entries; | |
801 int total_needed = unified_range_table_bytes_needed (rangetab); | |
826 | 802 void *new_dest = ALIGN_PTR ((char *) dest + 4, EMACS_INT); |
428 | 803 |
804 * (char *) dest = (char) ((char *) new_dest - (char *) dest); | |
805 * ((unsigned char *) dest + 1) = total_needed & 0xFF; | |
806 total_needed >>= 8; | |
807 * ((unsigned char *) dest + 2) = total_needed & 0xFF; | |
808 total_needed >>= 8; | |
809 * ((unsigned char *) dest + 3) = total_needed & 0xFF; | |
810 un = (struct unified_range_table *) new_dest; | |
811 un->nentries = Dynarr_length (rted); | |
4831
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
812 un->type = XRANGE_TABLE (rangetab)->type; |
4967 | 813 memcpy (&un->first, Dynarr_begin (rted), |
428 | 814 sizeof (struct range_table_entry) * Dynarr_length (rted)); |
815 } | |
816 | |
817 /* Return number of bytes actually used by a unified range table. */ | |
818 | |
819 int | |
820 unified_range_table_bytes_used (void *unrangetab) | |
821 { | |
822 return ((* ((unsigned char *) unrangetab + 1)) | |
823 + ((* ((unsigned char *) unrangetab + 2)) << 8) | |
824 + ((* ((unsigned char *) unrangetab + 3)) << 16)); | |
825 } | |
826 | |
827 /* Make sure the table is aligned, and move it around if it's not. */ | |
828 static void | |
829 align_the_damn_table (void *unrangetab) | |
830 { | |
831 void *cur_dest = (char *) unrangetab + * (char *) unrangetab; | |
826 | 832 if (cur_dest != ALIGN_PTR (cur_dest, EMACS_INT)) |
428 | 833 { |
834 int count = (unified_range_table_bytes_used (unrangetab) - 4 | |
835 - ALIGNOF (EMACS_INT)); | |
836 /* Find the proper location, just like above. */ | |
826 | 837 void *new_dest = ALIGN_PTR ((char *) unrangetab + 4, EMACS_INT); |
428 | 838 /* memmove() works in the presence of overlapping data. */ |
839 memmove (new_dest, cur_dest, count); | |
840 * (char *) unrangetab = (char) ((char *) new_dest - (char *) unrangetab); | |
841 } | |
842 } | |
843 | |
844 /* Look up a value in a unified range table. */ | |
845 | |
846 Lisp_Object | |
847 unified_range_table_lookup (void *unrangetab, EMACS_INT pos, | |
848 Lisp_Object default_) | |
849 { | |
850 void *new_dest; | |
851 struct unified_range_table *un; | |
852 | |
853 align_the_damn_table (unrangetab); | |
854 new_dest = (char *) unrangetab + * (char *) unrangetab; | |
855 un = (struct unified_range_table *) new_dest; | |
856 | |
857 return get_range_table (pos, un->nentries, &un->first, default_); | |
858 } | |
859 | |
860 /* Return number of entries in a unified range table. */ | |
861 | |
862 int | |
863 unified_range_table_nentries (void *unrangetab) | |
864 { | |
865 void *new_dest; | |
866 struct unified_range_table *un; | |
867 | |
868 align_the_damn_table (unrangetab); | |
869 new_dest = (char *) unrangetab + * (char *) unrangetab; | |
870 un = (struct unified_range_table *) new_dest; | |
871 return un->nentries; | |
872 } | |
873 | |
874 /* Return the OFFSETth range (counting from 0) in UNRANGETAB. */ | |
875 void | |
876 unified_range_table_get_range (void *unrangetab, int offset, | |
877 EMACS_INT *min, EMACS_INT *max, | |
878 Lisp_Object *val) | |
879 { | |
880 void *new_dest; | |
881 struct unified_range_table *un; | |
882 struct range_table_entry *tab; | |
883 | |
884 align_the_damn_table (unrangetab); | |
885 new_dest = (char *) unrangetab + * (char *) unrangetab; | |
886 un = (struct unified_range_table *) new_dest; | |
887 | |
888 assert (offset >= 0 && offset < un->nentries); | |
889 tab = (&un->first) + offset; | |
890 *min = tab->first; | |
891 *max = tab->last; | |
892 *val = tab->val; | |
4831
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
893 |
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
894 internal_to_external_adjust_ends (un->type, min, max); |
428 | 895 } |
896 | |
897 | |
898 /************************************************************************/ | |
899 /* Initialization */ | |
900 /************************************************************************/ | |
901 | |
902 void | |
903 syms_of_rangetab (void) | |
904 { | |
442 | 905 INIT_LRECORD_IMPLEMENTATION (range_table); |
906 | |
563 | 907 DEFSYMBOL_MULTIWORD_PREDICATE (Qrange_tablep); |
908 DEFSYMBOL (Qrange_table); | |
428 | 909 |
2421 | 910 DEFSYMBOL (Qstart_closed_end_open); |
911 DEFSYMBOL (Qstart_open_end_open); | |
912 DEFSYMBOL (Qstart_closed_end_closed); | |
913 DEFSYMBOL (Qstart_open_end_closed); | |
914 | |
428 | 915 DEFSUBR (Frange_table_p); |
2421 | 916 DEFSUBR (Frange_table_type); |
428 | 917 DEFSUBR (Fmake_range_table); |
918 DEFSUBR (Fcopy_range_table); | |
919 DEFSUBR (Fget_range_table); | |
920 DEFSUBR (Fput_range_table); | |
921 DEFSUBR (Fremove_range_table); | |
922 DEFSUBR (Fclear_range_table); | |
923 DEFSUBR (Fmap_range_table); | |
924 } | |
925 | |
926 void | |
927 structure_type_create_rangetab (void) | |
928 { | |
929 struct structure_type *st; | |
930 | |
931 st = define_structure_type (Qrange_table, 0, rangetab_instantiate); | |
932 | |
933 define_structure_type_keyword (st, Qdata, rangetab_data_validate); | |
2421 | 934 define_structure_type_keyword (st, Qtype, rangetab_type_validate); |
428 | 935 } |