Mercurial > hg > xemacs-beta
annotate src/rangetab.c @ 4539:061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
lib-src/ChangeLog addition:
2008-12-27 Aidan Kehoe <kehoea@parhasard.net>
* make-docfile.c (main): Allow more than one -d argument, followed
by a directory to change to.
(put_filename): Don't strip directory information; with previous
change, allows retrieval of Lisp function and variable origin
files from #'built-in-symbol-file relative to lisp-directory.
(scan_lisp_file): Don't add an extraneous newline after the file
name, put_filename has added the newline already.
lisp/ChangeLog addition:
2008-12-27 Aidan Kehoe <kehoea@parhasard.net>
* loadup.el (load-history):
Add the contents of current-load-list to load-history before
clearing it. Move the variable declarations earlier in the file to
a format understood by make-docfile.c.
* custom.el (custom-declare-variable): Add the variable's symbol
to the current file's load history entry correctly, don't use a
cons. Eliminate a comment that we don't need to worry about, we
don't need to check the `initialized' C variable in Lisp.
* bytecomp.el (byte-compile-output-file-form):
Merge Andreas Schwab's pre-GPLv3 GNU change of 19970831 here;
treat #'custom-declare-variable correctly, generating the
docstrings in a format understood by make-docfile.c.
* loadhist.el (symbol-file): Correct behaviour for checking
autoloaded macros and functions when supplied with a TYPE
argument. Accept fully-qualified paths from
#'built-in-symbol-file; if a path is not fully-qualified, return
it relative to lisp-directory if the filename corresponds to a
Lisp file, and relative to (concat source-directory "/src/")
otherwise.
* make-docfile.el (preloaded-file-list):
Rationalise some let bindings a little. Use the "-d" argument to
make-docfile.c to supply Lisp paths relative to lisp-directory,
not absolutely. Add in loadup.el explicitly to the list of files
to be processed by make-docfile.c--it doesn't make sense to add it
to preloaded-file-list, since that is used for purposes of
byte-compilation too.
src/ChangeLog addition:
2008-12-27 Aidan Kehoe <kehoea@parhasard.net>
* doc.c (Fbuilt_in_symbol_file):
Return a subr's filename immediately if we've found it. Check for
compiled function and compiled macro docstrings in DOC too, and
return them if they exist.
The branch of the if statement focused on functions may have
executed, but we may still want to check variable bindings; an
else clause isn't appropriate.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sat, 27 Dec 2008 14:05:50 +0000 |
| parents | cbf129b005df |
| children | 257b468bf2ca |
| rev | line source |
|---|---|
| 428 | 1 /* XEmacs routines to deal with range tables. |
| 2 Copyright (C) 1995 Sun Microsystems, Inc. | |
| 2952 | 3 Copyright (C) 1995, 2002, 2004, 2005 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); | |
| 95 return Qnil; | |
| 96 } | |
| 97 | |
| 98 static void | |
| 2286 | 99 print_range_table (Lisp_Object obj, Lisp_Object printcharfun, |
| 100 int UNUSED (escapeflag)) | |
| 428 | 101 { |
| 440 | 102 Lisp_Range_Table *rt = XRANGE_TABLE (obj); |
| 428 | 103 int i; |
| 104 | |
| 2421 | 105 if (print_readably) |
| 106 write_fmt_string_lisp (printcharfun, "#s(range-table type %s data (", | |
| 107 1, range_table_type_to_symbol (rt->type)); | |
| 108 else | |
| 109 write_c_string (printcharfun, "#<range-table "); | |
| 428 | 110 for (i = 0; i < Dynarr_length (rt->entries); i++) |
| 111 { | |
| 112 struct range_table_entry *rte = Dynarr_atp (rt->entries, i); | |
| 2421 | 113 int so, ec; |
| 428 | 114 if (i > 0) |
| 826 | 115 write_c_string (printcharfun, " "); |
| 2421 | 116 switch (rt->type) |
| 117 { | |
| 118 case RANGE_START_CLOSED_END_OPEN: so = 0, ec = 0; break; | |
| 119 case RANGE_START_CLOSED_END_CLOSED: so = 0, ec = 1; break; | |
| 120 case RANGE_START_OPEN_END_OPEN: so = 1, ec = 0; break; | |
| 121 case RANGE_START_OPEN_END_CLOSED: so = 1; ec = 1; break; | |
| 2500 | 122 default: ABORT (); so = 0, ec = 0; break; |
| 2421 | 123 } |
| 124 write_fmt_string (printcharfun, "%c%ld %ld%c ", | |
| 125 print_readably ? '(' : so ? '(' : '[', | |
| 126 (long) (rte->first - so), | |
| 127 (long) (rte->last - ec), | |
| 128 print_readably ? ')' : ec ? ']' : ')' | |
| 129 ); | |
| 428 | 130 print_internal (rte->val, printcharfun, 1); |
| 131 } | |
| 2421 | 132 if (print_readably) |
| 133 write_c_string (printcharfun, "))"); | |
| 134 else | |
| 135 write_fmt_string (printcharfun, " 0x%x>", rt->header.uid); | |
| 428 | 136 } |
| 137 | |
| 138 static int | |
| 139 range_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) | |
| 140 { | |
| 440 | 141 Lisp_Range_Table *rt1 = XRANGE_TABLE (obj1); |
| 142 Lisp_Range_Table *rt2 = XRANGE_TABLE (obj2); | |
| 428 | 143 int i; |
| 144 | |
| 145 if (Dynarr_length (rt1->entries) != Dynarr_length (rt2->entries)) | |
| 146 return 0; | |
| 147 | |
| 148 for (i = 0; i < Dynarr_length (rt1->entries); i++) | |
| 149 { | |
| 150 struct range_table_entry *rte1 = Dynarr_atp (rt1->entries, i); | |
| 151 struct range_table_entry *rte2 = Dynarr_atp (rt2->entries, i); | |
| 152 | |
| 153 if (rte1->first != rte2->first | |
| 154 || rte1->last != rte2->last | |
| 155 || !internal_equal (rte1->val, rte2->val, depth + 1)) | |
| 156 return 0; | |
| 157 } | |
| 158 | |
| 159 return 1; | |
| 160 } | |
| 161 | |
| 2515 | 162 static Hashcode |
| 428 | 163 range_table_entry_hash (struct range_table_entry *rte, int depth) |
| 164 { | |
| 165 return HASH3 (rte->first, rte->last, internal_hash (rte->val, depth + 1)); | |
| 166 } | |
| 167 | |
| 2515 | 168 static Hashcode |
| 428 | 169 range_table_hash (Lisp_Object obj, int depth) |
| 170 { | |
| 440 | 171 Lisp_Range_Table *rt = XRANGE_TABLE (obj); |
| 428 | 172 int i; |
| 173 int size = Dynarr_length (rt->entries); | |
| 2515 | 174 Hashcode hash = size; |
| 428 | 175 |
| 176 /* approach based on internal_array_hash(). */ | |
| 177 if (size <= 5) | |
| 178 { | |
| 179 for (i = 0; i < size; i++) | |
| 180 hash = HASH2 (hash, | |
| 181 range_table_entry_hash (Dynarr_atp (rt->entries, i), | |
| 182 depth)); | |
| 183 return hash; | |
| 184 } | |
| 185 | |
| 186 /* just pick five elements scattered throughout the array. | |
| 187 A slightly better approach would be to offset by some | |
| 188 noise factor from the points chosen below. */ | |
| 189 for (i = 0; i < 5; i++) | |
| 190 hash = HASH2 (hash, range_table_entry_hash (Dynarr_atp (rt->entries, | |
| 191 i*size/5), | |
| 192 depth)); | |
| 193 return hash; | |
| 194 } | |
| 195 | |
| 1204 | 196 static const struct memory_description rte_description_1[] = { |
| 440 | 197 { XD_LISP_OBJECT, offsetof (range_table_entry, val) }, |
| 428 | 198 { XD_END } |
| 199 }; | |
| 200 | |
| 1204 | 201 static const struct sized_memory_description rte_description = { |
| 440 | 202 sizeof (range_table_entry), |
| 428 | 203 rte_description_1 |
| 204 }; | |
| 205 | |
| 1204 | 206 static const struct memory_description rted_description_1[] = { |
| 440 | 207 XD_DYNARR_DESC (range_table_entry_dynarr, &rte_description), |
| 428 | 208 { XD_END } |
| 209 }; | |
| 210 | |
| 1204 | 211 static const struct sized_memory_description rted_description = { |
| 440 | 212 sizeof (range_table_entry_dynarr), |
| 428 | 213 rted_description_1 |
| 214 }; | |
| 215 | |
| 1204 | 216 static const struct memory_description range_table_description[] = { |
| 2551 | 217 { XD_BLOCK_PTR, offsetof (Lisp_Range_Table, entries), 1, |
| 218 { &rted_description } }, | |
| 428 | 219 { XD_END } |
| 220 }; | |
| 221 | |
| 934 | 222 DEFINE_LRECORD_IMPLEMENTATION ("range-table", range_table, |
| 223 1, /*dumpable-flag*/ | |
| 224 mark_range_table, print_range_table, 0, | |
| 225 range_table_equal, range_table_hash, | |
| 226 range_table_description, | |
| 227 Lisp_Range_Table); | |
| 428 | 228 |
| 229 /************************************************************************/ | |
| 230 /* Range table operations */ | |
| 231 /************************************************************************/ | |
| 232 | |
| 800 | 233 #ifdef ERROR_CHECK_STRUCTURES |
| 428 | 234 |
| 235 static void | |
| 440 | 236 verify_range_table (Lisp_Range_Table *rt) |
| 428 | 237 { |
| 238 int i; | |
| 239 | |
| 240 for (i = 0; i < Dynarr_length (rt->entries); i++) | |
| 241 { | |
| 242 struct range_table_entry *rte = Dynarr_atp (rt->entries, i); | |
| 243 assert (rte->last >= rte->first); | |
| 244 if (i > 0) | |
| 2421 | 245 assert (Dynarr_at (rt->entries, i - 1).last <= rte->first); |
| 428 | 246 } |
| 247 } | |
| 248 | |
| 249 #else | |
| 250 | |
| 251 #define verify_range_table(rt) | |
| 252 | |
| 253 #endif | |
| 254 | |
| 255 /* Look up in a range table without the Dynarr wrapper. | |
| 256 Used also by the unified range table format. */ | |
| 257 | |
| 258 static Lisp_Object | |
| 259 get_range_table (EMACS_INT pos, int nentries, struct range_table_entry *tab, | |
| 260 Lisp_Object default_) | |
| 261 { | |
| 262 int left = 0, right = nentries; | |
| 263 | |
| 264 /* binary search for the entry. Based on similar code in | |
| 265 extent_list_locate(). */ | |
| 266 while (left != right) | |
| 267 { | |
| 268 /* RIGHT might not point to a valid entry (i.e. it's at the end | |
| 269 of the list), so NEWPOS must round down. */ | |
| 647 | 270 int newpos = (left + right) >> 1; |
| 428 | 271 struct range_table_entry *entry = tab + newpos; |
| 2421 | 272 if (pos >= entry->last) |
| 273 left = newpos + 1; | |
| 428 | 274 else if (pos < entry->first) |
| 275 right = newpos; | |
| 276 else | |
| 277 return entry->val; | |
| 278 } | |
| 279 | |
| 280 return default_; | |
| 281 } | |
| 282 | |
| 283 DEFUN ("range-table-p", Frange_table_p, 1, 1, 0, /* | |
| 284 Return non-nil if OBJECT is a range table. | |
| 285 */ | |
| 286 (object)) | |
| 287 { | |
| 288 return RANGE_TABLEP (object) ? Qt : Qnil; | |
| 289 } | |
| 290 | |
| 2421 | 291 DEFUN ("range-table-type", Frange_table_type, 1, 1, 0, /* |
| 292 Return non-nil if OBJECT is a range table. | |
| 293 */ | |
| 294 (range_table)) | |
| 295 { | |
| 296 CHECK_RANGE_TABLE (range_table); | |
| 297 return range_table_type_to_symbol (XRANGE_TABLE (range_table)->type); | |
| 298 } | |
| 299 | |
| 300 DEFUN ("make-range-table", Fmake_range_table, 0, 1, 0, /* | |
| 428 | 301 Return a new, empty range table. |
| 302 You can manipulate it using `put-range-table', `get-range-table', | |
| 303 `remove-range-table', and `clear-range-table'. | |
| 2421 | 304 Range tables allow you to efficiently set values for ranges of integers. |
| 305 | |
| 306 TYPE is a symbol indicating how ranges are assumed to function at their | |
| 307 ends. It can be one of | |
| 308 | |
| 309 SYMBOL RANGE-START RANGE-END | |
| 310 ------ ----------- --------- | |
| 311 `start-closed-end-open' (the default) closed open | |
| 312 `start-closed-end-closed' closed closed | |
| 313 `start-open-end-open' open open | |
| 314 `start-open-end-closed' open closed | |
| 315 | |
| 316 A `closed' endpoint of a range means that the number at that end is included | |
| 317 in the range. For an `open' endpoint, the number would not be included. | |
| 318 | |
| 319 For example, a closed-open range from 5 to 20 would be indicated as [5, | |
| 320 20) where a bracket indicates a closed end and a parenthesis an open end, | |
| 321 and would mean `all the numbers between 5 and 20', including 5 but not 20. | |
| 322 This seems a little strange at first but is in fact extremely common in | |
| 323 the outside world as well as in computers and makes things work sensibly. | |
| 324 For example, if I say "there are seven days between today and next week | |
| 325 today", I'm including today but not next week today; if I included both, | |
| 326 there would be eight days. Similarly, there are 15 (= 20 - 5) elements in | |
| 327 the range [5, 20), but 16 in the range [5, 20]. | |
| 428 | 328 */ |
| 2421 | 329 (type)) |
| 428 | 330 { |
| 3017 | 331 Lisp_Range_Table *rt = ALLOC_LCRECORD_TYPE (Lisp_Range_Table, |
| 440 | 332 &lrecord_range_table); |
| 428 | 333 rt->entries = Dynarr_new (range_table_entry); |
| 2421 | 334 rt->type = range_table_symbol_to_type (type); |
| 793 | 335 return wrap_range_table (rt); |
| 428 | 336 } |
| 337 | |
| 338 DEFUN ("copy-range-table", Fcopy_range_table, 1, 1, 0, /* | |
| 444 | 339 Return a new range table which is a copy of RANGE-TABLE. |
| 340 It will contain the same values for the same ranges as RANGE-TABLE. | |
| 341 The values will not themselves be copied. | |
| 428 | 342 */ |
| 444 | 343 (range_table)) |
| 428 | 344 { |
| 440 | 345 Lisp_Range_Table *rt, *rtnew; |
| 428 | 346 |
| 444 | 347 CHECK_RANGE_TABLE (range_table); |
| 348 rt = XRANGE_TABLE (range_table); | |
| 428 | 349 |
| 3017 | 350 rtnew = ALLOC_LCRECORD_TYPE (Lisp_Range_Table, &lrecord_range_table); |
| 428 | 351 rtnew->entries = Dynarr_new (range_table_entry); |
| 2421 | 352 rtnew->type = rt->type; |
| 428 | 353 |
| 354 Dynarr_add_many (rtnew->entries, Dynarr_atp (rt->entries, 0), | |
| 355 Dynarr_length (rt->entries)); | |
| 793 | 356 return wrap_range_table (rtnew); |
| 428 | 357 } |
| 358 | |
| 359 DEFUN ("get-range-table", Fget_range_table, 2, 3, 0, /* | |
| 444 | 360 Find value for position POS in RANGE-TABLE. |
| 428 | 361 If there is no corresponding value, return DEFAULT (defaults to nil). |
| 362 */ | |
| 444 | 363 (pos, range_table, default_)) |
| 428 | 364 { |
| 440 | 365 Lisp_Range_Table *rt; |
| 428 | 366 |
| 444 | 367 CHECK_RANGE_TABLE (range_table); |
| 368 rt = XRANGE_TABLE (range_table); | |
| 428 | 369 |
| 370 CHECK_INT_COERCE_CHAR (pos); | |
| 371 | |
| 372 return get_range_table (XINT (pos), Dynarr_length (rt->entries), | |
| 373 Dynarr_atp (rt->entries, 0), default_); | |
| 374 } | |
| 375 | |
| 376 void | |
| 377 put_range_table (Lisp_Object table, EMACS_INT first, | |
| 378 EMACS_INT last, Lisp_Object val) | |
| 379 { | |
| 380 int i; | |
| 381 int insert_me_here = -1; | |
| 440 | 382 Lisp_Range_Table *rt = XRANGE_TABLE (table); |
| 428 | 383 |
| 2421 | 384 /* Fix up the numbers in accordance with the open/closedness to make |
| 385 them behave like default open/closed. */ | |
| 386 | |
| 387 switch (rt->type) | |
| 388 { | |
| 389 case RANGE_START_CLOSED_END_OPEN: break; | |
| 390 case RANGE_START_CLOSED_END_CLOSED: last++; break; | |
| 391 case RANGE_START_OPEN_END_OPEN: first++; break; | |
| 392 case RANGE_START_OPEN_END_CLOSED: first++, last++; break; | |
| 393 } | |
| 394 | |
| 395 if (first == last) | |
| 396 return; | |
| 397 if (first > last) | |
| 398 /* This will happen if originally first == last and both ends are | |
| 399 open. #### Should we signal an error? */ | |
| 400 return; | |
| 401 | |
| 428 | 402 /* Now insert in the proper place. This gets tricky because |
| 403 we may be overlapping one or more existing ranges and need | |
| 404 to fix them up. */ | |
| 405 | |
| 406 /* First delete all sections of any existing ranges that overlap | |
| 407 the new range. */ | |
| 408 for (i = 0; i < Dynarr_length (rt->entries); i++) | |
| 409 { | |
| 410 struct range_table_entry *entry = Dynarr_atp (rt->entries, i); | |
| 411 /* We insert before the first range that begins at or after the | |
| 412 new range. */ | |
| 413 if (entry->first >= first && insert_me_here < 0) | |
| 414 insert_me_here = i; | |
| 415 if (entry->last < first) | |
| 416 /* completely before the new range. */ | |
| 417 continue; | |
| 418 if (entry->first > last) | |
| 419 /* completely after the new range. No more possibilities of | |
| 420 finding overlapping ranges. */ | |
| 421 break; | |
| 2421 | 422 /* At this point the existing ENTRY overlaps or touches the new one. */ |
| 428 | 423 if (entry->first < first && entry->last <= last) |
| 424 { | |
| 425 /* looks like: | |
| 426 | |
| 2421 | 427 [ NEW ) |
| 428 [ EXISTING ) | |
| 429 | |
| 430 or | |
| 431 | |
| 432 [ NEW ) | |
| 433 [ EXISTING ) | |
| 428 | 434 |
| 435 */ | |
| 436 /* truncate the end off of it. */ | |
| 2421 | 437 entry->last = first; |
| 428 | 438 } |
| 439 else if (entry->first < first && entry->last > last) | |
| 440 /* looks like: | |
| 441 | |
| 2421 | 442 [ NEW ) |
| 443 [ EXISTING ) | |
| 428 | 444 |
| 445 */ | |
| 446 /* need to split this one in two. */ | |
| 447 { | |
| 448 struct range_table_entry insert_me_too; | |
| 449 | |
| 2421 | 450 insert_me_too.first = last; |
| 428 | 451 insert_me_too.last = entry->last; |
| 452 insert_me_too.val = entry->val; | |
| 2421 | 453 entry->last = first; |
| 428 | 454 Dynarr_insert_many (rt->entries, &insert_me_too, 1, i + 1); |
| 455 } | |
| 2421 | 456 else if (entry->last >= last) |
| 428 | 457 { |
| 458 /* looks like: | |
| 459 | |
| 2421 | 460 [ NEW ) |
| 461 [ EXISTING ) | |
| 462 | |
| 463 or | |
| 464 | |
| 465 [ NEW ) | |
| 466 [ EXISTING ) | |
| 428 | 467 |
| 468 */ | |
| 469 /* truncate the start off of it. */ | |
| 2421 | 470 entry->first = last; |
| 428 | 471 } |
| 472 else | |
| 473 { | |
| 474 /* existing is entirely within new. */ | |
| 475 Dynarr_delete_many (rt->entries, i, 1); | |
| 476 i--; /* back up since everything shifted one to the left. */ | |
| 477 } | |
| 478 } | |
| 479 | |
| 480 /* Someone asked us to delete the range, not insert it. */ | |
| 481 if (UNBOUNDP (val)) | |
| 482 return; | |
| 483 | |
| 484 /* Now insert the new entry, maybe at the end. */ | |
| 485 | |
| 486 if (insert_me_here < 0) | |
| 487 insert_me_here = i; | |
| 488 | |
| 489 { | |
| 490 struct range_table_entry insert_me; | |
| 491 | |
| 492 insert_me.first = first; | |
| 493 insert_me.last = last; | |
| 494 insert_me.val = val; | |
| 495 | |
| 496 Dynarr_insert_many (rt->entries, &insert_me, 1, insert_me_here); | |
| 497 } | |
| 498 | |
| 499 /* Now see if we can combine this entry with adjacent ones just | |
| 500 before or after. */ | |
| 501 | |
| 502 if (insert_me_here > 0) | |
| 503 { | |
| 504 struct range_table_entry *entry = Dynarr_atp (rt->entries, | |
| 505 insert_me_here - 1); | |
| 2421 | 506 if (EQ (val, entry->val) && entry->last == first) |
| 428 | 507 { |
| 508 entry->last = last; | |
| 509 Dynarr_delete_many (rt->entries, insert_me_here, 1); | |
| 510 insert_me_here--; | |
| 511 /* We have morphed into a larger range. Update our records | |
| 512 in case we also combine with the one after. */ | |
| 513 first = entry->first; | |
| 514 } | |
| 515 } | |
| 516 | |
| 517 if (insert_me_here < Dynarr_length (rt->entries) - 1) | |
| 518 { | |
| 519 struct range_table_entry *entry = Dynarr_atp (rt->entries, | |
| 520 insert_me_here + 1); | |
| 2421 | 521 if (EQ (val, entry->val) && entry->first == last) |
| 428 | 522 { |
| 523 entry->first = first; | |
| 524 Dynarr_delete_many (rt->entries, insert_me_here, 1); | |
| 525 } | |
| 526 } | |
| 527 } | |
| 528 | |
| 529 DEFUN ("put-range-table", Fput_range_table, 4, 4, 0, /* | |
| 2421 | 530 Set the value for range START .. END to be VALUE in RANGE-TABLE. |
| 428 | 531 */ |
| 444 | 532 (start, end, value, range_table)) |
| 428 | 533 { |
| 534 EMACS_INT first, last; | |
| 535 | |
| 444 | 536 CHECK_RANGE_TABLE (range_table); |
| 428 | 537 CHECK_INT_COERCE_CHAR (start); |
| 538 first = XINT (start); | |
| 539 CHECK_INT_COERCE_CHAR (end); | |
| 540 last = XINT (end); | |
| 541 if (first > last) | |
| 563 | 542 invalid_argument_2 ("start must be <= end", start, end); |
| 428 | 543 |
| 444 | 544 put_range_table (range_table, first, last, value); |
| 545 verify_range_table (XRANGE_TABLE (range_table)); | |
| 428 | 546 return Qnil; |
| 547 } | |
| 548 | |
| 549 DEFUN ("remove-range-table", Fremove_range_table, 3, 3, 0, /* | |
| 2421 | 550 Remove the value for range START .. END in RANGE-TABLE. |
| 428 | 551 */ |
| 444 | 552 (start, end, range_table)) |
| 428 | 553 { |
| 444 | 554 return Fput_range_table (start, end, Qunbound, range_table); |
| 428 | 555 } |
| 556 | |
| 557 DEFUN ("clear-range-table", Fclear_range_table, 1, 1, 0, /* | |
| 444 | 558 Flush RANGE-TABLE. |
| 428 | 559 */ |
| 444 | 560 (range_table)) |
| 428 | 561 { |
| 444 | 562 CHECK_RANGE_TABLE (range_table); |
| 563 Dynarr_reset (XRANGE_TABLE (range_table)->entries); | |
| 428 | 564 return Qnil; |
| 565 } | |
| 566 | |
| 567 DEFUN ("map-range-table", Fmap_range_table, 2, 2, 0, /* | |
| 444 | 568 Map FUNCTION over entries in RANGE-TABLE, calling it with three args, |
| 428 | 569 the beginning and end of the range and the corresponding value. |
| 442 | 570 |
| 571 Results are guaranteed to be correct (i.e. each entry processed | |
| 572 exactly once) if FUNCTION modifies or deletes the current entry | |
| 444 | 573 \(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
|
574 `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
|
575 this guarantee doesn't hold. |
| 428 | 576 */ |
| 444 | 577 (function, range_table)) |
| 428 | 578 { |
| 442 | 579 Lisp_Range_Table *rt; |
| 580 int i; | |
| 581 | |
| 444 | 582 CHECK_RANGE_TABLE (range_table); |
| 442 | 583 CHECK_FUNCTION (function); |
| 584 | |
| 444 | 585 rt = XRANGE_TABLE (range_table); |
| 442 | 586 |
| 587 /* Do not "optimize" by pulling out the length computation below! | |
| 588 FUNCTION may have changed the table. */ | |
| 589 for (i = 0; i < Dynarr_length (rt->entries); i++) | |
| 590 { | |
| 591 struct range_table_entry *entry = Dynarr_atp (rt->entries, i); | |
| 592 EMACS_INT first, last; | |
| 593 Lisp_Object args[4]; | |
| 594 int oldlen; | |
| 595 | |
| 596 again: | |
| 597 first = entry->first; | |
| 598 last = entry->last; | |
| 599 oldlen = Dynarr_length (rt->entries); | |
| 600 args[0] = function; | |
| 2952 | 601 /* Fix up the numbers in accordance with the open/closedness of the |
| 602 table. */ | |
| 603 { | |
| 604 EMACS_INT premier = first, dernier = last; | |
| 605 switch (rt->type) | |
| 606 { | |
| 607 case RANGE_START_CLOSED_END_OPEN: break; | |
| 608 case RANGE_START_CLOSED_END_CLOSED: dernier--; break; | |
| 609 case RANGE_START_OPEN_END_OPEN: premier--; break; | |
| 610 case RANGE_START_OPEN_END_CLOSED: premier--, dernier--; break; | |
| 611 } | |
| 612 args[1] = make_int (premier); | |
| 613 args[2] = make_int (dernier); | |
| 614 } | |
| 442 | 615 args[3] = entry->val; |
| 616 Ffuncall (countof (args), args); | |
| 617 /* Has FUNCTION removed the entry? */ | |
| 618 if (oldlen > Dynarr_length (rt->entries) | |
| 619 && i < Dynarr_length (rt->entries) | |
| 620 && (first != entry->first || last != entry->last)) | |
| 621 goto again; | |
| 622 } | |
| 623 | |
| 428 | 624 return Qnil; |
| 625 } | |
| 626 | |
| 627 | |
| 628 /************************************************************************/ | |
| 629 /* Range table read syntax */ | |
| 630 /************************************************************************/ | |
| 631 | |
| 632 static int | |
| 2421 | 633 rangetab_type_validate (Lisp_Object UNUSED (keyword), Lisp_Object value, |
| 634 Error_Behavior UNUSED (errb)) | |
| 635 { | |
| 636 /* #### should deal with ERRB */ | |
| 637 range_table_symbol_to_type (value); | |
| 638 return 1; | |
| 639 } | |
| 640 | |
| 641 static int | |
| 2286 | 642 rangetab_data_validate (Lisp_Object UNUSED (keyword), Lisp_Object value, |
| 643 Error_Behavior UNUSED (errb)) | |
| 428 | 644 { |
| 2367 | 645 /* #### should deal with ERRB */ |
| 646 EXTERNAL_PROPERTY_LIST_LOOP_3 (range, data, value) | |
| 428 | 647 { |
| 648 if (!INTP (range) && !CHARP (range) | |
| 649 && !(CONSP (range) && CONSP (XCDR (range)) | |
| 650 && NILP (XCDR (XCDR (range))) | |
| 651 && (INTP (XCAR (range)) || CHARP (XCAR (range))) | |
| 652 && (INTP (XCAR (XCDR (range))) || CHARP (XCAR (XCDR (range)))))) | |
| 563 | 653 sferror ("Invalid range format", range); |
| 428 | 654 } |
| 655 | |
| 656 return 1; | |
| 657 } | |
| 658 | |
| 659 static Lisp_Object | |
| 2421 | 660 rangetab_instantiate (Lisp_Object plist) |
| 428 | 661 { |
| 2425 | 662 Lisp_Object data = Qnil, type = Qnil, rangetab; |
| 428 | 663 |
| 2421 | 664 PROPERTY_LIST_LOOP_3 (key, value, plist) |
| 428 | 665 { |
| 2421 | 666 if (EQ (key, Qtype)) type = value; |
| 667 else if (EQ (key, Qdata)) data = value; | |
| 668 else | |
| 2500 | 669 ABORT (); |
| 2421 | 670 } |
| 671 | |
| 2425 | 672 rangetab = Fmake_range_table (type); |
| 428 | 673 |
| 2421 | 674 { |
| 675 PROPERTY_LIST_LOOP_3 (range, val, data) | |
| 676 { | |
| 677 if (CONSP (range)) | |
| 678 Fput_range_table (Fcar (range), Fcar (Fcdr (range)), val, | |
| 679 rangetab); | |
| 680 else | |
| 681 Fput_range_table (range, range, val, rangetab); | |
| 682 } | |
| 683 } | |
| 428 | 684 |
| 685 return rangetab; | |
| 686 } | |
| 687 | |
| 688 | |
| 689 /************************************************************************/ | |
| 690 /* Unified range tables */ | |
| 691 /************************************************************************/ | |
| 692 | |
| 693 /* A "unified range table" is a format for storing range tables | |
| 694 as contiguous blocks of memory. This is used by the regexp | |
| 695 code, which needs to use range tables to properly handle [] | |
| 696 constructs in the presence of extended characters but wants to | |
| 697 store an entire compiled pattern as a contiguous block of memory. | |
| 698 | |
| 699 Unified range tables are designed so that they can be placed | |
| 700 at an arbitrary (possibly mis-aligned) place in memory. | |
| 701 (Dealing with alignment is a pain in the ass.) | |
| 702 | |
| 703 WARNING: No provisions for garbage collection are currently made. | |
| 704 This means that there must not be any Lisp objects in a unified | |
| 705 range table that need to be marked for garbage collection. | |
| 706 Good candidates for objects that can go into a range table are | |
| 707 | |
| 708 -- numbers and characters (do not need to be marked) | |
| 709 -- nil, t (marked elsewhere) | |
| 710 -- charsets and coding systems (automatically marked because | |
| 711 they are in a marked list, | |
| 712 and can't be removed) | |
| 713 | |
| 714 Good but slightly less so: | |
| 715 | |
| 716 -- symbols (could be uninterned, but that is not likely) | |
| 717 | |
| 718 Somewhat less good: | |
| 719 | |
| 720 -- buffers, frames, devices (could get deleted) | |
| 721 | |
| 722 | |
| 723 It is expected that you work with range tables in the normal | |
| 724 format and then convert to unified format when you are done | |
| 725 making modifications. As such, no functions are provided | |
| 726 for modifying a unified range table. The only operations | |
| 727 you can do to unified range tables are | |
| 728 | |
| 729 -- look up a value | |
| 730 -- retrieve all the ranges in an iterative fashion | |
| 731 | |
| 732 */ | |
| 733 | |
| 734 /* The format of a unified range table is as follows: | |
| 735 | |
| 736 -- The first byte contains the number of bytes to skip to find the | |
| 737 actual start of the table. This deals with alignment constraints, | |
| 738 since the table might want to go at any arbitrary place in memory. | |
| 739 -- The next three bytes contain the number of bytes to skip (from the | |
| 740 *first* byte) to find the stuff after the table. It's stored in | |
| 741 little-endian format because that's how God intended things. We don't | |
| 742 necessarily start the stuff at the very end of the table because | |
| 743 we want to have at least ALIGNOF (EMACS_INT) extra space in case | |
| 744 we have to move the range table around. (It appears that some | |
| 745 architectures don't maintain alignment when reallocing.) | |
| 746 -- At the prescribed offset is a struct unified_range_table, containing | |
| 747 some number of `struct range_table_entry' entries. */ | |
| 748 | |
| 749 struct unified_range_table | |
| 750 { | |
| 751 int nentries; | |
| 752 struct range_table_entry first; | |
| 753 }; | |
| 754 | |
| 755 /* Return size in bytes needed to store the data in a range table. */ | |
| 756 | |
| 757 int | |
| 758 unified_range_table_bytes_needed (Lisp_Object rangetab) | |
| 759 { | |
| 760 return (sizeof (struct range_table_entry) * | |
| 761 (Dynarr_length (XRANGE_TABLE (rangetab)->entries) - 1) + | |
| 762 sizeof (struct unified_range_table) + | |
| 763 /* ALIGNOF a struct may be too big. */ | |
| 764 /* We have four bytes for the size numbers, and an extra | |
| 765 four or eight bytes for making sure we get the alignment | |
| 766 OK. */ | |
| 767 ALIGNOF (EMACS_INT) + 4); | |
| 768 } | |
| 769 | |
| 770 /* Convert a range table into unified format and store in DEST, | |
| 771 which must be able to hold the number of bytes returned by | |
| 772 range_table_bytes_needed(). */ | |
| 773 | |
| 774 void | |
| 775 unified_range_table_copy_data (Lisp_Object rangetab, void *dest) | |
| 776 { | |
| 777 /* We cast to the above structure rather than just casting to | |
| 778 char * and adding sizeof(int), because that will lead to | |
| 779 mis-aligned data on the Alpha machines. */ | |
| 780 struct unified_range_table *un; | |
| 781 range_table_entry_dynarr *rted = XRANGE_TABLE (rangetab)->entries; | |
| 782 int total_needed = unified_range_table_bytes_needed (rangetab); | |
| 826 | 783 void *new_dest = ALIGN_PTR ((char *) dest + 4, EMACS_INT); |
| 428 | 784 |
| 785 * (char *) dest = (char) ((char *) new_dest - (char *) dest); | |
| 786 * ((unsigned char *) dest + 1) = total_needed & 0xFF; | |
| 787 total_needed >>= 8; | |
| 788 * ((unsigned char *) dest + 2) = total_needed & 0xFF; | |
| 789 total_needed >>= 8; | |
| 790 * ((unsigned char *) dest + 3) = total_needed & 0xFF; | |
| 791 un = (struct unified_range_table *) new_dest; | |
| 792 un->nentries = Dynarr_length (rted); | |
| 793 memcpy (&un->first, Dynarr_atp (rted, 0), | |
| 794 sizeof (struct range_table_entry) * Dynarr_length (rted)); | |
| 795 } | |
| 796 | |
| 797 /* Return number of bytes actually used by a unified range table. */ | |
| 798 | |
| 799 int | |
| 800 unified_range_table_bytes_used (void *unrangetab) | |
| 801 { | |
| 802 return ((* ((unsigned char *) unrangetab + 1)) | |
| 803 + ((* ((unsigned char *) unrangetab + 2)) << 8) | |
| 804 + ((* ((unsigned char *) unrangetab + 3)) << 16)); | |
| 805 } | |
| 806 | |
| 807 /* Make sure the table is aligned, and move it around if it's not. */ | |
| 808 static void | |
| 809 align_the_damn_table (void *unrangetab) | |
| 810 { | |
| 811 void *cur_dest = (char *) unrangetab + * (char *) unrangetab; | |
| 826 | 812 if (cur_dest != ALIGN_PTR (cur_dest, EMACS_INT)) |
| 428 | 813 { |
| 814 int count = (unified_range_table_bytes_used (unrangetab) - 4 | |
| 815 - ALIGNOF (EMACS_INT)); | |
| 816 /* Find the proper location, just like above. */ | |
| 826 | 817 void *new_dest = ALIGN_PTR ((char *) unrangetab + 4, EMACS_INT); |
| 428 | 818 /* memmove() works in the presence of overlapping data. */ |
| 819 memmove (new_dest, cur_dest, count); | |
| 820 * (char *) unrangetab = (char) ((char *) new_dest - (char *) unrangetab); | |
| 821 } | |
| 822 } | |
| 823 | |
| 824 /* Look up a value in a unified range table. */ | |
| 825 | |
| 826 Lisp_Object | |
| 827 unified_range_table_lookup (void *unrangetab, EMACS_INT pos, | |
| 828 Lisp_Object default_) | |
| 829 { | |
| 830 void *new_dest; | |
| 831 struct unified_range_table *un; | |
| 832 | |
| 833 align_the_damn_table (unrangetab); | |
| 834 new_dest = (char *) unrangetab + * (char *) unrangetab; | |
| 835 un = (struct unified_range_table *) new_dest; | |
| 836 | |
| 837 return get_range_table (pos, un->nentries, &un->first, default_); | |
| 838 } | |
| 839 | |
| 840 /* Return number of entries in a unified range table. */ | |
| 841 | |
| 842 int | |
| 843 unified_range_table_nentries (void *unrangetab) | |
| 844 { | |
| 845 void *new_dest; | |
| 846 struct unified_range_table *un; | |
| 847 | |
| 848 align_the_damn_table (unrangetab); | |
| 849 new_dest = (char *) unrangetab + * (char *) unrangetab; | |
| 850 un = (struct unified_range_table *) new_dest; | |
| 851 return un->nentries; | |
| 852 } | |
| 853 | |
| 854 /* Return the OFFSETth range (counting from 0) in UNRANGETAB. */ | |
| 855 void | |
| 856 unified_range_table_get_range (void *unrangetab, int offset, | |
| 857 EMACS_INT *min, EMACS_INT *max, | |
| 858 Lisp_Object *val) | |
| 859 { | |
| 860 void *new_dest; | |
| 861 struct unified_range_table *un; | |
| 862 struct range_table_entry *tab; | |
| 863 | |
| 864 align_the_damn_table (unrangetab); | |
| 865 new_dest = (char *) unrangetab + * (char *) unrangetab; | |
| 866 un = (struct unified_range_table *) new_dest; | |
| 867 | |
| 868 assert (offset >= 0 && offset < un->nentries); | |
| 869 tab = (&un->first) + offset; | |
| 870 *min = tab->first; | |
| 871 *max = tab->last; | |
| 872 *val = tab->val; | |
| 873 } | |
| 874 | |
| 875 | |
| 876 /************************************************************************/ | |
| 877 /* Initialization */ | |
| 878 /************************************************************************/ | |
| 879 | |
| 880 void | |
| 881 syms_of_rangetab (void) | |
| 882 { | |
| 442 | 883 INIT_LRECORD_IMPLEMENTATION (range_table); |
| 884 | |
| 563 | 885 DEFSYMBOL_MULTIWORD_PREDICATE (Qrange_tablep); |
| 886 DEFSYMBOL (Qrange_table); | |
| 428 | 887 |
| 2421 | 888 DEFSYMBOL (Qstart_closed_end_open); |
| 889 DEFSYMBOL (Qstart_open_end_open); | |
| 890 DEFSYMBOL (Qstart_closed_end_closed); | |
| 891 DEFSYMBOL (Qstart_open_end_closed); | |
| 892 | |
| 428 | 893 DEFSUBR (Frange_table_p); |
| 2421 | 894 DEFSUBR (Frange_table_type); |
| 428 | 895 DEFSUBR (Fmake_range_table); |
| 896 DEFSUBR (Fcopy_range_table); | |
| 897 DEFSUBR (Fget_range_table); | |
| 898 DEFSUBR (Fput_range_table); | |
| 899 DEFSUBR (Fremove_range_table); | |
| 900 DEFSUBR (Fclear_range_table); | |
| 901 DEFSUBR (Fmap_range_table); | |
| 902 } | |
| 903 | |
| 904 void | |
| 905 structure_type_create_rangetab (void) | |
| 906 { | |
| 907 struct structure_type *st; | |
| 908 | |
| 909 st = define_structure_type (Qrange_table, 0, rangetab_instantiate); | |
| 910 | |
| 911 define_structure_type_keyword (st, Qdata, rangetab_data_validate); | |
| 2421 | 912 define_structure_type_keyword (st, Qtype, rangetab_type_validate); |
| 428 | 913 } |