Mercurial > hg > xemacs-beta
annotate src/rangetab.c @ 4967:0d4c9d0f6a8d
rewrite dynarr code
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-02-03 Ben Wing <ben@xemacs.org>
* device-x.c (x_get_resource_prefix):
* device-x.c (Fx_get_resource):
* device-x.c (Fx_get_resource_prefix):
* device-x.c (Fx_put_resource):
* dialog-msw.c:
* dialog-msw.c (handle_question_dialog_box):
* dired-msw.c (mswindows_sort_files):
* dired-msw.c (mswindows_get_files):
* extents.c (extent_fragment_sort_by_priority):
* extents.c (Fset_extent_parent):
* file-coding.c (coding_reader):
* file-coding.c (coding_writer):
* file-coding.c (gzip_convert):
* frame.c (generate_title_string):
* gutter.c (calculate_gutter_size_from_display_lines):
* indent.c (vmotion_1):
* lread.c (read_bit_vector):
* mule-coding.c (iso2022_decode):
* rangetab.c:
* rangetab.c (Fcopy_range_table):
* rangetab.c (Fget_range_table):
* rangetab.c (unified_range_table_copy_data):
* redisplay-msw.c (mswindows_output_string):
* redisplay-output.c (output_display_line):
* redisplay-output.c (redisplay_move_cursor):
* redisplay-output.c (redisplay_clear_bottom_of_window):
* redisplay-tty.c (tty_output_ichar_dynarr):
* redisplay-tty.c (set_foreground_to):
* redisplay-tty.c (set_background_to):
* redisplay-xlike-inc.c (XLIKE_output_string):
* redisplay.c (redisplay_window_text_width_string):
* redisplay.c (redisplay_text_width_string):
* redisplay.c (create_text_block):
* redisplay.c (SET_CURRENT_MODE_CHARS_PIXSIZE):
* redisplay.c (generate_fstring_runes):
* redisplay.c (regenerate_modeline):
* redisplay.c (ensure_modeline_generated):
* redisplay.c (real_current_modeline_height):
* redisplay.c (create_string_text_block):
* redisplay.c (regenerate_window):
* redisplay.c (REGEN_INC_FIND_START_END):
* redisplay.c (point_visible):
* redisplay.c (redisplay_window):
* redisplay.c (mark_glyph_block_dynarr):
* redisplay.c (line_start_cache_start):
* redisplay.c (start_with_line_at_pixpos):
* redisplay.c (update_line_start_cache):
* redisplay.c (glyph_to_pixel_translation):
* redisplay.c (pixel_to_glyph_translation):
* sysdep.c (qxe_readdir):
* text.c (dfc_convert_to_external_format):
* text.c (dfc_convert_to_internal_format):
* toolbar-common.c (common_output_toolbar_button):
* window.c (window_modeline_height):
* window.c (Fwindow_last_line_visible_height):
* window.c (window_displayed_height):
* window.c (window_scroll):
* window.c (get_current_pixel_pos):
Use Dynarr_begin() in place of Dynarr_atp (foo, 0).
* dynarr.c (Dynarr_realloc):
* dynarr.c (Dynarr_lisp_realloc):
* dynarr.c (Dynarr_resize):
* dynarr.c (Dynarr_insert_many):
* dynarr.c (Dynarr_delete_many):
* dynarr.c (Dynarr_memory_usage):
* dynarr.c (stack_like_malloc):
* dynarr.c (stack_like_free):
* lisp.h:
* lisp.h (DECLARE_DYNARR_LISP_IMP):
* lisp.h (XD_DYNARR_DESC):
* lisp.h (Dynarr_pop):
* gutter.c (output_gutter):
* redisplay-output.c (sync_rune_structs):
* redisplay-output.c (redisplay_output_window):
Redo the dynarr code, add greater checks.
Rename the `len', `largest' and `max' members to `len_',
`largest_' and `max_' to try and catch existing places that might
directly modify these values. Make new accessors Dynarr_largest()
and Dynarr_max() and make them and existing Dynarr_length() be
non-lvalues by adding '+ 0' to them; fix a couple of places in the
redisplay code that tried to modify the length directly by setting
Dynarr_length(). Use the accessors whenever possible even in the
dynarr code itself. The accessors also verify that 0 <= len <=
largest <= max. Rename settor function Dynarr_set_size() to
Dynarr_set_length() and use it more consistently; also create
lower-level Dynarr_set_length_1(). This latter function should be
the only function that directly modifies the `len_' member of a
Dynarr, and in the process makes sure that the `largest' value is
kept correct.
Consistently use ERROR_CHECK_STRUCTURES instead of
ERROR_CHECK_TYPES for error-checking code. Reintroduce the
temporarily disabled verification code on the positions of
Dynarr_at(), Dynarr_atp() and Dynarr_atp_past_end().
Also create Dynarr_resize_if() in place of a repeated
code fragment. Clean up all the functions that modify Dynarrs to
use the new macros and functions and verify the correctness of the
Dynarr both before and after the change.
Note that there are two kinds of verification -- one for accessing
and one for modifying. The difference is that the modify
verification additionally checks to make sure that the Dynarr
isn't locked. (This is used in redisplay to check for problems
with reentrancy.)
* lrecord.h: Move XD_DYNARR_DESC to lisp.h, grouping with the dynarr code.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Wed, 03 Feb 2010 20:51:18 -0600 |
| parents | e813cf16c015 |
| children | b5df3737028a |
| 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 | |
| 93 for (i = 0; i < Dynarr_length (rt->entries); i++) | |
| 94 mark_object (Dynarr_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) |
| 107 write_fmt_string_lisp (printcharfun, "#s(range-table type %s data (", | |
| 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 "); |
| 428 | 111 for (i = 0; i < Dynarr_length (rt->entries); i++) |
| 112 { | |
| 113 struct range_table_entry *rte = Dynarr_atp (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 ? '(' : '[', | |
| 127 (long) (rte->first - so), | |
| 128 (long) (rte->last - ec), | |
| 129 print_readably ? ')' : ec ? ']' : ')' | |
| 130 ); | |
| 428 | 131 print_internal (rte->val, printcharfun, 1); |
| 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 |
| 136 write_fmt_string (printcharfun, " 0x%x>", rt->header.uid); | |
| 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 | |
| 146 if (Dynarr_length (rt1->entries) != Dynarr_length (rt2->entries)) | |
| 147 return 0; | |
| 148 | |
| 149 for (i = 0; i < Dynarr_length (rt1->entries); i++) | |
| 150 { | |
| 151 struct range_table_entry *rte1 = Dynarr_atp (rt1->entries, i); | |
| 152 struct range_table_entry *rte2 = Dynarr_atp (rt2->entries, i); | |
| 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 |
| 428 | 164 range_table_entry_hash (struct range_table_entry *rte, int depth) |
| 165 { | |
| 166 return HASH3 (rte->first, rte->last, internal_hash (rte->val, depth + 1)); | |
| 167 } | |
| 168 | |
| 2515 | 169 static Hashcode |
| 428 | 170 range_table_hash (Lisp_Object obj, int depth) |
| 171 { | |
| 440 | 172 Lisp_Range_Table *rt = XRANGE_TABLE (obj); |
| 428 | 173 int i; |
| 174 int size = Dynarr_length (rt->entries); | |
| 2515 | 175 Hashcode hash = size; |
| 428 | 176 |
| 177 /* approach based on internal_array_hash(). */ | |
| 178 if (size <= 5) | |
| 179 { | |
| 180 for (i = 0; i < size; i++) | |
| 181 hash = HASH2 (hash, | |
| 182 range_table_entry_hash (Dynarr_atp (rt->entries, i), | |
| 183 depth)); | |
| 184 return hash; | |
| 185 } | |
| 186 | |
| 187 /* just pick five elements scattered throughout the array. | |
| 188 A slightly better approach would be to offset by some | |
| 189 noise factor from the points chosen below. */ | |
| 190 for (i = 0; i < 5; i++) | |
| 191 hash = HASH2 (hash, range_table_entry_hash (Dynarr_atp (rt->entries, | |
| 192 i*size/5), | |
| 193 depth)); | |
| 194 return hash; | |
| 195 } | |
| 196 | |
| 1204 | 197 static const struct memory_description rte_description_1[] = { |
| 440 | 198 { XD_LISP_OBJECT, offsetof (range_table_entry, val) }, |
| 428 | 199 { XD_END } |
| 200 }; | |
| 201 | |
| 1204 | 202 static const struct sized_memory_description rte_description = { |
| 440 | 203 sizeof (range_table_entry), |
| 428 | 204 rte_description_1 |
| 205 }; | |
| 206 | |
| 1204 | 207 static const struct memory_description rted_description_1[] = { |
| 440 | 208 XD_DYNARR_DESC (range_table_entry_dynarr, &rte_description), |
| 428 | 209 { XD_END } |
| 210 }; | |
| 211 | |
| 1204 | 212 static const struct sized_memory_description rted_description = { |
| 440 | 213 sizeof (range_table_entry_dynarr), |
| 428 | 214 rted_description_1 |
| 215 }; | |
| 216 | |
| 1204 | 217 static const struct memory_description range_table_description[] = { |
| 2551 | 218 { XD_BLOCK_PTR, offsetof (Lisp_Range_Table, entries), 1, |
| 219 { &rted_description } }, | |
| 428 | 220 { XD_END } |
| 221 }; | |
| 222 | |
| 934 | 223 DEFINE_LRECORD_IMPLEMENTATION ("range-table", range_table, |
| 224 1, /*dumpable-flag*/ | |
| 225 mark_range_table, print_range_table, 0, | |
| 226 range_table_equal, range_table_hash, | |
| 227 range_table_description, | |
| 228 Lisp_Range_Table); | |
| 428 | 229 |
| 230 /************************************************************************/ | |
| 231 /* Range table operations */ | |
| 232 /************************************************************************/ | |
| 233 | |
| 800 | 234 #ifdef ERROR_CHECK_STRUCTURES |
| 428 | 235 |
| 236 static void | |
| 440 | 237 verify_range_table (Lisp_Range_Table *rt) |
| 428 | 238 { |
| 239 int i; | |
| 240 | |
| 241 for (i = 0; i < Dynarr_length (rt->entries); i++) | |
| 242 { | |
| 243 struct range_table_entry *rte = Dynarr_atp (rt->entries, i); | |
| 244 assert (rte->last >= rte->first); | |
| 245 if (i > 0) | |
| 2421 | 246 assert (Dynarr_at (rt->entries, i - 1).last <= rte->first); |
| 428 | 247 } |
| 248 } | |
| 249 | |
| 250 #else | |
| 251 | |
| 252 #define verify_range_table(rt) | |
| 253 | |
| 254 #endif | |
| 255 | |
| 256 /* Look up in a range table without the Dynarr wrapper. | |
| 257 Used also by the unified range table format. */ | |
| 258 | |
| 259 static Lisp_Object | |
| 260 get_range_table (EMACS_INT pos, int nentries, struct range_table_entry *tab, | |
| 261 Lisp_Object default_) | |
| 262 { | |
| 263 int left = 0, right = nentries; | |
| 264 | |
| 265 /* binary search for the entry. Based on similar code in | |
| 266 extent_list_locate(). */ | |
| 267 while (left != right) | |
| 268 { | |
| 269 /* RIGHT might not point to a valid entry (i.e. it's at the end | |
| 270 of the list), so NEWPOS must round down. */ | |
| 647 | 271 int newpos = (left + right) >> 1; |
| 428 | 272 struct range_table_entry *entry = tab + newpos; |
| 2421 | 273 if (pos >= entry->last) |
| 274 left = newpos + 1; | |
| 428 | 275 else if (pos < entry->first) |
| 276 right = newpos; | |
| 277 else | |
| 278 return entry->val; | |
| 279 } | |
| 280 | |
| 281 return default_; | |
| 282 } | |
| 283 | |
| 284 DEFUN ("range-table-p", Frange_table_p, 1, 1, 0, /* | |
| 285 Return non-nil if OBJECT is a range table. | |
| 286 */ | |
| 287 (object)) | |
| 288 { | |
| 289 return RANGE_TABLEP (object) ? Qt : Qnil; | |
| 290 } | |
| 291 | |
| 2421 | 292 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
|
293 Return the type of RANGE-TABLE. |
|
312503644bc3
Correct the docstring for #'range-table-type.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4690
diff
changeset
|
294 |
|
312503644bc3
Correct the docstring for #'range-table-type.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4690
diff
changeset
|
295 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
|
296 ends; see `make-range-table'. |
| 2421 | 297 */ |
| 298 (range_table)) | |
| 299 { | |
| 300 CHECK_RANGE_TABLE (range_table); | |
| 301 return range_table_type_to_symbol (XRANGE_TABLE (range_table)->type); | |
| 302 } | |
| 303 | |
| 304 DEFUN ("make-range-table", Fmake_range_table, 0, 1, 0, /* | |
| 428 | 305 Return a new, empty range table. |
| 306 You can manipulate it using `put-range-table', `get-range-table', | |
| 307 `remove-range-table', and `clear-range-table'. | |
| 2421 | 308 Range tables allow you to efficiently set values for ranges of integers. |
| 309 | |
| 310 TYPE is a symbol indicating how ranges are assumed to function at their | |
| 311 ends. It can be one of | |
| 312 | |
| 313 SYMBOL RANGE-START RANGE-END | |
| 314 ------ ----------- --------- | |
| 315 `start-closed-end-open' (the default) closed open | |
| 316 `start-closed-end-closed' closed closed | |
| 317 `start-open-end-open' open open | |
| 318 `start-open-end-closed' open closed | |
| 319 | |
| 320 A `closed' endpoint of a range means that the number at that end is included | |
| 321 in the range. For an `open' endpoint, the number would not be included. | |
| 322 | |
| 323 For example, a closed-open range from 5 to 20 would be indicated as [5, | |
| 324 20) where a bracket indicates a closed end and a parenthesis an open end, | |
| 325 and would mean `all the numbers between 5 and 20', including 5 but not 20. | |
| 326 This seems a little strange at first but is in fact extremely common in | |
| 327 the outside world as well as in computers and makes things work sensibly. | |
| 328 For example, if I say "there are seven days between today and next week | |
| 329 today", I'm including today but not next week today; if I included both, | |
| 330 there would be eight days. Similarly, there are 15 (= 20 - 5) elements in | |
| 331 the range [5, 20), but 16 in the range [5, 20]. | |
| 428 | 332 */ |
| 2421 | 333 (type)) |
| 428 | 334 { |
| 3017 | 335 Lisp_Range_Table *rt = ALLOC_LCRECORD_TYPE (Lisp_Range_Table, |
| 440 | 336 &lrecord_range_table); |
| 428 | 337 rt->entries = Dynarr_new (range_table_entry); |
| 2421 | 338 rt->type = range_table_symbol_to_type (type); |
| 793 | 339 return wrap_range_table (rt); |
| 428 | 340 } |
| 341 | |
| 342 DEFUN ("copy-range-table", Fcopy_range_table, 1, 1, 0, /* | |
| 444 | 343 Return a new range table which is a copy of RANGE-TABLE. |
| 344 It will contain the same values for the same ranges as RANGE-TABLE. | |
| 345 The values will not themselves be copied. | |
| 428 | 346 */ |
| 444 | 347 (range_table)) |
| 428 | 348 { |
| 440 | 349 Lisp_Range_Table *rt, *rtnew; |
| 428 | 350 |
| 444 | 351 CHECK_RANGE_TABLE (range_table); |
| 352 rt = XRANGE_TABLE (range_table); | |
| 428 | 353 |
| 3017 | 354 rtnew = ALLOC_LCRECORD_TYPE (Lisp_Range_Table, &lrecord_range_table); |
| 428 | 355 rtnew->entries = Dynarr_new (range_table_entry); |
| 2421 | 356 rtnew->type = rt->type; |
| 428 | 357 |
| 4967 | 358 Dynarr_add_many (rtnew->entries, Dynarr_begin (rt->entries), |
| 428 | 359 Dynarr_length (rt->entries)); |
| 793 | 360 return wrap_range_table (rtnew); |
| 428 | 361 } |
| 362 | |
| 363 DEFUN ("get-range-table", Fget_range_table, 2, 3, 0, /* | |
| 444 | 364 Find value for position POS in RANGE-TABLE. |
| 428 | 365 If there is no corresponding value, return DEFAULT (defaults to nil). |
| 366 */ | |
| 444 | 367 (pos, range_table, default_)) |
| 428 | 368 { |
| 440 | 369 Lisp_Range_Table *rt; |
| 428 | 370 |
| 444 | 371 CHECK_RANGE_TABLE (range_table); |
| 372 rt = XRANGE_TABLE (range_table); | |
| 428 | 373 |
| 374 CHECK_INT_COERCE_CHAR (pos); | |
| 375 | |
| 376 return get_range_table (XINT (pos), Dynarr_length (rt->entries), | |
| 4967 | 377 Dynarr_begin (rt->entries), default_); |
| 428 | 378 } |
| 379 | |
|
4831
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
380 static void |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
381 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
|
382 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
|
383 { |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
384 /* 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
|
385 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
|
386 switch (type) |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
387 { |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
388 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
|
389 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
|
390 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
|
391 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
|
392 } |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
393 } |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
394 |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
395 static void |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
396 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
|
397 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
|
398 { |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
399 /* 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
|
400 */ |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
401 switch (type) |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
402 { |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
403 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
|
404 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
|
405 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
|
406 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
|
407 } |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
408 } |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
409 |
| 428 | 410 void |
| 411 put_range_table (Lisp_Object table, EMACS_INT first, | |
| 412 EMACS_INT last, Lisp_Object val) | |
| 413 { | |
| 414 int i; | |
| 415 int insert_me_here = -1; | |
| 440 | 416 Lisp_Range_Table *rt = XRANGE_TABLE (table); |
| 428 | 417 |
|
4831
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
418 external_to_internal_adjust_ends (rt->type, &first, &last); |
| 2421 | 419 if (first == last) |
| 420 return; | |
| 421 if (first > last) | |
| 422 /* This will happen if originally first == last and both ends are | |
| 423 open. #### Should we signal an error? */ | |
| 424 return; | |
| 425 | |
| 428 | 426 /* Now insert in the proper place. This gets tricky because |
| 427 we may be overlapping one or more existing ranges and need | |
| 428 to fix them up. */ | |
| 429 | |
| 430 /* First delete all sections of any existing ranges that overlap | |
| 431 the new range. */ | |
| 432 for (i = 0; i < Dynarr_length (rt->entries); i++) | |
| 433 { | |
| 434 struct range_table_entry *entry = Dynarr_atp (rt->entries, i); | |
| 435 /* We insert before the first range that begins at or after the | |
| 436 new range. */ | |
| 437 if (entry->first >= first && insert_me_here < 0) | |
| 438 insert_me_here = i; | |
| 439 if (entry->last < first) | |
| 440 /* completely before the new range. */ | |
| 441 continue; | |
| 442 if (entry->first > last) | |
| 443 /* completely after the new range. No more possibilities of | |
| 444 finding overlapping ranges. */ | |
| 445 break; | |
| 2421 | 446 /* At this point the existing ENTRY overlaps or touches the new one. */ |
| 428 | 447 if (entry->first < first && entry->last <= last) |
| 448 { | |
| 449 /* looks like: | |
| 450 | |
| 2421 | 451 [ NEW ) |
| 452 [ EXISTING ) | |
| 453 | |
| 454 or | |
| 455 | |
| 456 [ NEW ) | |
| 457 [ EXISTING ) | |
| 428 | 458 |
| 459 */ | |
| 460 /* truncate the end off of it. */ | |
| 2421 | 461 entry->last = first; |
| 428 | 462 } |
| 463 else if (entry->first < first && entry->last > last) | |
| 464 /* looks like: | |
| 465 | |
| 2421 | 466 [ NEW ) |
| 467 [ EXISTING ) | |
| 428 | 468 |
| 469 */ | |
| 470 /* need to split this one in two. */ | |
| 471 { | |
| 472 struct range_table_entry insert_me_too; | |
| 473 | |
| 2421 | 474 insert_me_too.first = last; |
| 428 | 475 insert_me_too.last = entry->last; |
| 476 insert_me_too.val = entry->val; | |
| 2421 | 477 entry->last = first; |
| 428 | 478 Dynarr_insert_many (rt->entries, &insert_me_too, 1, i + 1); |
| 479 } | |
| 2421 | 480 else if (entry->last >= last) |
| 428 | 481 { |
| 482 /* looks like: | |
| 483 | |
| 2421 | 484 [ NEW ) |
| 485 [ EXISTING ) | |
| 486 | |
| 487 or | |
| 488 | |
| 489 [ NEW ) | |
| 490 [ EXISTING ) | |
| 428 | 491 |
| 492 */ | |
| 493 /* truncate the start off of it. */ | |
| 2421 | 494 entry->first = last; |
| 428 | 495 } |
| 496 else | |
| 497 { | |
| 498 /* existing is entirely within new. */ | |
| 499 Dynarr_delete_many (rt->entries, i, 1); | |
| 500 i--; /* back up since everything shifted one to the left. */ | |
| 501 } | |
| 502 } | |
| 503 | |
| 504 /* Someone asked us to delete the range, not insert it. */ | |
| 505 if (UNBOUNDP (val)) | |
| 506 return; | |
| 507 | |
| 508 /* Now insert the new entry, maybe at the end. */ | |
| 509 | |
| 510 if (insert_me_here < 0) | |
| 511 insert_me_here = i; | |
| 512 | |
| 513 { | |
| 514 struct range_table_entry insert_me; | |
| 515 | |
| 516 insert_me.first = first; | |
| 517 insert_me.last = last; | |
| 518 insert_me.val = val; | |
| 519 | |
| 520 Dynarr_insert_many (rt->entries, &insert_me, 1, insert_me_here); | |
| 521 } | |
| 522 | |
| 523 /* Now see if we can combine this entry with adjacent ones just | |
| 524 before or after. */ | |
| 525 | |
| 526 if (insert_me_here > 0) | |
| 527 { | |
| 528 struct range_table_entry *entry = Dynarr_atp (rt->entries, | |
| 529 insert_me_here - 1); | |
| 2421 | 530 if (EQ (val, entry->val) && entry->last == first) |
| 428 | 531 { |
| 532 entry->last = last; | |
| 533 Dynarr_delete_many (rt->entries, insert_me_here, 1); | |
| 534 insert_me_here--; | |
| 535 /* We have morphed into a larger range. Update our records | |
| 536 in case we also combine with the one after. */ | |
| 537 first = entry->first; | |
| 538 } | |
| 539 } | |
| 540 | |
| 541 if (insert_me_here < Dynarr_length (rt->entries) - 1) | |
| 542 { | |
| 543 struct range_table_entry *entry = Dynarr_atp (rt->entries, | |
| 544 insert_me_here + 1); | |
| 2421 | 545 if (EQ (val, entry->val) && entry->first == last) |
| 428 | 546 { |
| 547 entry->first = first; | |
| 548 Dynarr_delete_many (rt->entries, insert_me_here, 1); | |
| 549 } | |
| 550 } | |
| 551 } | |
| 552 | |
| 553 DEFUN ("put-range-table", Fput_range_table, 4, 4, 0, /* | |
| 2421 | 554 Set the value for range START .. END to be VALUE in RANGE-TABLE. |
| 428 | 555 */ |
| 444 | 556 (start, end, value, range_table)) |
| 428 | 557 { |
| 558 EMACS_INT first, last; | |
| 559 | |
| 444 | 560 CHECK_RANGE_TABLE (range_table); |
| 428 | 561 CHECK_INT_COERCE_CHAR (start); |
| 562 first = XINT (start); | |
| 563 CHECK_INT_COERCE_CHAR (end); | |
| 564 last = XINT (end); | |
| 565 if (first > last) | |
| 563 | 566 invalid_argument_2 ("start must be <= end", start, end); |
| 428 | 567 |
| 444 | 568 put_range_table (range_table, first, last, value); |
| 569 verify_range_table (XRANGE_TABLE (range_table)); | |
| 428 | 570 return Qnil; |
| 571 } | |
| 572 | |
| 573 DEFUN ("remove-range-table", Fremove_range_table, 3, 3, 0, /* | |
| 2421 | 574 Remove the value for range START .. END in RANGE-TABLE. |
| 428 | 575 */ |
| 444 | 576 (start, end, range_table)) |
| 428 | 577 { |
| 444 | 578 return Fput_range_table (start, end, Qunbound, range_table); |
| 428 | 579 } |
| 580 | |
| 581 DEFUN ("clear-range-table", Fclear_range_table, 1, 1, 0, /* | |
| 444 | 582 Flush RANGE-TABLE. |
| 428 | 583 */ |
| 444 | 584 (range_table)) |
| 428 | 585 { |
| 444 | 586 CHECK_RANGE_TABLE (range_table); |
| 587 Dynarr_reset (XRANGE_TABLE (range_table)->entries); | |
| 428 | 588 return Qnil; |
| 589 } | |
| 590 | |
| 591 DEFUN ("map-range-table", Fmap_range_table, 2, 2, 0, /* | |
| 444 | 592 Map FUNCTION over entries in RANGE-TABLE, calling it with three args, |
| 428 | 593 the beginning and end of the range and the corresponding value. |
| 442 | 594 |
| 595 Results are guaranteed to be correct (i.e. each entry processed | |
| 596 exactly once) if FUNCTION modifies or deletes the current entry | |
| 444 | 597 \(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
|
598 `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
|
599 this guarantee doesn't hold. |
| 428 | 600 */ |
| 444 | 601 (function, range_table)) |
| 428 | 602 { |
| 442 | 603 Lisp_Range_Table *rt; |
| 604 int i; | |
| 605 | |
| 444 | 606 CHECK_RANGE_TABLE (range_table); |
| 442 | 607 CHECK_FUNCTION (function); |
| 608 | |
| 444 | 609 rt = XRANGE_TABLE (range_table); |
| 442 | 610 |
| 611 /* Do not "optimize" by pulling out the length computation below! | |
| 612 FUNCTION may have changed the table. */ | |
| 613 for (i = 0; i < Dynarr_length (rt->entries); i++) | |
| 614 { | |
| 615 struct range_table_entry *entry = Dynarr_atp (rt->entries, i); | |
| 616 EMACS_INT first, last; | |
| 617 Lisp_Object args[4]; | |
| 618 int oldlen; | |
| 619 | |
| 620 again: | |
| 621 first = entry->first; | |
| 622 last = entry->last; | |
| 623 oldlen = Dynarr_length (rt->entries); | |
| 624 args[0] = function; | |
| 2952 | 625 /* Fix up the numbers in accordance with the open/closedness of the |
| 626 table. */ | |
| 627 { | |
| 628 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
|
629 internal_to_external_adjust_ends (rt->type, &premier, &dernier); |
| 2952 | 630 args[1] = make_int (premier); |
| 631 args[2] = make_int (dernier); | |
| 632 } | |
| 442 | 633 args[3] = entry->val; |
| 634 Ffuncall (countof (args), args); | |
| 635 /* Has FUNCTION removed the entry? */ | |
| 636 if (oldlen > Dynarr_length (rt->entries) | |
| 637 && i < Dynarr_length (rt->entries) | |
| 638 && (first != entry->first || last != entry->last)) | |
| 639 goto again; | |
| 640 } | |
| 641 | |
| 428 | 642 return Qnil; |
| 643 } | |
| 644 | |
| 645 | |
| 646 /************************************************************************/ | |
| 647 /* Range table read syntax */ | |
| 648 /************************************************************************/ | |
| 649 | |
| 650 static int | |
| 2421 | 651 rangetab_type_validate (Lisp_Object UNUSED (keyword), Lisp_Object value, |
| 652 Error_Behavior UNUSED (errb)) | |
| 653 { | |
| 654 /* #### should deal with ERRB */ | |
| 655 range_table_symbol_to_type (value); | |
| 656 return 1; | |
| 657 } | |
| 658 | |
| 659 static int | |
| 2286 | 660 rangetab_data_validate (Lisp_Object UNUSED (keyword), Lisp_Object value, |
| 661 Error_Behavior UNUSED (errb)) | |
| 428 | 662 { |
| 2367 | 663 /* #### should deal with ERRB */ |
| 664 EXTERNAL_PROPERTY_LIST_LOOP_3 (range, data, value) | |
| 428 | 665 { |
| 666 if (!INTP (range) && !CHARP (range) | |
| 667 && !(CONSP (range) && CONSP (XCDR (range)) | |
| 668 && NILP (XCDR (XCDR (range))) | |
| 669 && (INTP (XCAR (range)) || CHARP (XCAR (range))) | |
| 670 && (INTP (XCAR (XCDR (range))) || CHARP (XCAR (XCDR (range)))))) | |
| 563 | 671 sferror ("Invalid range format", range); |
| 428 | 672 } |
| 673 | |
| 674 return 1; | |
| 675 } | |
| 676 | |
| 677 static Lisp_Object | |
| 2421 | 678 rangetab_instantiate (Lisp_Object plist) |
| 428 | 679 { |
| 2425 | 680 Lisp_Object data = Qnil, type = Qnil, rangetab; |
| 428 | 681 |
| 2421 | 682 PROPERTY_LIST_LOOP_3 (key, value, plist) |
| 428 | 683 { |
| 2421 | 684 if (EQ (key, Qtype)) type = value; |
| 685 else if (EQ (key, Qdata)) data = value; | |
| 686 else | |
| 2500 | 687 ABORT (); |
| 2421 | 688 } |
| 689 | |
| 2425 | 690 rangetab = Fmake_range_table (type); |
| 428 | 691 |
| 2421 | 692 { |
| 693 PROPERTY_LIST_LOOP_3 (range, val, data) | |
| 694 { | |
| 695 if (CONSP (range)) | |
| 696 Fput_range_table (Fcar (range), Fcar (Fcdr (range)), val, | |
| 697 rangetab); | |
| 698 else | |
| 699 Fput_range_table (range, range, val, rangetab); | |
| 700 } | |
| 701 } | |
| 428 | 702 |
| 703 return rangetab; | |
| 704 } | |
| 705 | |
| 706 | |
| 707 /************************************************************************/ | |
| 708 /* Unified range tables */ | |
| 709 /************************************************************************/ | |
| 710 | |
| 711 /* A "unified range table" is a format for storing range tables | |
| 712 as contiguous blocks of memory. This is used by the regexp | |
| 713 code, which needs to use range tables to properly handle [] | |
| 714 constructs in the presence of extended characters but wants to | |
| 715 store an entire compiled pattern as a contiguous block of memory. | |
| 716 | |
| 717 Unified range tables are designed so that they can be placed | |
| 718 at an arbitrary (possibly mis-aligned) place in memory. | |
| 719 (Dealing with alignment is a pain in the ass.) | |
| 720 | |
| 721 WARNING: No provisions for garbage collection are currently made. | |
| 722 This means that there must not be any Lisp objects in a unified | |
| 723 range table that need to be marked for garbage collection. | |
| 724 Good candidates for objects that can go into a range table are | |
| 725 | |
| 726 -- numbers and characters (do not need to be marked) | |
| 727 -- nil, t (marked elsewhere) | |
| 728 -- charsets and coding systems (automatically marked because | |
| 729 they are in a marked list, | |
| 730 and can't be removed) | |
| 731 | |
| 732 Good but slightly less so: | |
| 733 | |
| 734 -- symbols (could be uninterned, but that is not likely) | |
| 735 | |
| 736 Somewhat less good: | |
| 737 | |
| 738 -- buffers, frames, devices (could get deleted) | |
| 739 | |
| 740 | |
| 741 It is expected that you work with range tables in the normal | |
| 742 format and then convert to unified format when you are done | |
| 743 making modifications. As such, no functions are provided | |
| 744 for modifying a unified range table. The only operations | |
| 745 you can do to unified range tables are | |
| 746 | |
| 747 -- look up a value | |
| 748 -- retrieve all the ranges in an iterative fashion | |
| 749 | |
| 750 */ | |
| 751 | |
| 752 /* The format of a unified range table is as follows: | |
| 753 | |
| 754 -- The first byte contains the number of bytes to skip to find the | |
| 755 actual start of the table. This deals with alignment constraints, | |
| 756 since the table might want to go at any arbitrary place in memory. | |
| 757 -- The next three bytes contain the number of bytes to skip (from the | |
| 758 *first* byte) to find the stuff after the table. It's stored in | |
| 759 little-endian format because that's how God intended things. We don't | |
| 760 necessarily start the stuff at the very end of the table because | |
| 761 we want to have at least ALIGNOF (EMACS_INT) extra space in case | |
| 762 we have to move the range table around. (It appears that some | |
| 763 architectures don't maintain alignment when reallocing.) | |
| 764 -- At the prescribed offset is a struct unified_range_table, containing | |
| 765 some number of `struct range_table_entry' entries. */ | |
| 766 | |
| 767 struct unified_range_table | |
| 768 { | |
| 769 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
|
770 enum range_table_type type; |
| 428 | 771 struct range_table_entry first; |
| 772 }; | |
| 773 | |
| 774 /* Return size in bytes needed to store the data in a range table. */ | |
| 775 | |
| 776 int | |
| 777 unified_range_table_bytes_needed (Lisp_Object rangetab) | |
| 778 { | |
| 779 return (sizeof (struct range_table_entry) * | |
| 780 (Dynarr_length (XRANGE_TABLE (rangetab)->entries) - 1) + | |
| 781 sizeof (struct unified_range_table) + | |
| 782 /* ALIGNOF a struct may be too big. */ | |
| 783 /* We have four bytes for the size numbers, and an extra | |
| 784 four or eight bytes for making sure we get the alignment | |
| 785 OK. */ | |
| 786 ALIGNOF (EMACS_INT) + 4); | |
| 787 } | |
| 788 | |
| 789 /* Convert a range table into unified format and store in DEST, | |
| 790 which must be able to hold the number of bytes returned by | |
| 791 range_table_bytes_needed(). */ | |
| 792 | |
| 793 void | |
| 794 unified_range_table_copy_data (Lisp_Object rangetab, void *dest) | |
| 795 { | |
| 796 /* We cast to the above structure rather than just casting to | |
| 797 char * and adding sizeof(int), because that will lead to | |
| 798 mis-aligned data on the Alpha machines. */ | |
| 799 struct unified_range_table *un; | |
| 800 range_table_entry_dynarr *rted = XRANGE_TABLE (rangetab)->entries; | |
| 801 int total_needed = unified_range_table_bytes_needed (rangetab); | |
| 826 | 802 void *new_dest = ALIGN_PTR ((char *) dest + 4, EMACS_INT); |
| 428 | 803 |
| 804 * (char *) dest = (char) ((char *) new_dest - (char *) dest); | |
| 805 * ((unsigned char *) dest + 1) = total_needed & 0xFF; | |
| 806 total_needed >>= 8; | |
| 807 * ((unsigned char *) dest + 2) = total_needed & 0xFF; | |
| 808 total_needed >>= 8; | |
| 809 * ((unsigned char *) dest + 3) = total_needed & 0xFF; | |
| 810 un = (struct unified_range_table *) new_dest; | |
| 811 un->nentries = Dynarr_length (rted); | |
|
4831
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
812 un->type = XRANGE_TABLE (rangetab)->type; |
| 4967 | 813 memcpy (&un->first, Dynarr_begin (rted), |
| 428 | 814 sizeof (struct range_table_entry) * Dynarr_length (rted)); |
| 815 } | |
| 816 | |
| 817 /* Return number of bytes actually used by a unified range table. */ | |
| 818 | |
| 819 int | |
| 820 unified_range_table_bytes_used (void *unrangetab) | |
| 821 { | |
| 822 return ((* ((unsigned char *) unrangetab + 1)) | |
| 823 + ((* ((unsigned char *) unrangetab + 2)) << 8) | |
| 824 + ((* ((unsigned char *) unrangetab + 3)) << 16)); | |
| 825 } | |
| 826 | |
| 827 /* Make sure the table is aligned, and move it around if it's not. */ | |
| 828 static void | |
| 829 align_the_damn_table (void *unrangetab) | |
| 830 { | |
| 831 void *cur_dest = (char *) unrangetab + * (char *) unrangetab; | |
| 826 | 832 if (cur_dest != ALIGN_PTR (cur_dest, EMACS_INT)) |
| 428 | 833 { |
| 834 int count = (unified_range_table_bytes_used (unrangetab) - 4 | |
| 835 - ALIGNOF (EMACS_INT)); | |
| 836 /* Find the proper location, just like above. */ | |
| 826 | 837 void *new_dest = ALIGN_PTR ((char *) unrangetab + 4, EMACS_INT); |
| 428 | 838 /* memmove() works in the presence of overlapping data. */ |
| 839 memmove (new_dest, cur_dest, count); | |
| 840 * (char *) unrangetab = (char) ((char *) new_dest - (char *) unrangetab); | |
| 841 } | |
| 842 } | |
| 843 | |
| 844 /* Look up a value in a unified range table. */ | |
| 845 | |
| 846 Lisp_Object | |
| 847 unified_range_table_lookup (void *unrangetab, EMACS_INT pos, | |
| 848 Lisp_Object default_) | |
| 849 { | |
| 850 void *new_dest; | |
| 851 struct unified_range_table *un; | |
| 852 | |
| 853 align_the_damn_table (unrangetab); | |
| 854 new_dest = (char *) unrangetab + * (char *) unrangetab; | |
| 855 un = (struct unified_range_table *) new_dest; | |
| 856 | |
| 857 return get_range_table (pos, un->nentries, &un->first, default_); | |
| 858 } | |
| 859 | |
| 860 /* Return number of entries in a unified range table. */ | |
| 861 | |
| 862 int | |
| 863 unified_range_table_nentries (void *unrangetab) | |
| 864 { | |
| 865 void *new_dest; | |
| 866 struct unified_range_table *un; | |
| 867 | |
| 868 align_the_damn_table (unrangetab); | |
| 869 new_dest = (char *) unrangetab + * (char *) unrangetab; | |
| 870 un = (struct unified_range_table *) new_dest; | |
| 871 return un->nentries; | |
| 872 } | |
| 873 | |
| 874 /* Return the OFFSETth range (counting from 0) in UNRANGETAB. */ | |
| 875 void | |
| 876 unified_range_table_get_range (void *unrangetab, int offset, | |
| 877 EMACS_INT *min, EMACS_INT *max, | |
| 878 Lisp_Object *val) | |
| 879 { | |
| 880 void *new_dest; | |
| 881 struct unified_range_table *un; | |
| 882 struct range_table_entry *tab; | |
| 883 | |
| 884 align_the_damn_table (unrangetab); | |
| 885 new_dest = (char *) unrangetab + * (char *) unrangetab; | |
| 886 un = (struct unified_range_table *) new_dest; | |
| 887 | |
| 888 assert (offset >= 0 && offset < un->nentries); | |
| 889 tab = (&un->first) + offset; | |
| 890 *min = tab->first; | |
| 891 *max = tab->last; | |
| 892 *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
|
893 |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
894 internal_to_external_adjust_ends (un->type, min, max); |
| 428 | 895 } |
| 896 | |
| 897 | |
| 898 /************************************************************************/ | |
| 899 /* Initialization */ | |
| 900 /************************************************************************/ | |
| 901 | |
| 902 void | |
| 903 syms_of_rangetab (void) | |
| 904 { | |
| 442 | 905 INIT_LRECORD_IMPLEMENTATION (range_table); |
| 906 | |
| 563 | 907 DEFSYMBOL_MULTIWORD_PREDICATE (Qrange_tablep); |
| 908 DEFSYMBOL (Qrange_table); | |
| 428 | 909 |
| 2421 | 910 DEFSYMBOL (Qstart_closed_end_open); |
| 911 DEFSYMBOL (Qstart_open_end_open); | |
| 912 DEFSYMBOL (Qstart_closed_end_closed); | |
| 913 DEFSYMBOL (Qstart_open_end_closed); | |
| 914 | |
| 428 | 915 DEFSUBR (Frange_table_p); |
| 2421 | 916 DEFSUBR (Frange_table_type); |
| 428 | 917 DEFSUBR (Fmake_range_table); |
| 918 DEFSUBR (Fcopy_range_table); | |
| 919 DEFSUBR (Fget_range_table); | |
| 920 DEFSUBR (Fput_range_table); | |
| 921 DEFSUBR (Fremove_range_table); | |
| 922 DEFSUBR (Fclear_range_table); | |
| 923 DEFSUBR (Fmap_range_table); | |
| 924 } | |
| 925 | |
| 926 void | |
| 927 structure_type_create_rangetab (void) | |
| 928 { | |
| 929 struct structure_type *st; | |
| 930 | |
| 931 st = define_structure_type (Qrange_table, 0, rangetab_instantiate); | |
| 932 | |
| 933 define_structure_type_keyword (st, Qdata, rangetab_data_validate); | |
| 2421 | 934 define_structure_type_keyword (st, Qtype, rangetab_type_validate); |
| 428 | 935 } |