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);
58 write_c_string("#s(range-table data (", printcharfun);
59 for (i = 0; i < Dynarr_length(rt->entries); i++) {
60 struct range_table_entry *rte = Dynarr_atp(rt->entries, i);
62 write_c_string(" ", printcharfun);
63 if (rte->first == rte->last)
64 sprintf(buf, "%ld ", (long)(rte->first));
66 sprintf(buf, "(%ld %ld) ", (long)(rte->first),
68 write_c_string(buf, printcharfun);
69 print_internal(rte->val, printcharfun, 1);
71 write_c_string("))", printcharfun);
74 static int range_table_equal(Lisp_Object obj1, Lisp_Object obj2, int depth)
76 Lisp_Range_Table *rt1 = XRANGE_TABLE(obj1);
77 Lisp_Range_Table *rt2 = XRANGE_TABLE(obj2);
80 if (Dynarr_length(rt1->entries) != Dynarr_length(rt2->entries))
83 for (i = 0; i < Dynarr_length(rt1->entries); i++) {
84 struct range_table_entry *rte1 = Dynarr_atp(rt1->entries, i);
85 struct range_table_entry *rte2 = Dynarr_atp(rt2->entries, i);
87 if (rte1->first != rte2->first
88 || rte1->last != rte2->last
89 || !internal_equal(rte1->val, rte2->val, depth + 1))
97 range_table_entry_hash(struct range_table_entry *rte, int depth)
99 return HASH3(rte->first, rte->last, internal_hash(rte->val, depth + 1));
102 static unsigned long range_table_hash(Lisp_Object obj, int depth)
104 Lisp_Range_Table *rt = XRANGE_TABLE(obj);
106 int size = Dynarr_length(rt->entries);
107 unsigned long hash = size;
109 /* approach based on internal_array_hash(). */
111 for (i = 0; i < size; i++)
113 range_table_entry_hash(Dynarr_atp
119 /* just pick five elements scattered throughout the array.
120 A slightly better approach would be to offset by some
121 noise factor from the points chosen below. */
122 for (i = 0; i < 5; i++)
125 range_table_entry_hash(Dynarr_atp
126 (rt->entries, i * size / 5),
131 static const struct lrecord_description rte_description_1[] = {
132 {XD_LISP_OBJECT, offsetof(range_table_entry, val)},
136 static const struct struct_description rte_description = {
137 sizeof(range_table_entry),
141 static const struct lrecord_description rted_description_1[] = {
142 XD_DYNARR_DESC(range_table_entry_dynarr, &rte_description),
146 static const struct struct_description rted_description = {
147 sizeof(range_table_entry_dynarr),
151 static const struct lrecord_description range_table_description[] = {
152 {XD_STRUCT_PTR, offsetof(Lisp_Range_Table, entries), 1,
157 DEFINE_LRECORD_IMPLEMENTATION("range-table", range_table,
158 mark_range_table, print_range_table, 0,
159 range_table_equal, range_table_hash,
160 range_table_description, Lisp_Range_Table);
162 /************************************************************************/
163 /* Range table operations */
164 /************************************************************************/
166 #ifdef ERROR_CHECK_TYPECHECK
168 static void verify_range_table(Lisp_Range_Table * rt)
172 for (i = 0; i < Dynarr_length(rt->entries); i++) {
173 struct range_table_entry *rte = Dynarr_atp(rt->entries, i);
174 assert(rte->last >= rte->first);
176 assert(Dynarr_at(rt->entries, i - 1).last < rte->first);
182 #define verify_range_table(rt)
186 /* Look up in a range table without the Dynarr wrapper.
187 Used also by the unified range table format. */
190 get_range_table(EMACS_INT pos, int nentries, struct range_table_entry *tab,
191 Lisp_Object default_)
193 int left = 0, right = nentries;
195 /* binary search for the entry. Based on similar code in
196 extent_list_locate(). */
197 while (left != right) {
198 /* RIGHT might not point to a valid entry (i.e. it's at the end
199 of the list), so NEWPOS must round down. */
200 unsigned int newpos = (left + right) >> 1;
201 struct range_table_entry *entry = tab + newpos;
202 if (pos > entry->last)
204 else if (pos < entry->first)
213 DEFUN("range-table-p", Frange_table_p, 1, 1, 0, /*
214 Return non-nil if OBJECT is a range table.
218 return RANGE_TABLEP(object) ? Qt : Qnil;
221 DEFUN("make-range-table", Fmake_range_table, 0, 0, 0, /*
222 Return a new, empty range table.
223 You can manipulate it using `put-range-table', `get-range-table',
224 `remove-range-table', and `clear-range-table'.
229 Lisp_Range_Table *rt = alloc_lcrecord_type(Lisp_Range_Table,
230 &lrecord_range_table);
231 rt->entries = Dynarr_new(range_table_entry);
232 XSETRANGE_TABLE(obj, rt);
236 DEFUN("copy-range-table", Fcopy_range_table, 1, 1, 0, /*
237 Return a new range table which is a copy of RANGE-TABLE.
238 It will contain the same values for the same ranges as RANGE-TABLE.
239 The values will not themselves be copied.
243 Lisp_Range_Table *rt, *rtnew;
246 CHECK_RANGE_TABLE(range_table);
247 rt = XRANGE_TABLE(range_table);
249 rtnew = alloc_lcrecord_type(Lisp_Range_Table, &lrecord_range_table);
250 rtnew->entries = Dynarr_new(range_table_entry);
252 Dynarr_add_many(rtnew->entries, Dynarr_atp(rt->entries, 0),
253 Dynarr_length(rt->entries));
254 XSETRANGE_TABLE(obj, rtnew);
258 DEFUN("get-range-table", Fget_range_table, 2, 3, 0, /*
259 Find value for position POS in RANGE-TABLE.
260 If there is no corresponding value, return DEFAULT (defaults to nil).
262 (pos, range_table, default_))
264 Lisp_Range_Table *rt;
266 CHECK_RANGE_TABLE(range_table);
267 rt = XRANGE_TABLE(range_table);
269 CHECK_INT_COERCE_CHAR(pos);
271 return get_range_table(XINT(pos), Dynarr_length(rt->entries),
272 Dynarr_atp(rt->entries, 0), default_);
276 put_range_table(Lisp_Object table, EMACS_INT first,
277 EMACS_INT last, Lisp_Object val)
280 int insert_me_here = -1;
281 Lisp_Range_Table *rt = XRANGE_TABLE(table);
283 /* Now insert in the proper place. This gets tricky because
284 we may be overlapping one or more existing ranges and need
287 /* First delete all sections of any existing ranges that overlap
289 for (i = 0; i < Dynarr_length(rt->entries); i++) {
290 struct range_table_entry *entry = Dynarr_atp(rt->entries, i);
291 /* We insert before the first range that begins at or after the
293 if (entry->first >= first && insert_me_here < 0)
295 if (entry->last < first)
296 /* completely before the new range. */
298 if (entry->first > last)
299 /* completely after the new range. No more possibilities of
300 finding overlapping ranges. */
302 if (entry->first < first && entry->last <= last) {
309 /* truncate the end off of it. */
310 entry->last = first - 1;
311 } else if (entry->first < first && entry->last > last)
318 /* need to split this one in two. */
320 struct range_table_entry insert_me_too;
322 insert_me_too.first = last + 1;
323 insert_me_too.last = entry->last;
324 insert_me_too.val = entry->val;
325 entry->last = first - 1;
326 Dynarr_insert_many(rt->entries, &insert_me_too, 1,
328 } else if (entry->last > last) {
335 /* truncate the start off of it. */
336 entry->first = last + 1;
338 /* existing is entirely within new. */
339 Dynarr_delete_many(rt->entries, i, 1);
340 i--; /* back up since everything shifted one to the left. */
344 /* Someone asked us to delete the range, not insert it. */
348 /* Now insert the new entry, maybe at the end. */
350 if (insert_me_here < 0)
354 struct range_table_entry insert_me;
356 insert_me.first = first;
357 insert_me.last = last;
360 Dynarr_insert_many(rt->entries, &insert_me, 1, insert_me_here);
363 /* Now see if we can combine this entry with adjacent ones just
366 if (insert_me_here > 0) {
367 struct range_table_entry *entry = Dynarr_atp(rt->entries,
370 if (EQ(val, entry->val) && entry->last == first - 1) {
372 Dynarr_delete_many(rt->entries, insert_me_here, 1);
374 /* We have morphed into a larger range. Update our records
375 in case we also combine with the one after. */
376 first = entry->first;
380 if (insert_me_here < Dynarr_length(rt->entries) - 1) {
381 struct range_table_entry *entry = Dynarr_atp(rt->entries,
384 if (EQ(val, entry->val) && entry->first == last + 1) {
385 entry->first = first;
386 Dynarr_delete_many(rt->entries, insert_me_here, 1);
391 DEFUN("put-range-table", Fput_range_table, 4, 4, 0, /*
392 Set the value for range (START, END) to be VALUE in RANGE-TABLE.
394 (start, end, value, range_table))
396 EMACS_INT first, last;
398 CHECK_RANGE_TABLE(range_table);
399 CHECK_INT_COERCE_CHAR(start);
401 CHECK_INT_COERCE_CHAR(end);
404 signal_simple_error_2("start must be <= end", start, end);
406 put_range_table(range_table, first, last, value);
407 verify_range_table(XRANGE_TABLE(range_table));
411 DEFUN("remove-range-table", Fremove_range_table, 3, 3, 0, /*
412 Remove the value for range (START, END) in RANGE-TABLE.
414 (start, end, range_table))
416 return Fput_range_table(start, end, Qunbound, range_table);
419 DEFUN("clear-range-table", Fclear_range_table, 1, 1, 0, /*
424 CHECK_RANGE_TABLE(range_table);
425 Dynarr_reset(XRANGE_TABLE(range_table)->entries);
429 DEFUN("map-range-table", Fmap_range_table, 2, 2, 0, /*
430 Map FUNCTION over entries in RANGE-TABLE, calling it with three args,
431 the beginning and end of the range and the corresponding value.
433 Results are guaranteed to be correct (i.e. each entry processed
434 exactly once) if FUNCTION modifies or deletes the current entry
435 \(i.e. passes the current range to `put-range-table' or
436 `remove-range-table'), but not otherwise.
438 (function, range_table))
440 Lisp_Range_Table *rt;
443 CHECK_RANGE_TABLE(range_table);
444 CHECK_FUNCTION(function);
446 rt = XRANGE_TABLE(range_table);
448 /* Do not "optimize" by pulling out the length computation below!
449 FUNCTION may have changed the table. */
450 for (i = 0; i < Dynarr_length(rt->entries); i++) {
451 struct range_table_entry *entry = Dynarr_atp(rt->entries, i);
452 EMACS_INT first, last;
457 first = entry->first;
459 oldlen = Dynarr_length(rt->entries);
461 args[1] = make_int(first);
462 args[2] = make_int(last);
463 args[3] = entry->val;
464 Ffuncall(countof(args), args);
465 /* Has FUNCTION removed the entry? */
466 if (oldlen > Dynarr_length(rt->entries)
467 && i < Dynarr_length(rt->entries)
468 && (first != entry->first || last != entry->last))
475 /************************************************************************/
476 /* Range table read syntax */
477 /************************************************************************/
480 rangetab_data_validate(Lisp_Object keyword, Lisp_Object value,
485 /* #### should deal with errb */
486 EXTERNAL_LIST_LOOP(rest, value) {
487 Lisp_Object range = XCAR(rest);
490 signal_simple_error("Invalid list format", value);
491 if (!INTP(range) && !CHARP(range)
492 && !(CONSP(range) && CONSP(XCDR(range))
493 && NILP(XCDR(XCDR(range)))
494 && (INTP(XCAR(range)) || CHARP(XCAR(range)))
495 && (INTP(XCAR(XCDR(range)))
496 || CHARP(XCAR(XCDR(range))))))
497 signal_simple_error("Invalid range format", range);
503 static Lisp_Object rangetab_instantiate(Lisp_Object data)
505 Lisp_Object rangetab = Fmake_range_table();
508 data = Fcar(Fcdr(data)); /* skip over 'data keyword */
509 while (!NILP(data)) {
510 Lisp_Object range = Fcar(data);
511 Lisp_Object val = Fcar(Fcdr(data));
513 data = Fcdr(Fcdr(data));
515 Fput_range_table(Fcar(range), Fcar(Fcdr(range)),
518 Fput_range_table(range, range, val, rangetab);
525 /************************************************************************/
526 /* Unified range tables */
527 /************************************************************************/
529 /* A "unified range table" is a format for storing range tables
530 as contiguous blocks of memory. This is used by the regexp
531 code, which needs to use range tables to properly handle []
532 constructs in the presence of extended characters but wants to
533 store an entire compiled pattern as a contiguous block of memory.
535 Unified range tables are designed so that they can be placed
536 at an arbitrary (possibly mis-aligned) place in memory.
537 (Dealing with alignment is a pain in the ass.)
539 WARNING: No provisions for garbage collection are currently made.
540 This means that there must not be any Lisp objects in a unified
541 range table that need to be marked for garbage collection.
542 Good candidates for objects that can go into a range table are
544 -- numbers and characters (do not need to be marked)
545 -- nil, t (marked elsewhere)
546 -- charsets and coding systems (automatically marked because
547 they are in a marked list,
548 and can't be removed)
550 Good but slightly less so:
552 -- symbols (could be uninterned, but that is not likely)
556 -- buffers, frames, devices (could get deleted)
558 It is expected that you work with range tables in the normal
559 format and then convert to unified format when you are done
560 making modifications. As such, no functions are provided
561 for modifying a unified range table. The only operations
562 you can do to unified range tables are
565 -- retrieve all the ranges in an iterative fashion
569 /* The format of a unified range table is as follows:
571 -- The first byte contains the number of bytes to skip to find the
572 actual start of the table. This deals with alignment constraints,
573 since the table might want to go at any arbitrary place in memory.
574 -- The next three bytes contain the number of bytes to skip (from the
575 *first* byte) to find the stuff after the table. It's stored in
576 little-endian format because that's how God intended things. We don't
577 necessarily start the stuff at the very end of the table because
578 we want to have at least ALIGNOF (EMACS_INT) extra space in case
579 we have to move the range table around. (It appears that some
580 architectures don't maintain alignment when reallocing.)
581 -- At the prescribed offset is a struct unified_range_table, containing
582 some number of `struct range_table_entry' entries. */
584 struct unified_range_table {
586 struct range_table_entry first;
589 /* Return size in bytes needed to store the data in a range table. */
591 int unified_range_table_bytes_needed(Lisp_Object rangetab)
593 return (sizeof(struct range_table_entry) *
594 (Dynarr_length(XRANGE_TABLE(rangetab)->entries) - 1) +
595 sizeof(struct unified_range_table) +
596 /* ALIGNOF a struct may be too big. */
597 /* We have four bytes for the size numbers, and an extra
598 four or eight bytes for making sure we get the alignment
600 ALIGNOF(EMACS_INT) + 4);
603 /* Convert a range table into unified format and store in DEST,
604 which must be able to hold the number of bytes returned by
605 range_table_bytes_needed(). */
607 void unified_range_table_copy_data(Lisp_Object rangetab, void *dest)
609 /* We cast to the above structure rather than just casting to
610 char * and adding sizeof(int), because that will lead to
611 mis-aligned data on the Alpha machines. */
612 struct unified_range_table *un;
613 range_table_entry_dynarr *rted = XRANGE_TABLE(rangetab)->entries;
614 int total_needed = unified_range_table_bytes_needed(rangetab);
615 void *new_dest = ALIGN_PTR((char *)dest + 4, ALIGNOF(EMACS_INT));
617 *(char *)dest = (char)((char *)new_dest - (char *)dest);
618 *((unsigned char *)dest + 1) = total_needed & 0xFF;
620 *((unsigned char *)dest + 2) = total_needed & 0xFF;
622 *((unsigned char *)dest + 3) = total_needed & 0xFF;
623 un = (struct unified_range_table *)new_dest;
624 un->nentries = Dynarr_length(rted);
625 memcpy(&un->first, Dynarr_atp(rted, 0),
626 sizeof(struct range_table_entry) * Dynarr_length(rted));
629 /* Return number of bytes actually used by a unified range table. */
631 int unified_range_table_bytes_used(const void *unrangetab)
633 return ((*((const unsigned char*)unrangetab + 1))
634 + ((*((const unsigned char*)unrangetab + 2)) << 8)
635 + ((*((const unsigned char*)unrangetab + 3)) << 16));
638 /* Make sure the table is aligned, and move it around if it's not. */
640 align_the_damn_table(void *unrangetab)
642 const void *cur_dest = (char*)unrangetab + *(char*)unrangetab;
643 #if SXE_LONGBITS == 64
644 if ((((long)cur_dest) & 7) != 0)
646 if ((((int)cur_dest) & 3) != 0)
649 int count = (unified_range_table_bytes_used(unrangetab) - 4
650 - ALIGNOF(EMACS_INT));
651 /* Find the proper location, just like above. */
652 void *new_dest = ALIGN_PTR((char*)unrangetab + 4,
654 /* memmove() works in the presence of overlapping data. */
655 memmove(new_dest, cur_dest, count);
657 (char)((char*)new_dest - (char*)unrangetab);
661 /* Look up a value in a unified range table. */
664 unified_range_table_lookup(void *unrangetab, EMACS_INT pos,
665 Lisp_Object default_)
668 struct unified_range_table *un;
670 align_the_damn_table(unrangetab);
671 new_dest = (char *)unrangetab + *(char *)unrangetab;
672 un = (struct unified_range_table *)new_dest;
674 return get_range_table(pos, un->nentries, &un->first, default_);
677 /* Return number of entries in a unified range table. */
680 unified_range_table_nentries(void *unrangetab)
683 struct unified_range_table *un;
685 align_the_damn_table(unrangetab);
686 new_dest = (char *)unrangetab + *(char *)unrangetab;
687 un = (struct unified_range_table *)new_dest;
691 /* Return the OFFSETth range (counting from 0) in UNRANGETAB. */
693 unified_range_table_get_range(void *unrangetab, int offset,
694 EMACS_INT * min, EMACS_INT * max,
698 struct unified_range_table *un;
699 struct range_table_entry *tab;
701 align_the_damn_table(unrangetab);
702 new_dest = (char *)unrangetab + *(char *)unrangetab;
703 un = (struct unified_range_table *)new_dest;
705 assert(offset >= 0 && offset < un->nentries);
706 tab = (&un->first) + offset;
712 /************************************************************************/
714 /************************************************************************/
716 void syms_of_rangetab(void)
718 INIT_LRECORD_IMPLEMENTATION(range_table);
720 defsymbol(&Qrange_tablep, "range-table-p");
721 defsymbol(&Qrange_table, "range-table");
723 DEFSUBR(Frange_table_p);
724 DEFSUBR(Fmake_range_table);
725 DEFSUBR(Fcopy_range_table);
726 DEFSUBR(Fget_range_table);
727 DEFSUBR(Fput_range_table);
728 DEFSUBR(Fremove_range_table);
729 DEFSUBR(Fclear_range_table);
730 DEFSUBR(Fmap_range_table);
733 void structure_type_create_rangetab(void)
735 struct structure_type *st;
737 st = define_structure_type(Qrange_table, 0, rangetab_instantiate);
739 define_structure_type_keyword(st, Qdata, rangetab_data_validate);