1 /* XEmacs 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 XEmacs.
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
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
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. */
22 /* Synched up with: Not in FSF. */
24 /* Written by Ben Wing, August 1995. */
30 Lisp_Object Qrange_tablep;
31 Lisp_Object Qrange_table;
34 /************************************************************************/
35 /* Range table object */
36 /************************************************************************/
38 /* We use a sorted array of ranges.
40 #### We should be using the gap array stuff from extents.c. This
41 is not hard but just requires moving that stuff out of that file. */
44 mark_range_table (Lisp_Object obj)
46 Lisp_Range_Table *rt = XRANGE_TABLE (obj);
49 for (i = 0; i < Dynarr_length (rt->entries); i++)
50 mark_object (Dynarr_at (rt->entries, i).val);
55 print_range_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
57 Lisp_Range_Table *rt = XRANGE_TABLE (obj);
61 write_c_string ("#s(range-table data (", printcharfun);
62 for (i = 0; i < Dynarr_length (rt->entries); i++)
64 struct range_table_entry *rte = Dynarr_atp (rt->entries, i);
66 write_c_string (" ", printcharfun);
67 if (rte->first == rte->last)
68 sprintf (buf, "%ld ", (long) (rte->first));
70 sprintf (buf, "(%ld %ld) ", (long) (rte->first), (long) (rte->last));
71 write_c_string (buf, printcharfun);
72 print_internal (rte->val, printcharfun, 1);
74 write_c_string ("))", printcharfun);
78 range_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
80 Lisp_Range_Table *rt1 = XRANGE_TABLE (obj1);
81 Lisp_Range_Table *rt2 = XRANGE_TABLE (obj2);
84 if (Dynarr_length (rt1->entries) != Dynarr_length (rt2->entries))
87 for (i = 0; i < Dynarr_length (rt1->entries); i++)
89 struct range_table_entry *rte1 = Dynarr_atp (rt1->entries, i);
90 struct range_table_entry *rte2 = Dynarr_atp (rt2->entries, i);
92 if (rte1->first != rte2->first
93 || rte1->last != rte2->last
94 || !internal_equal (rte1->val, rte2->val, depth + 1))
102 range_table_entry_hash (struct range_table_entry *rte, int depth)
104 return HASH3 (rte->first, rte->last, internal_hash (rte->val, depth + 1));
108 range_table_hash (Lisp_Object obj, int depth)
110 Lisp_Range_Table *rt = XRANGE_TABLE (obj);
112 int size = Dynarr_length (rt->entries);
113 unsigned long hash = size;
115 /* approach based on internal_array_hash(). */
118 for (i = 0; i < size; i++)
120 range_table_entry_hash (Dynarr_atp (rt->entries, i),
125 /* just pick five elements scattered throughout the array.
126 A slightly better approach would be to offset by some
127 noise factor from the points chosen below. */
128 for (i = 0; i < 5; i++)
129 hash = HASH2 (hash, range_table_entry_hash (Dynarr_atp (rt->entries,
135 static const struct lrecord_description rte_description_1[] = {
136 { XD_LISP_OBJECT, offsetof (range_table_entry, val) },
140 static const struct struct_description rte_description = {
141 sizeof (range_table_entry),
145 static const struct lrecord_description rted_description_1[] = {
146 XD_DYNARR_DESC (range_table_entry_dynarr, &rte_description),
150 static const struct struct_description rted_description = {
151 sizeof (range_table_entry_dynarr),
155 static const struct lrecord_description range_table_description[] = {
156 { XD_STRUCT_PTR, offsetof (Lisp_Range_Table, entries), 1, &rted_description },
160 DEFINE_LRECORD_IMPLEMENTATION ("range-table", range_table,
161 mark_range_table, print_range_table, 0,
162 range_table_equal, range_table_hash,
163 range_table_description,
166 /************************************************************************/
167 /* Range table operations */
168 /************************************************************************/
170 #ifdef ERROR_CHECK_TYPECHECK
173 verify_range_table (Lisp_Range_Table *rt)
177 for (i = 0; i < Dynarr_length (rt->entries); i++)
179 struct range_table_entry *rte = Dynarr_atp (rt->entries, i);
180 assert (rte->last >= rte->first);
182 assert (Dynarr_at (rt->entries, i - 1).last < rte->first);
188 #define verify_range_table(rt)
192 /* Look up in a range table without the Dynarr wrapper.
193 Used also by the unified range table format. */
196 get_range_table (EMACS_INT pos, int nentries, struct range_table_entry *tab,
197 Lisp_Object default_)
199 int left = 0, right = nentries;
201 /* binary search for the entry. Based on similar code in
202 extent_list_locate(). */
203 while (left != right)
205 /* RIGHT might not point to a valid entry (i.e. it's at the end
206 of the list), so NEWPOS must round down. */
207 unsigned int newpos = (left + right) >> 1;
208 struct range_table_entry *entry = tab + newpos;
209 if (pos > entry->last)
211 else if (pos < entry->first)
220 DEFUN ("range-table-p", Frange_table_p, 1, 1, 0, /*
221 Return non-nil if OBJECT is a range table.
225 return RANGE_TABLEP (object) ? Qt : Qnil;
228 DEFUN ("make-range-table", Fmake_range_table, 0, 0, 0, /*
229 Return a new, empty range table.
230 You can manipulate it using `put-range-table', `get-range-table',
231 `remove-range-table', and `clear-range-table'.
236 Lisp_Range_Table *rt = alloc_lcrecord_type (Lisp_Range_Table,
237 &lrecord_range_table);
238 rt->entries = Dynarr_new (range_table_entry);
239 XSETRANGE_TABLE (obj, rt);
243 DEFUN ("copy-range-table", Fcopy_range_table, 1, 1, 0, /*
244 Return a new range table which is a copy of RANGE-TABLE.
245 It will contain the same values for the same ranges as RANGE-TABLE.
246 The values will not themselves be copied.
250 Lisp_Range_Table *rt, *rtnew;
253 CHECK_RANGE_TABLE (range_table);
254 rt = XRANGE_TABLE (range_table);
256 rtnew = alloc_lcrecord_type (Lisp_Range_Table, &lrecord_range_table);
257 rtnew->entries = Dynarr_new (range_table_entry);
259 Dynarr_add_many (rtnew->entries, Dynarr_atp (rt->entries, 0),
260 Dynarr_length (rt->entries));
261 XSETRANGE_TABLE (obj, rtnew);
265 DEFUN ("get-range-table", Fget_range_table, 2, 3, 0, /*
266 Find value for position POS in RANGE-TABLE.
267 If there is no corresponding value, return DEFAULT (defaults to nil).
269 (pos, range_table, default_))
271 Lisp_Range_Table *rt;
273 CHECK_RANGE_TABLE (range_table);
274 rt = XRANGE_TABLE (range_table);
276 CHECK_INT_COERCE_CHAR (pos);
278 return get_range_table (XINT (pos), Dynarr_length (rt->entries),
279 Dynarr_atp (rt->entries, 0), default_);
283 put_range_table (Lisp_Object table, EMACS_INT first,
284 EMACS_INT last, Lisp_Object val)
287 int insert_me_here = -1;
288 Lisp_Range_Table *rt = XRANGE_TABLE (table);
290 /* Now insert in the proper place. This gets tricky because
291 we may be overlapping one or more existing ranges and need
294 /* First delete all sections of any existing ranges that overlap
296 for (i = 0; i < Dynarr_length (rt->entries); i++)
298 struct range_table_entry *entry = Dynarr_atp (rt->entries, i);
299 /* We insert before the first range that begins at or after the
301 if (entry->first >= first && insert_me_here < 0)
303 if (entry->last < first)
304 /* completely before the new range. */
306 if (entry->first > last)
307 /* completely after the new range. No more possibilities of
308 finding overlapping ranges. */
310 if (entry->first < first && entry->last <= last)
318 /* truncate the end off of it. */
319 entry->last = first - 1;
321 else if (entry->first < first && entry->last > last)
328 /* need to split this one in two. */
330 struct range_table_entry insert_me_too;
332 insert_me_too.first = last + 1;
333 insert_me_too.last = entry->last;
334 insert_me_too.val = entry->val;
335 entry->last = first - 1;
336 Dynarr_insert_many (rt->entries, &insert_me_too, 1, i + 1);
338 else if (entry->last > last)
346 /* truncate the start off of it. */
347 entry->first = last + 1;
351 /* existing is entirely within new. */
352 Dynarr_delete_many (rt->entries, i, 1);
353 i--; /* back up since everything shifted one to the left. */
357 /* Someone asked us to delete the range, not insert it. */
361 /* Now insert the new entry, maybe at the end. */
363 if (insert_me_here < 0)
367 struct range_table_entry insert_me;
369 insert_me.first = first;
370 insert_me.last = last;
373 Dynarr_insert_many (rt->entries, &insert_me, 1, insert_me_here);
376 /* Now see if we can combine this entry with adjacent ones just
379 if (insert_me_here > 0)
381 struct range_table_entry *entry = Dynarr_atp (rt->entries,
383 if (EQ (val, entry->val) && entry->last == first - 1)
386 Dynarr_delete_many (rt->entries, insert_me_here, 1);
388 /* We have morphed into a larger range. Update our records
389 in case we also combine with the one after. */
390 first = entry->first;
394 if (insert_me_here < Dynarr_length (rt->entries) - 1)
396 struct range_table_entry *entry = Dynarr_atp (rt->entries,
398 if (EQ (val, entry->val) && entry->first == last + 1)
400 entry->first = first;
401 Dynarr_delete_many (rt->entries, insert_me_here, 1);
406 DEFUN ("put-range-table", Fput_range_table, 4, 4, 0, /*
407 Set the value for range (START, END) to be VALUE in RANGE-TABLE.
409 (start, end, value, range_table))
411 EMACS_INT first, last;
413 CHECK_RANGE_TABLE (range_table);
414 CHECK_INT_COERCE_CHAR (start);
415 first = XINT (start);
416 CHECK_INT_COERCE_CHAR (end);
419 signal_simple_error_2 ("start must be <= end", start, end);
421 put_range_table (range_table, first, last, value);
422 verify_range_table (XRANGE_TABLE (range_table));
426 DEFUN ("remove-range-table", Fremove_range_table, 3, 3, 0, /*
427 Remove the value for range (START, END) in RANGE-TABLE.
429 (start, end, range_table))
431 return Fput_range_table (start, end, Qunbound, range_table);
434 DEFUN ("clear-range-table", Fclear_range_table, 1, 1, 0, /*
439 CHECK_RANGE_TABLE (range_table);
440 Dynarr_reset (XRANGE_TABLE (range_table)->entries);
444 DEFUN ("map-range-table", Fmap_range_table, 2, 2, 0, /*
445 Map FUNCTION over entries in RANGE-TABLE, calling it with three args,
446 the beginning and end of the range and the corresponding value.
448 Results are guaranteed to be correct (i.e. each entry processed
449 exactly once) if FUNCTION modifies or deletes the current entry
450 \(i.e. passes the current range to `put-range-table' or
451 `remove-range-table'), but not otherwise.
453 (function, range_table))
455 Lisp_Range_Table *rt;
458 CHECK_RANGE_TABLE (range_table);
459 CHECK_FUNCTION (function);
461 rt = XRANGE_TABLE (range_table);
463 /* Do not "optimize" by pulling out the length computation below!
464 FUNCTION may have changed the table. */
465 for (i = 0; i < Dynarr_length (rt->entries); i++)
467 struct range_table_entry *entry = Dynarr_atp (rt->entries, i);
468 EMACS_INT first, last;
473 first = entry->first;
475 oldlen = Dynarr_length (rt->entries);
477 args[1] = make_int (first);
478 args[2] = make_int (last);
479 args[3] = entry->val;
480 Ffuncall (countof (args), args);
481 /* Has FUNCTION removed the entry? */
482 if (oldlen > Dynarr_length (rt->entries)
483 && i < Dynarr_length (rt->entries)
484 && (first != entry->first || last != entry->last))
492 /************************************************************************/
493 /* Range table read syntax */
494 /************************************************************************/
497 rangetab_data_validate (Lisp_Object keyword, Lisp_Object value,
502 /* #### should deal with errb */
503 EXTERNAL_LIST_LOOP (rest, value)
505 Lisp_Object range = XCAR (rest);
508 signal_simple_error ("Invalid list format", value);
509 if (!INTP (range) && !CHARP (range)
510 && !(CONSP (range) && CONSP (XCDR (range))
511 && NILP (XCDR (XCDR (range)))
512 && (INTP (XCAR (range)) || CHARP (XCAR (range)))
513 && (INTP (XCAR (XCDR (range))) || CHARP (XCAR (XCDR (range))))))
514 signal_simple_error ("Invalid range format", range);
521 rangetab_instantiate (Lisp_Object data)
523 Lisp_Object rangetab = Fmake_range_table ();
527 data = Fcar (Fcdr (data)); /* skip over 'data keyword */
530 Lisp_Object range = Fcar (data);
531 Lisp_Object val = Fcar (Fcdr (data));
533 data = Fcdr (Fcdr (data));
535 Fput_range_table (Fcar (range), Fcar (Fcdr (range)), val,
538 Fput_range_table (range, range, val, rangetab);
546 /************************************************************************/
547 /* Unified range tables */
548 /************************************************************************/
550 /* A "unified range table" is a format for storing range tables
551 as contiguous blocks of memory. This is used by the regexp
552 code, which needs to use range tables to properly handle []
553 constructs in the presence of extended characters but wants to
554 store an entire compiled pattern as a contiguous block of memory.
556 Unified range tables are designed so that they can be placed
557 at an arbitrary (possibly mis-aligned) place in memory.
558 (Dealing with alignment is a pain in the ass.)
560 WARNING: No provisions for garbage collection are currently made.
561 This means that there must not be any Lisp objects in a unified
562 range table that need to be marked for garbage collection.
563 Good candidates for objects that can go into a range table are
565 -- numbers and characters (do not need to be marked)
566 -- nil, t (marked elsewhere)
567 -- charsets and coding systems (automatically marked because
568 they are in a marked list,
569 and can't be removed)
571 Good but slightly less so:
573 -- symbols (could be uninterned, but that is not likely)
577 -- buffers, frames, devices (could get deleted)
580 It is expected that you work with range tables in the normal
581 format and then convert to unified format when you are done
582 making modifications. As such, no functions are provided
583 for modifying a unified range table. The only operations
584 you can do to unified range tables are
587 -- retrieve all the ranges in an iterative fashion
591 /* The format of a unified range table is as follows:
593 -- The first byte contains the number of bytes to skip to find the
594 actual start of the table. This deals with alignment constraints,
595 since the table might want to go at any arbitrary place in memory.
596 -- The next three bytes contain the number of bytes to skip (from the
597 *first* byte) to find the stuff after the table. It's stored in
598 little-endian format because that's how God intended things. We don't
599 necessarily start the stuff at the very end of the table because
600 we want to have at least ALIGNOF (EMACS_INT) extra space in case
601 we have to move the range table around. (It appears that some
602 architectures don't maintain alignment when reallocing.)
603 -- At the prescribed offset is a struct unified_range_table, containing
604 some number of `struct range_table_entry' entries. */
606 struct unified_range_table
609 struct range_table_entry first;
612 /* Return size in bytes needed to store the data in a range table. */
615 unified_range_table_bytes_needed (Lisp_Object rangetab)
617 return (sizeof (struct range_table_entry) *
618 (Dynarr_length (XRANGE_TABLE (rangetab)->entries) - 1) +
619 sizeof (struct unified_range_table) +
620 /* ALIGNOF a struct may be too big. */
621 /* We have four bytes for the size numbers, and an extra
622 four or eight bytes for making sure we get the alignment
624 ALIGNOF (EMACS_INT) + 4);
627 /* Convert a range table into unified format and store in DEST,
628 which must be able to hold the number of bytes returned by
629 range_table_bytes_needed(). */
632 unified_range_table_copy_data (Lisp_Object rangetab, void *dest)
634 /* We cast to the above structure rather than just casting to
635 char * and adding sizeof(int), because that will lead to
636 mis-aligned data on the Alpha machines. */
637 struct unified_range_table *un;
638 range_table_entry_dynarr *rted = XRANGE_TABLE (rangetab)->entries;
639 int total_needed = unified_range_table_bytes_needed (rangetab);
640 void *new_dest = ALIGN_PTR ((char *) dest + 4, ALIGNOF (EMACS_INT));
642 * (char *) dest = (char) ((char *) new_dest - (char *) dest);
643 * ((unsigned char *) dest + 1) = total_needed & 0xFF;
645 * ((unsigned char *) dest + 2) = total_needed & 0xFF;
647 * ((unsigned char *) dest + 3) = total_needed & 0xFF;
648 un = (struct unified_range_table *) new_dest;
649 un->nentries = Dynarr_length (rted);
650 memcpy (&un->first, Dynarr_atp (rted, 0),
651 sizeof (struct range_table_entry) * Dynarr_length (rted));
654 /* Return number of bytes actually used by a unified range table. */
657 unified_range_table_bytes_used (void *unrangetab)
659 return ((* ((unsigned char *) unrangetab + 1))
660 + ((* ((unsigned char *) unrangetab + 2)) << 8)
661 + ((* ((unsigned char *) unrangetab + 3)) << 16));
664 /* Make sure the table is aligned, and move it around if it's not. */
666 align_the_damn_table (void *unrangetab)
668 void *cur_dest = (char *) unrangetab + * (char *) unrangetab;
670 if ((((long) cur_dest) & 7) != 0)
672 if ((((int) cur_dest) & 3) != 0)
675 int count = (unified_range_table_bytes_used (unrangetab) - 4
676 - ALIGNOF (EMACS_INT));
677 /* Find the proper location, just like above. */
678 void *new_dest = ALIGN_PTR ((char *) unrangetab + 4,
679 ALIGNOF (EMACS_INT));
680 /* memmove() works in the presence of overlapping data. */
681 memmove (new_dest, cur_dest, count);
682 * (char *) unrangetab = (char) ((char *) new_dest - (char *) unrangetab);
686 /* Look up a value in a unified range table. */
689 unified_range_table_lookup (void *unrangetab, EMACS_INT pos,
690 Lisp_Object default_)
693 struct unified_range_table *un;
695 align_the_damn_table (unrangetab);
696 new_dest = (char *) unrangetab + * (char *) unrangetab;
697 un = (struct unified_range_table *) new_dest;
699 return get_range_table (pos, un->nentries, &un->first, default_);
702 /* Return number of entries in a unified range table. */
705 unified_range_table_nentries (void *unrangetab)
708 struct unified_range_table *un;
710 align_the_damn_table (unrangetab);
711 new_dest = (char *) unrangetab + * (char *) unrangetab;
712 un = (struct unified_range_table *) new_dest;
716 /* Return the OFFSETth range (counting from 0) in UNRANGETAB. */
718 unified_range_table_get_range (void *unrangetab, int offset,
719 EMACS_INT *min, EMACS_INT *max,
723 struct unified_range_table *un;
724 struct range_table_entry *tab;
726 align_the_damn_table (unrangetab);
727 new_dest = (char *) unrangetab + * (char *) unrangetab;
728 un = (struct unified_range_table *) new_dest;
730 assert (offset >= 0 && offset < un->nentries);
731 tab = (&un->first) + offset;
738 /************************************************************************/
740 /************************************************************************/
743 syms_of_rangetab (void)
745 INIT_LRECORD_IMPLEMENTATION (range_table);
747 defsymbol (&Qrange_tablep, "range-table-p");
748 defsymbol (&Qrange_table, "range-table");
750 DEFSUBR (Frange_table_p);
751 DEFSUBR (Fmake_range_table);
752 DEFSUBR (Fcopy_range_table);
753 DEFSUBR (Fget_range_table);
754 DEFSUBR (Fput_range_table);
755 DEFSUBR (Fremove_range_table);
756 DEFSUBR (Fclear_range_table);
757 DEFSUBR (Fmap_range_table);
761 structure_type_create_rangetab (void)
763 struct structure_type *st;
765 st = define_structure_type (Qrange_table, 0, rangetab_instantiate);
767 define_structure_type_keyword (st, Qdata, rangetab_data_validate);