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