1 /* SXEmacs routines to deal with range tables.
2 Copyright (C) 1995 Sun Microsystems, Inc.
3 Copyright (C) 1995 Ben Wing.
5 This file is part of SXEmacs
7 SXEmacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 SXEmacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with this program. If not, see <http://www.gnu.org/licenses/>. */
21 /* Synched up with: Not in FSF. */
23 /* Written by Ben Wing, August 1995. */
29 Lisp_Object Qrange_tablep;
30 Lisp_Object Qrange_table;
32 /************************************************************************/
33 /* Range table object */
34 /************************************************************************/
36 /* We use a sorted array of ranges.
38 #### We should be using the gap array stuff from extents.c. This
39 is not hard but just requires moving that stuff out of that file. */
41 static Lisp_Object mark_range_table(Lisp_Object obj)
43 Lisp_Range_Table *rt = XRANGE_TABLE(obj);
46 for (i = 0; i < Dynarr_length(rt->entries); i++)
47 mark_object(Dynarr_at(rt->entries, i).val);
52 print_range_table(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
54 Lisp_Range_Table *rt = XRANGE_TABLE(obj);
57 write_c_string("#s(range-table data (", printcharfun);
58 for (i = 0; i < Dynarr_length(rt->entries); i++) {
59 struct range_table_entry *rte = Dynarr_atp(rt->entries, i);
61 write_c_string(" ", printcharfun);
62 if (rte->first == rte->last)
63 write_fmt_str(printcharfun, "%ld ", (long)(rte->first));
65 write_fmt_str(printcharfun, "(%ld %ld) ",
68 print_internal(rte->val, printcharfun, 1);
70 write_c_string("))", printcharfun);
73 static int range_table_equal(Lisp_Object obj1, Lisp_Object obj2, int depth)
75 Lisp_Range_Table *rt1 = XRANGE_TABLE(obj1);
76 Lisp_Range_Table *rt2 = XRANGE_TABLE(obj2);
79 if (Dynarr_length(rt1->entries) != Dynarr_length(rt2->entries))
82 for (i = 0; i < Dynarr_length(rt1->entries); i++) {
83 struct range_table_entry *rte1 = Dynarr_atp(rt1->entries, i);
84 struct range_table_entry *rte2 = Dynarr_atp(rt2->entries, i);
86 if (rte1->first != rte2->first
87 || rte1->last != rte2->last
88 || !internal_equal(rte1->val, rte2->val, depth + 1))
96 range_table_entry_hash(struct range_table_entry *rte, int depth)
98 return HASH3(rte->first, rte->last, internal_hash(rte->val, depth + 1));
101 static unsigned long range_table_hash(Lisp_Object obj, int depth)
103 Lisp_Range_Table *rt = XRANGE_TABLE(obj);
105 int size = Dynarr_length(rt->entries);
106 unsigned long hash = size;
108 /* approach based on internal_array_hash(). */
110 for (i = 0; i < size; i++)
112 range_table_entry_hash(Dynarr_atp
118 /* just pick five elements scattered throughout the array.
119 A slightly better approach would be to offset by some
120 noise factor from the points chosen below. */
121 for (i = 0; i < 5; i++)
124 range_table_entry_hash(Dynarr_atp
125 (rt->entries, i * size / 5),
130 static const struct lrecord_description rte_description_1[] = {
131 {XD_LISP_OBJECT, offsetof(range_table_entry, val)},
135 static const struct struct_description rte_description = {
136 sizeof(range_table_entry),
140 static const struct lrecord_description rted_description_1[] = {
141 XD_DYNARR_DESC(range_table_entry_dynarr, &rte_description),
145 static const struct struct_description rted_description = {
146 sizeof(range_table_entry_dynarr),
150 static const struct lrecord_description range_table_description[] = {
151 {XD_STRUCT_PTR, offsetof(Lisp_Range_Table, entries), 1,
156 DEFINE_LRECORD_IMPLEMENTATION("range-table", range_table,
157 mark_range_table, print_range_table, 0,
158 range_table_equal, range_table_hash,
159 range_table_description, Lisp_Range_Table);
161 /************************************************************************/
162 /* Range table operations */
163 /************************************************************************/
165 #ifdef ERROR_CHECK_TYPECHECK
167 static void verify_range_table(Lisp_Range_Table * rt)
171 for (i = 0; i < Dynarr_length(rt->entries); i++) {
172 struct range_table_entry *rte = Dynarr_atp(rt->entries, i);
173 assert(rte->last >= rte->first);
175 assert(Dynarr_at(rt->entries, i - 1).last < rte->first);
181 #define verify_range_table(rt)
185 /* Look up in a range table without the Dynarr wrapper.
186 Used also by the unified range table format. */
189 get_range_table(EMACS_INT pos, int nentries, struct range_table_entry *tab,
190 Lisp_Object default_)
192 int left = 0, right = nentries;
194 /* binary search for the entry. Based on similar code in
195 extent_list_locate(). */
196 while (left != right) {
197 /* RIGHT might not point to a valid entry (i.e. it's at the end
198 of the list), so NEWPOS must round down. */
199 unsigned int newpos = (left + right) >> 1;
200 struct range_table_entry *entry = tab + newpos;
201 if (pos > entry->last)
203 else if (pos < entry->first)
212 DEFUN("range-table-p", Frange_table_p, 1, 1, 0, /*
213 Return non-nil if OBJECT is a range table.
217 return RANGE_TABLEP(object) ? Qt : Qnil;
220 DEFUN("make-range-table", Fmake_range_table, 0, 0, 0, /*
221 Return a new, empty range table.
222 You can manipulate it using `put-range-table', `get-range-table',
223 `remove-range-table', and `clear-range-table'.
228 Lisp_Range_Table *rt = alloc_lcrecord_type(Lisp_Range_Table,
229 &lrecord_range_table);
230 rt->entries = Dynarr_new(range_table_entry);
231 XSETRANGE_TABLE(obj, rt);
235 DEFUN("copy-range-table", Fcopy_range_table, 1, 1, 0, /*
236 Return a new range table which is a copy of RANGE-TABLE.
237 It will contain the same values for the same ranges as RANGE-TABLE.
238 The values will not themselves be copied.
242 Lisp_Range_Table *rt, *rtnew;
245 CHECK_RANGE_TABLE(range_table);
246 rt = XRANGE_TABLE(range_table);
248 rtnew = alloc_lcrecord_type(Lisp_Range_Table, &lrecord_range_table);
249 rtnew->entries = Dynarr_new(range_table_entry);
251 Dynarr_add_many(rtnew->entries, Dynarr_atp(rt->entries, 0),
252 Dynarr_length(rt->entries));
253 XSETRANGE_TABLE(obj, rtnew);
257 DEFUN("get-range-table", Fget_range_table, 2, 3, 0, /*
258 Find value for position POS in RANGE-TABLE.
259 If there is no corresponding value, return DEFAULT (defaults to nil).
261 (pos, range_table, default_))
263 Lisp_Range_Table *rt;
265 CHECK_RANGE_TABLE(range_table);
266 rt = XRANGE_TABLE(range_table);
268 CHECK_INT_COERCE_CHAR(pos);
270 return get_range_table(XINT(pos), Dynarr_length(rt->entries),
271 Dynarr_atp(rt->entries, 0), default_);
275 put_range_table(Lisp_Object table, EMACS_INT first,
276 EMACS_INT last, Lisp_Object val)
279 int insert_me_here = -1;
280 Lisp_Range_Table *rt = XRANGE_TABLE(table);
282 /* Now insert in the proper place. This gets tricky because
283 we may be overlapping one or more existing ranges and need
286 /* First delete all sections of any existing ranges that overlap
288 for (i = 0; i < Dynarr_length(rt->entries); i++) {
289 struct range_table_entry *entry = Dynarr_atp(rt->entries, i);
290 /* We insert before the first range that begins at or after the
292 if (entry->first >= first && insert_me_here < 0)
294 if (entry->last < first)
295 /* completely before the new range. */
297 if (entry->first > last)
298 /* completely after the new range. No more possibilities of
299 finding overlapping ranges. */
301 if (entry->first < first && entry->last <= last) {
308 /* truncate the end off of it. */
309 entry->last = first - 1;
310 } else if (entry->first < first && entry->last > last)
317 /* need to split this one in two. */
319 struct range_table_entry insert_me_too;
321 insert_me_too.first = last + 1;
322 insert_me_too.last = entry->last;
323 insert_me_too.val = entry->val;
324 entry->last = first - 1;
325 Dynarr_insert_many(rt->entries, &insert_me_too, 1,
327 } else if (entry->last > last) {
334 /* truncate the start off of it. */
335 entry->first = last + 1;
337 /* existing is entirely within new. */
338 Dynarr_delete_many(rt->entries, i, 1);
339 i--; /* back up since everything shifted one to the left. */
343 /* Someone asked us to delete the range, not insert it. */
347 /* Now insert the new entry, maybe at the end. */
349 if (insert_me_here < 0)
353 struct range_table_entry insert_me;
355 insert_me.first = first;
356 insert_me.last = last;
359 Dynarr_insert_many(rt->entries, &insert_me, 1, insert_me_here);
362 /* Now see if we can combine this entry with adjacent ones just
365 if (insert_me_here > 0) {
366 struct range_table_entry *entry = Dynarr_atp(rt->entries,
369 if (EQ(val, entry->val) && entry->last == first - 1) {
371 Dynarr_delete_many(rt->entries, insert_me_here, 1);
373 /* We have morphed into a larger range. Update our records
374 in case we also combine with the one after. */
375 first = entry->first;
379 if (insert_me_here < Dynarr_length(rt->entries) - 1) {
380 struct range_table_entry *entry = Dynarr_atp(rt->entries,
383 if (EQ(val, entry->val) && entry->first == last + 1) {
384 entry->first = first;
385 Dynarr_delete_many(rt->entries, insert_me_here, 1);
390 DEFUN("put-range-table", Fput_range_table, 4, 4, 0, /*
391 Set the value for range (START, END) to be VALUE in RANGE-TABLE.
393 (start, end, value, range_table))
395 EMACS_INT first, last;
397 CHECK_RANGE_TABLE(range_table);
398 CHECK_INT_COERCE_CHAR(start);
400 CHECK_INT_COERCE_CHAR(end);
403 signal_simple_error_2("start must be <= end", start, end);
405 put_range_table(range_table, first, last, value);
406 verify_range_table(XRANGE_TABLE(range_table));
410 DEFUN("remove-range-table", Fremove_range_table, 3, 3, 0, /*
411 Remove the value for range (START, END) in RANGE-TABLE.
413 (start, end, range_table))
415 return Fput_range_table(start, end, Qunbound, range_table);
418 DEFUN("clear-range-table", Fclear_range_table, 1, 1, 0, /*
423 CHECK_RANGE_TABLE(range_table);
424 Dynarr_reset(XRANGE_TABLE(range_table)->entries);
428 DEFUN("map-range-table", Fmap_range_table, 2, 2, 0, /*
429 Map FUNCTION over entries in RANGE-TABLE, calling it with three args,
430 the beginning and end of the range and the corresponding value.
432 Results are guaranteed to be correct (i.e. each entry processed
433 exactly once) if FUNCTION modifies or deletes the current entry
434 \(i.e. passes the current range to `put-range-table' or
435 `remove-range-table'), but not otherwise.
437 (function, range_table))
439 Lisp_Range_Table *rt;
442 CHECK_RANGE_TABLE(range_table);
443 CHECK_FUNCTION(function);
445 rt = XRANGE_TABLE(range_table);
447 /* Do not "optimize" by pulling out the length computation below!
448 FUNCTION may have changed the table. */
449 for (i = 0; i < Dynarr_length(rt->entries); i++) {
450 struct range_table_entry *entry = Dynarr_atp(rt->entries, i);
451 EMACS_INT first, last;
456 first = entry->first;
458 oldlen = Dynarr_length(rt->entries);
460 args[1] = make_int(first);
461 args[2] = make_int(last);
462 args[3] = entry->val;
463 Ffuncall(countof(args), args);
464 /* Has FUNCTION removed the entry? */
465 if (oldlen > Dynarr_length(rt->entries)
466 && i < Dynarr_length(rt->entries)
467 && (first != entry->first || last != entry->last))
474 /************************************************************************/
475 /* Range table read syntax */
476 /************************************************************************/
479 rangetab_data_validate(Lisp_Object keyword, Lisp_Object value,
484 /* #### should deal with errb */
485 EXTERNAL_LIST_LOOP(rest, value) {
486 Lisp_Object range = XCAR(rest);
489 signal_simple_error("Invalid list format", value);
490 if (!INTP(range) && !CHARP(range)
491 && !(CONSP(range) && CONSP(XCDR(range))
492 && NILP(XCDR(XCDR(range)))
493 && (INTP(XCAR(range)) || CHARP(XCAR(range)))
494 && (INTP(XCAR(XCDR(range)))
495 || CHARP(XCAR(XCDR(range))))))
496 signal_simple_error("Invalid range format", range);
502 static Lisp_Object rangetab_instantiate(Lisp_Object data)
504 Lisp_Object rangetab = Fmake_range_table();
507 data = Fcar(Fcdr(data)); /* skip over 'data keyword */
508 while (!NILP(data)) {
509 Lisp_Object range = Fcar(data);
510 Lisp_Object val = Fcar(Fcdr(data));
512 data = Fcdr(Fcdr(data));
514 Fput_range_table(Fcar(range), Fcar(Fcdr(range)),
517 Fput_range_table(range, range, val, rangetab);
524 /************************************************************************/
525 /* Unified range tables */
526 /************************************************************************/
528 /* A "unified range table" is a format for storing range tables
529 as contiguous blocks of memory. This is used by the regexp
530 code, which needs to use range tables to properly handle []
531 constructs in the presence of extended characters but wants to
532 store an entire compiled pattern as a contiguous block of memory.
534 Unified range tables are designed so that they can be placed
535 at an arbitrary (possibly mis-aligned) place in memory.
536 (Dealing with alignment is a pain in the ass.)
538 WARNING: No provisions for garbage collection are currently made.
539 This means that there must not be any Lisp objects in a unified
540 range table that need to be marked for garbage collection.
541 Good candidates for objects that can go into a range table are
543 -- numbers and characters (do not need to be marked)
544 -- nil, t (marked elsewhere)
545 -- charsets and coding systems (automatically marked because
546 they are in a marked list,
547 and can't be removed)
549 Good but slightly less so:
551 -- symbols (could be uninterned, but that is not likely)
555 -- buffers, frames, devices (could get deleted)
557 It is expected that you work with range tables in the normal
558 format and then convert to unified format when you are done
559 making modifications. As such, no functions are provided
560 for modifying a unified range table. The only operations
561 you can do to unified range tables are
564 -- retrieve all the ranges in an iterative fashion
568 /* The format of a unified range table is as follows:
570 -- The first byte contains the number of bytes to skip to find the
571 actual start of the table. This deals with alignment constraints,
572 since the table might want to go at any arbitrary place in memory.
573 -- The next three bytes contain the number of bytes to skip (from the
574 *first* byte) to find the stuff after the table. It's stored in
575 little-endian format because that's how God intended things. We don't
576 necessarily start the stuff at the very end of the table because
577 we want to have at least ALIGNOF (EMACS_INT) extra space in case
578 we have to move the range table around. (It appears that some
579 architectures don't maintain alignment when reallocing.)
580 -- At the prescribed offset is a struct unified_range_table, containing
581 some number of `struct range_table_entry' entries. */
583 struct unified_range_table {
585 struct range_table_entry first;
588 /* Return size in bytes needed to store the data in a range table. */
590 int unified_range_table_bytes_needed(Lisp_Object rangetab)
592 return (sizeof(struct range_table_entry) *
593 (Dynarr_length(XRANGE_TABLE(rangetab)->entries) - 1) +
594 sizeof(struct unified_range_table) +
595 /* ALIGNOF a struct may be too big. */
596 /* We have four bytes for the size numbers, and an extra
597 four or eight bytes for making sure we get the alignment
599 ALIGNOF(EMACS_INT) + 4);
602 /* Convert a range table into unified format and store in DEST,
603 which must be able to hold the number of bytes returned by
604 range_table_bytes_needed(). */
606 void unified_range_table_copy_data(Lisp_Object rangetab, void *dest)
608 /* We cast to the above structure rather than just casting to
609 char * and adding sizeof(int), because that will lead to
610 mis-aligned data on the Alpha machines. */
611 struct unified_range_table *un;
612 range_table_entry_dynarr *rted = XRANGE_TABLE(rangetab)->entries;
613 int total_needed = unified_range_table_bytes_needed(rangetab);
614 void *new_dest = ALIGN_PTR((char *)dest + 4, ALIGNOF(EMACS_INT));
616 *(char *)dest = (char)((char *)new_dest - (char *)dest);
617 *((unsigned char *)dest + 1) = total_needed & 0xFF;
619 *((unsigned char *)dest + 2) = total_needed & 0xFF;
621 *((unsigned char *)dest + 3) = total_needed & 0xFF;
622 un = (struct unified_range_table *)new_dest;
623 un->nentries = Dynarr_length(rted);
624 memcpy(&un->first, Dynarr_atp(rted, 0),
625 sizeof(struct range_table_entry) * Dynarr_length(rted));
628 /* Return number of bytes actually used by a unified range table. */
630 int unified_range_table_bytes_used(const void *unrangetab)
632 return ((*((const unsigned char*)unrangetab + 1))
633 + ((*((const unsigned char*)unrangetab + 2)) << 8)
634 + ((*((const unsigned char*)unrangetab + 3)) << 16));
637 /* Make sure the table is aligned, and move it around if it's not. */
639 align_the_damn_table(void *unrangetab)
641 const void *cur_dest = (char*)unrangetab + *(char*)unrangetab;
642 #if SXE_LONGBITS == 64
643 if ((((long)cur_dest) & 7) != 0)
645 if ((((int)cur_dest) & 3) != 0)
648 int count = (unified_range_table_bytes_used(unrangetab) - 4
649 - ALIGNOF(EMACS_INT));
650 /* Find the proper location, just like above. */
651 void *new_dest = ALIGN_PTR((char*)unrangetab + 4,
653 /* memmove() works in the presence of overlapping data. */
654 memmove(new_dest, cur_dest, count);
656 (char)((char*)new_dest - (char*)unrangetab);
660 /* Look up a value in a unified range table. */
663 unified_range_table_lookup(void *unrangetab, EMACS_INT pos,
664 Lisp_Object default_)
667 struct unified_range_table *un;
669 align_the_damn_table(unrangetab);
670 new_dest = (char *)unrangetab + *(char *)unrangetab;
671 un = (struct unified_range_table *)new_dest;
673 return get_range_table(pos, un->nentries, &un->first, default_);
676 /* Return number of entries in a unified range table. */
679 unified_range_table_nentries(void *unrangetab)
682 struct unified_range_table *un;
684 align_the_damn_table(unrangetab);
685 new_dest = (char *)unrangetab + *(char *)unrangetab;
686 un = (struct unified_range_table *)new_dest;
690 /* Return the OFFSETth range (counting from 0) in UNRANGETAB. */
692 unified_range_table_get_range(void *unrangetab, int offset,
693 EMACS_INT * min, EMACS_INT * max,
697 struct unified_range_table *un;
698 struct range_table_entry *tab;
700 align_the_damn_table(unrangetab);
701 new_dest = (char *)unrangetab + *(char *)unrangetab;
702 un = (struct unified_range_table *)new_dest;
704 assert(offset >= 0 && offset < un->nentries);
705 tab = (&un->first) + offset;
711 /************************************************************************/
713 /************************************************************************/
715 void syms_of_rangetab(void)
717 INIT_LRECORD_IMPLEMENTATION(range_table);
719 defsymbol(&Qrange_tablep, "range-table-p");
720 defsymbol(&Qrange_table, "range-table");
722 DEFSUBR(Frange_table_p);
723 DEFSUBR(Fmake_range_table);
724 DEFSUBR(Fcopy_range_table);
725 DEFSUBR(Fget_range_table);
726 DEFSUBR(Fput_range_table);
727 DEFSUBR(Fremove_range_table);
728 DEFSUBR(Fclear_range_table);
729 DEFSUBR(Fmap_range_table);
732 void structure_type_create_rangetab(void)
734 struct structure_type *st;
736 st = define_structure_type(Qrange_table, 0, rangetab_instantiate);
738 define_structure_type_keyword(st, Qdata, rangetab_data_validate);