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