Mercurial > hg > xemacs-beta
annotate src/rangetab.c @ 5124:623d57b7fbe8 ben-lisp-object
separate regular and disksave finalization, print method fixes.
Create separate disksave method and make the finalize method only be for
actual object finalization, not disksave finalization.
Fix places where 0 was given in place of a printer -- print methods are
mandatory, and internal objects formerly without a print method now must
explicitly specify internal_object_printer().
Change the defn of CONSOLE_LIVE_P to avoid problems in some weird situations.
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-01-20 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (very_old_free_lcrecord):
* alloc.c (disksave_object_finalization_1):
* alloc.c (make_lcrecord_list):
* alloc.c (alloc_managed_lcrecord):
* alloc.c (free_managed_lcrecord):
* alloc.c (sweep_lcrecords_1):
* buffer.c:
* bytecode.c:
* bytecode.c (Fcompiled_function_p):
* chartab.c:
* console-impl.h:
* console-impl.h (CONSOLE_TYPE_P):
* console.c:
* console.c (set_quit_events):
* data.c:
* data.c (Fmake_ephemeron):
* database.c:
* database.c (finalize_database):
* database.c (Fclose_database):
* device-msw.c:
* device-msw.c (finalize_devmode):
* device-msw.c (allocate_devmode):
* device.c:
* elhash.c:
* elhash.c (finalize_hash_table):
* eval.c:
* eval.c (bind_multiple_value_limits):
* event-stream.c:
* event-stream.c (finalize_command_builder):
* events.c:
* events.c (mark_event):
* extents.c:
* extents.c (finalize_extent_info):
* extents.c (uninit_buffer_extents):
* faces.c:
* file-coding.c:
* file-coding.c (finalize_coding_system):
* file-coding.h:
* file-coding.h (struct coding_system_methods):
* file-coding.h (struct detector):
* floatfns.c:
* floatfns.c (extract_float):
* fns.c:
* fns.c (Fidentity):
* font-mgr.c (finalize_fc_pattern):
* font-mgr.c (finalize_fc_config):
* frame.c:
* glyphs.c:
* glyphs.c (finalize_image_instance):
* glyphs.c (unmap_subwindow_instance_cache_mapper):
* gui.c:
* gui.c (gui_error):
* keymap.c:
* lisp.h (struct Lisp_Symbol):
* lrecord.h:
* lrecord.h (struct lrecord_implementation):
* lrecord.h (MC_ALLOC_CALL_FINALIZER):
* lrecord.h (MC_ALLOC_CALL_FINALIZER_FOR_DISKSAVE):
* lrecord.h (DEFINE_DUMPABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_SIZABLE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_SIZABLE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_FROB_BLOCK_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_FROB_BLOCK_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_INTERNAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_SIZABLE_INTERNAL_LISP_OBJECT):
* lrecord.h (MAKE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_SIZABLE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_SIZABLE_GENERAL_LISP_OBJECT):
* lrecord.h (MAKE_MODULE_LISP_OBJECT):
* lstream.c:
* lstream.c (finalize_lstream):
* lstream.c (disksave_lstream):
* marker.c:
* marker.c (finalize_marker):
* mule-charset.c (make_charset):
* number.c:
* objects.c:
* objects.c (finalize_color_instance):
* objects.c (finalize_font_instance):
* opaque.c:
* opaque.c (make_opaque_ptr):
* process-nt.c:
* process-nt.c (nt_finalize_process_data):
* process-nt.c (nt_deactivate_process):
* process.c:
* process.c (finalize_process):
* procimpl.h (struct process_methods):
* scrollbar.c:
* scrollbar.c (free_scrollbar_instance):
* specifier.c (finalize_specifier):
* symbols.c:
* toolbar.c:
* toolbar.c (Ftoolbar_button_p):
* tooltalk.c:
* ui-gtk.c:
* ui-gtk.c (emacs_gtk_object_finalizer):
* ui-gtk.c (allocate_emacs_gtk_boxed_data):
* window.c:
* window.c (finalize_window):
* window.c (mark_window_as_deleted):
Separate out regular and disksave finalization. Instead of a
FOR_DISKSAVE argument to the finalizer, create a separate object
method `disksaver'. Make `finalizer' have only one argument.
Go through and separate out all finalize methods into finalize
and disksave. Delete lots of thereby redundant disksave checking.
Delete places that signal an error if we attempt to disksave --
all of these objects are non-dumpable and we will get an error
from pdump anyway if we attempt to dump them. After this is done,
only one object remains that has a disksave method -- lstream.
Change DEFINE_*_LISP_OBJECT_WITH_PROPS to DEFINE_*_GENERAL_LISP_OBJECT,
which is used for specifying either property methods or disksave
methods (or in the future, any other less-used methods).
Remove the for_disksave argument to finalize_process_data. Don't
provide a disksaver for processes because no one currently needs
it.
Clean up various places where objects didn't provide a print method.
It was made mandatory in previous changes, and all methods now
either provide their own print method or use internal_object_printer
or external_object_printer.
Change the definition of CONSOLE_LIVE_P to use the contype enum
rather than looking into the conmeths structure -- in some weird
situations with dead objects, the conmeths structure is NULL,
and printing such objects from debug_print() will crash if we try
to look into the conmeths structure.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Wed, 20 Jan 2010 07:05:57 -0600 |
| parents | e0db3c197671 |
| children | b5df3737028a |
| rev | line source |
|---|---|
| 428 | 1 /* XEmacs routines to deal with range tables. |
| 2 Copyright (C) 1995 Sun Microsystems, Inc. | |
| 2952 | 3 Copyright (C) 1995, 2002, 2004, 2005 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 | |
| 110 write_c_string (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) |
| 826 | 116 write_c_string (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) |
| 134 write_c_string (printcharfun, "))"); | |
| 135 else | |
| 136 write_fmt_string (printcharfun, " 0x%x>", rt->header.uid); | |
| 428 | 137 } |
| 138 | |
| 139 static int | |
| 140 range_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) | |
| 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 | |
| 156 || !internal_equal (rte1->val, rte2->val, depth + 1)) | |
| 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 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
223 DEFINE_DUMPABLE_LISP_OBJECT ("range-table", range_table, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
224 mark_range_table, print_range_table, 0, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
225 range_table_equal, range_table_hash, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
226 range_table_description, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
227 Lisp_Range_Table); |
| 428 | 228 |
| 229 /************************************************************************/ | |
| 230 /* Range table operations */ | |
| 231 /************************************************************************/ | |
| 232 | |
| 800 | 233 #ifdef ERROR_CHECK_STRUCTURES |
| 428 | 234 |
| 235 static void | |
| 440 | 236 verify_range_table (Lisp_Range_Table *rt) |
| 428 | 237 { |
| 238 int i; | |
| 239 | |
| 240 for (i = 0; i < Dynarr_length (rt->entries); i++) | |
| 241 { | |
| 242 struct range_table_entry *rte = Dynarr_atp (rt->entries, i); | |
| 243 assert (rte->last >= rte->first); | |
| 244 if (i > 0) | |
| 2421 | 245 assert (Dynarr_at (rt->entries, i - 1).last <= rte->first); |
| 428 | 246 } |
| 247 } | |
| 248 | |
| 249 #else | |
| 250 | |
| 251 #define verify_range_table(rt) | |
| 252 | |
| 253 #endif | |
| 254 | |
| 255 /* Look up in a range table without the Dynarr wrapper. | |
| 256 Used also by the unified range table format. */ | |
| 257 | |
| 258 static Lisp_Object | |
| 259 get_range_table (EMACS_INT pos, int nentries, struct range_table_entry *tab, | |
| 260 Lisp_Object default_) | |
| 261 { | |
| 262 int left = 0, right = nentries; | |
| 263 | |
| 264 /* binary search for the entry. Based on similar code in | |
| 265 extent_list_locate(). */ | |
| 266 while (left != right) | |
| 267 { | |
| 268 /* RIGHT might not point to a valid entry (i.e. it's at the end | |
| 269 of the list), so NEWPOS must round down. */ | |
| 647 | 270 int newpos = (left + right) >> 1; |
| 428 | 271 struct range_table_entry *entry = tab + newpos; |
| 2421 | 272 if (pos >= entry->last) |
| 273 left = newpos + 1; | |
| 428 | 274 else if (pos < entry->first) |
| 275 right = newpos; | |
| 276 else | |
| 277 return entry->val; | |
| 278 } | |
| 279 | |
| 280 return default_; | |
| 281 } | |
| 282 | |
| 283 DEFUN ("range-table-p", Frange_table_p, 1, 1, 0, /* | |
| 284 Return non-nil if OBJECT is a range table. | |
| 285 */ | |
| 286 (object)) | |
| 287 { | |
| 288 return RANGE_TABLEP (object) ? Qt : Qnil; | |
| 289 } | |
| 290 | |
| 2421 | 291 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
|
292 Return the type of RANGE-TABLE. |
|
312503644bc3
Correct the docstring for #'range-table-type.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4690
diff
changeset
|
293 |
|
312503644bc3
Correct the docstring for #'range-table-type.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4690
diff
changeset
|
294 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
|
295 ends; see `make-range-table'. |
| 2421 | 296 */ |
| 297 (range_table)) | |
| 298 { | |
| 299 CHECK_RANGE_TABLE (range_table); | |
| 300 return range_table_type_to_symbol (XRANGE_TABLE (range_table)->type); | |
| 301 } | |
| 302 | |
| 303 DEFUN ("make-range-table", Fmake_range_table, 0, 1, 0, /* | |
| 428 | 304 Return a new, empty range table. |
| 305 You can manipulate it using `put-range-table', `get-range-table', | |
| 306 `remove-range-table', and `clear-range-table'. | |
| 2421 | 307 Range tables allow you to efficiently set values for ranges of integers. |
| 308 | |
| 309 TYPE is a symbol indicating how ranges are assumed to function at their | |
| 310 ends. It can be one of | |
| 311 | |
| 312 SYMBOL RANGE-START RANGE-END | |
| 313 ------ ----------- --------- | |
| 314 `start-closed-end-open' (the default) closed open | |
| 315 `start-closed-end-closed' closed closed | |
| 316 `start-open-end-open' open open | |
| 317 `start-open-end-closed' open closed | |
| 318 | |
| 319 A `closed' endpoint of a range means that the number at that end is included | |
| 320 in the range. For an `open' endpoint, the number would not be included. | |
| 321 | |
| 322 For example, a closed-open range from 5 to 20 would be indicated as [5, | |
| 323 20) where a bracket indicates a closed end and a parenthesis an open end, | |
| 324 and would mean `all the numbers between 5 and 20', including 5 but not 20. | |
| 325 This seems a little strange at first but is in fact extremely common in | |
| 326 the outside world as well as in computers and makes things work sensibly. | |
| 327 For example, if I say "there are seven days between today and next week | |
| 328 today", I'm including today but not next week today; if I included both, | |
| 329 there would be eight days. Similarly, there are 15 (= 20 - 5) elements in | |
| 330 the range [5, 20), but 16 in the range [5, 20]. | |
| 428 | 331 */ |
| 2421 | 332 (type)) |
| 428 | 333 { |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
334 Lisp_Object obj = ALLOC_LISP_OBJECT (range_table); |
|
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
335 Lisp_Range_Table *rt = XRANGE_TABLE (obj); |
| 428 | 336 rt->entries = Dynarr_new (range_table_entry); |
| 2421 | 337 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
|
338 return obj; |
| 428 | 339 } |
| 340 | |
| 341 DEFUN ("copy-range-table", Fcopy_range_table, 1, 1, 0, /* | |
| 444 | 342 Return a new range table which is a copy of RANGE-TABLE. |
| 343 It will contain the same values for the same ranges as RANGE-TABLE. | |
| 344 The values will not themselves be copied. | |
| 428 | 345 */ |
| 444 | 346 (range_table)) |
| 428 | 347 { |
| 440 | 348 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
|
349 Lisp_Object obj; |
| 428 | 350 |
| 444 | 351 CHECK_RANGE_TABLE (range_table); |
| 352 rt = XRANGE_TABLE (range_table); | |
| 428 | 353 |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
354 obj = ALLOC_LISP_OBJECT (range_table); |
|
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
355 rtnew = XRANGE_TABLE (obj); |
| 428 | 356 rtnew->entries = Dynarr_new (range_table_entry); |
| 2421 | 357 rtnew->type = rt->type; |
| 428 | 358 |
| 359 Dynarr_add_many (rtnew->entries, Dynarr_atp (rt->entries, 0), | |
| 360 Dynarr_length (rt->entries)); | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
361 return obj; |
| 428 | 362 } |
| 363 | |
| 364 DEFUN ("get-range-table", Fget_range_table, 2, 3, 0, /* | |
| 444 | 365 Find value for position POS in RANGE-TABLE. |
| 428 | 366 If there is no corresponding value, return DEFAULT (defaults to nil). |
| 367 */ | |
| 444 | 368 (pos, range_table, default_)) |
| 428 | 369 { |
| 440 | 370 Lisp_Range_Table *rt; |
| 428 | 371 |
| 444 | 372 CHECK_RANGE_TABLE (range_table); |
| 373 rt = XRANGE_TABLE (range_table); | |
| 428 | 374 |
| 375 CHECK_INT_COERCE_CHAR (pos); | |
| 376 | |
| 377 return get_range_table (XINT (pos), Dynarr_length (rt->entries), | |
| 378 Dynarr_atp (rt->entries, 0), default_); | |
| 379 } | |
| 380 | |
| 381 void | |
| 382 put_range_table (Lisp_Object table, EMACS_INT first, | |
| 383 EMACS_INT last, Lisp_Object val) | |
| 384 { | |
| 385 int i; | |
| 386 int insert_me_here = -1; | |
| 440 | 387 Lisp_Range_Table *rt = XRANGE_TABLE (table); |
| 428 | 388 |
| 2421 | 389 /* Fix up the numbers in accordance with the open/closedness to make |
| 390 them behave like default open/closed. */ | |
| 391 | |
| 392 switch (rt->type) | |
| 393 { | |
| 394 case RANGE_START_CLOSED_END_OPEN: break; | |
| 395 case RANGE_START_CLOSED_END_CLOSED: last++; break; | |
| 396 case RANGE_START_OPEN_END_OPEN: first++; break; | |
| 397 case RANGE_START_OPEN_END_CLOSED: first++, last++; break; | |
| 398 } | |
| 399 | |
| 400 if (first == last) | |
| 401 return; | |
| 402 if (first > last) | |
| 403 /* This will happen if originally first == last and both ends are | |
| 404 open. #### Should we signal an error? */ | |
| 405 return; | |
| 406 | |
| 428 | 407 /* Now insert in the proper place. This gets tricky because |
| 408 we may be overlapping one or more existing ranges and need | |
| 409 to fix them up. */ | |
| 410 | |
| 411 /* First delete all sections of any existing ranges that overlap | |
| 412 the new range. */ | |
| 413 for (i = 0; i < Dynarr_length (rt->entries); i++) | |
| 414 { | |
| 415 struct range_table_entry *entry = Dynarr_atp (rt->entries, i); | |
| 416 /* We insert before the first range that begins at or after the | |
| 417 new range. */ | |
| 418 if (entry->first >= first && insert_me_here < 0) | |
| 419 insert_me_here = i; | |
| 420 if (entry->last < first) | |
| 421 /* completely before the new range. */ | |
| 422 continue; | |
| 423 if (entry->first > last) | |
| 424 /* completely after the new range. No more possibilities of | |
| 425 finding overlapping ranges. */ | |
| 426 break; | |
| 2421 | 427 /* At this point the existing ENTRY overlaps or touches the new one. */ |
| 428 | 428 if (entry->first < first && entry->last <= last) |
| 429 { | |
| 430 /* looks like: | |
| 431 | |
| 2421 | 432 [ NEW ) |
| 433 [ EXISTING ) | |
| 434 | |
| 435 or | |
| 436 | |
| 437 [ NEW ) | |
| 438 [ EXISTING ) | |
| 428 | 439 |
| 440 */ | |
| 441 /* truncate the end off of it. */ | |
| 2421 | 442 entry->last = first; |
| 428 | 443 } |
| 444 else if (entry->first < first && entry->last > last) | |
| 445 /* looks like: | |
| 446 | |
| 2421 | 447 [ NEW ) |
| 448 [ EXISTING ) | |
| 428 | 449 |
| 450 */ | |
| 451 /* need to split this one in two. */ | |
| 452 { | |
| 453 struct range_table_entry insert_me_too; | |
| 454 | |
| 2421 | 455 insert_me_too.first = last; |
| 428 | 456 insert_me_too.last = entry->last; |
| 457 insert_me_too.val = entry->val; | |
| 2421 | 458 entry->last = first; |
| 428 | 459 Dynarr_insert_many (rt->entries, &insert_me_too, 1, i + 1); |
| 460 } | |
| 2421 | 461 else if (entry->last >= last) |
| 428 | 462 { |
| 463 /* looks like: | |
| 464 | |
| 2421 | 465 [ NEW ) |
| 466 [ EXISTING ) | |
| 467 | |
| 468 or | |
| 469 | |
| 470 [ NEW ) | |
| 471 [ EXISTING ) | |
| 428 | 472 |
| 473 */ | |
| 474 /* truncate the start off of it. */ | |
| 2421 | 475 entry->first = last; |
| 428 | 476 } |
| 477 else | |
| 478 { | |
| 479 /* existing is entirely within new. */ | |
| 480 Dynarr_delete_many (rt->entries, i, 1); | |
| 481 i--; /* back up since everything shifted one to the left. */ | |
| 482 } | |
| 483 } | |
| 484 | |
| 485 /* Someone asked us to delete the range, not insert it. */ | |
| 486 if (UNBOUNDP (val)) | |
| 487 return; | |
| 488 | |
| 489 /* Now insert the new entry, maybe at the end. */ | |
| 490 | |
| 491 if (insert_me_here < 0) | |
| 492 insert_me_here = i; | |
| 493 | |
| 494 { | |
| 495 struct range_table_entry insert_me; | |
| 496 | |
| 497 insert_me.first = first; | |
| 498 insert_me.last = last; | |
| 499 insert_me.val = val; | |
| 500 | |
| 501 Dynarr_insert_many (rt->entries, &insert_me, 1, insert_me_here); | |
| 502 } | |
| 503 | |
| 504 /* Now see if we can combine this entry with adjacent ones just | |
| 505 before or after. */ | |
| 506 | |
| 507 if (insert_me_here > 0) | |
| 508 { | |
| 509 struct range_table_entry *entry = Dynarr_atp (rt->entries, | |
| 510 insert_me_here - 1); | |
| 2421 | 511 if (EQ (val, entry->val) && entry->last == first) |
| 428 | 512 { |
| 513 entry->last = last; | |
| 514 Dynarr_delete_many (rt->entries, insert_me_here, 1); | |
| 515 insert_me_here--; | |
| 516 /* We have morphed into a larger range. Update our records | |
| 517 in case we also combine with the one after. */ | |
| 518 first = entry->first; | |
| 519 } | |
| 520 } | |
| 521 | |
| 522 if (insert_me_here < Dynarr_length (rt->entries) - 1) | |
| 523 { | |
| 524 struct range_table_entry *entry = Dynarr_atp (rt->entries, | |
| 525 insert_me_here + 1); | |
| 2421 | 526 if (EQ (val, entry->val) && entry->first == last) |
| 428 | 527 { |
| 528 entry->first = first; | |
| 529 Dynarr_delete_many (rt->entries, insert_me_here, 1); | |
| 530 } | |
| 531 } | |
| 532 } | |
| 533 | |
| 534 DEFUN ("put-range-table", Fput_range_table, 4, 4, 0, /* | |
| 2421 | 535 Set the value for range START .. END to be VALUE in RANGE-TABLE. |
| 428 | 536 */ |
| 444 | 537 (start, end, value, range_table)) |
| 428 | 538 { |
| 539 EMACS_INT first, last; | |
| 540 | |
| 444 | 541 CHECK_RANGE_TABLE (range_table); |
| 428 | 542 CHECK_INT_COERCE_CHAR (start); |
| 543 first = XINT (start); | |
| 544 CHECK_INT_COERCE_CHAR (end); | |
| 545 last = XINT (end); | |
| 546 if (first > last) | |
| 563 | 547 invalid_argument_2 ("start must be <= end", start, end); |
| 428 | 548 |
| 444 | 549 put_range_table (range_table, first, last, value); |
| 550 verify_range_table (XRANGE_TABLE (range_table)); | |
| 428 | 551 return Qnil; |
| 552 } | |
| 553 | |
| 554 DEFUN ("remove-range-table", Fremove_range_table, 3, 3, 0, /* | |
| 2421 | 555 Remove the value for range START .. END in RANGE-TABLE. |
| 428 | 556 */ |
| 444 | 557 (start, end, range_table)) |
| 428 | 558 { |
| 444 | 559 return Fput_range_table (start, end, Qunbound, range_table); |
| 428 | 560 } |
| 561 | |
| 562 DEFUN ("clear-range-table", Fclear_range_table, 1, 1, 0, /* | |
| 444 | 563 Flush RANGE-TABLE. |
| 428 | 564 */ |
| 444 | 565 (range_table)) |
| 428 | 566 { |
| 444 | 567 CHECK_RANGE_TABLE (range_table); |
| 568 Dynarr_reset (XRANGE_TABLE (range_table)->entries); | |
| 428 | 569 return Qnil; |
| 570 } | |
| 571 | |
| 572 DEFUN ("map-range-table", Fmap_range_table, 2, 2, 0, /* | |
| 444 | 573 Map FUNCTION over entries in RANGE-TABLE, calling it with three args, |
| 428 | 574 the beginning and end of the range and the corresponding value. |
| 442 | 575 |
| 576 Results are guaranteed to be correct (i.e. each entry processed | |
| 577 exactly once) if FUNCTION modifies or deletes the current entry | |
| 444 | 578 \(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
|
579 `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
|
580 this guarantee doesn't hold. |
| 428 | 581 */ |
| 444 | 582 (function, range_table)) |
| 428 | 583 { |
| 442 | 584 Lisp_Range_Table *rt; |
| 585 int i; | |
| 586 | |
| 444 | 587 CHECK_RANGE_TABLE (range_table); |
| 442 | 588 CHECK_FUNCTION (function); |
| 589 | |
| 444 | 590 rt = XRANGE_TABLE (range_table); |
| 442 | 591 |
| 592 /* Do not "optimize" by pulling out the length computation below! | |
| 593 FUNCTION may have changed the table. */ | |
| 594 for (i = 0; i < Dynarr_length (rt->entries); i++) | |
| 595 { | |
| 596 struct range_table_entry *entry = Dynarr_atp (rt->entries, i); | |
| 597 EMACS_INT first, last; | |
| 598 Lisp_Object args[4]; | |
| 599 int oldlen; | |
| 600 | |
| 601 again: | |
| 602 first = entry->first; | |
| 603 last = entry->last; | |
| 604 oldlen = Dynarr_length (rt->entries); | |
| 605 args[0] = function; | |
| 2952 | 606 /* Fix up the numbers in accordance with the open/closedness of the |
| 607 table. */ | |
| 608 { | |
| 609 EMACS_INT premier = first, dernier = last; | |
| 610 switch (rt->type) | |
| 611 { | |
| 612 case RANGE_START_CLOSED_END_OPEN: break; | |
| 613 case RANGE_START_CLOSED_END_CLOSED: dernier--; break; | |
| 614 case RANGE_START_OPEN_END_OPEN: premier--; break; | |
| 615 case RANGE_START_OPEN_END_CLOSED: premier--, dernier--; break; | |
| 616 } | |
| 617 args[1] = make_int (premier); | |
| 618 args[2] = make_int (dernier); | |
| 619 } | |
| 442 | 620 args[3] = entry->val; |
| 621 Ffuncall (countof (args), args); | |
| 622 /* Has FUNCTION removed the entry? */ | |
| 623 if (oldlen > Dynarr_length (rt->entries) | |
| 624 && i < Dynarr_length (rt->entries) | |
| 625 && (first != entry->first || last != entry->last)) | |
| 626 goto again; | |
| 627 } | |
| 628 | |
| 428 | 629 return Qnil; |
| 630 } | |
| 631 | |
| 632 | |
| 633 /************************************************************************/ | |
| 634 /* Range table read syntax */ | |
| 635 /************************************************************************/ | |
| 636 | |
| 637 static int | |
| 2421 | 638 rangetab_type_validate (Lisp_Object UNUSED (keyword), Lisp_Object value, |
| 639 Error_Behavior UNUSED (errb)) | |
| 640 { | |
| 641 /* #### should deal with ERRB */ | |
| 642 range_table_symbol_to_type (value); | |
| 643 return 1; | |
| 644 } | |
| 645 | |
| 646 static int | |
| 2286 | 647 rangetab_data_validate (Lisp_Object UNUSED (keyword), Lisp_Object value, |
| 648 Error_Behavior UNUSED (errb)) | |
| 428 | 649 { |
| 2367 | 650 /* #### should deal with ERRB */ |
| 651 EXTERNAL_PROPERTY_LIST_LOOP_3 (range, data, value) | |
| 428 | 652 { |
| 653 if (!INTP (range) && !CHARP (range) | |
| 654 && !(CONSP (range) && CONSP (XCDR (range)) | |
| 655 && NILP (XCDR (XCDR (range))) | |
| 656 && (INTP (XCAR (range)) || CHARP (XCAR (range))) | |
| 657 && (INTP (XCAR (XCDR (range))) || CHARP (XCAR (XCDR (range)))))) | |
| 563 | 658 sferror ("Invalid range format", range); |
| 428 | 659 } |
| 660 | |
| 661 return 1; | |
| 662 } | |
| 663 | |
| 664 static Lisp_Object | |
| 2421 | 665 rangetab_instantiate (Lisp_Object plist) |
| 428 | 666 { |
| 2425 | 667 Lisp_Object data = Qnil, type = Qnil, rangetab; |
| 428 | 668 |
| 2421 | 669 PROPERTY_LIST_LOOP_3 (key, value, plist) |
| 428 | 670 { |
| 2421 | 671 if (EQ (key, Qtype)) type = value; |
| 672 else if (EQ (key, Qdata)) data = value; | |
| 673 else | |
| 2500 | 674 ABORT (); |
| 2421 | 675 } |
| 676 | |
| 2425 | 677 rangetab = Fmake_range_table (type); |
| 428 | 678 |
| 2421 | 679 { |
| 680 PROPERTY_LIST_LOOP_3 (range, val, data) | |
| 681 { | |
| 682 if (CONSP (range)) | |
| 683 Fput_range_table (Fcar (range), Fcar (Fcdr (range)), val, | |
| 684 rangetab); | |
| 685 else | |
| 686 Fput_range_table (range, range, val, rangetab); | |
| 687 } | |
| 688 } | |
| 428 | 689 |
| 690 return rangetab; | |
| 691 } | |
| 692 | |
| 693 | |
| 694 /************************************************************************/ | |
| 695 /* Unified range tables */ | |
| 696 /************************************************************************/ | |
| 697 | |
| 698 /* A "unified range table" is a format for storing range tables | |
| 699 as contiguous blocks of memory. This is used by the regexp | |
| 700 code, which needs to use range tables to properly handle [] | |
| 701 constructs in the presence of extended characters but wants to | |
| 702 store an entire compiled pattern as a contiguous block of memory. | |
| 703 | |
| 704 Unified range tables are designed so that they can be placed | |
| 705 at an arbitrary (possibly mis-aligned) place in memory. | |
| 706 (Dealing with alignment is a pain in the ass.) | |
| 707 | |
| 708 WARNING: No provisions for garbage collection are currently made. | |
| 709 This means that there must not be any Lisp objects in a unified | |
| 710 range table that need to be marked for garbage collection. | |
| 711 Good candidates for objects that can go into a range table are | |
| 712 | |
| 713 -- numbers and characters (do not need to be marked) | |
| 714 -- nil, t (marked elsewhere) | |
| 715 -- charsets and coding systems (automatically marked because | |
| 716 they are in a marked list, | |
| 717 and can't be removed) | |
| 718 | |
| 719 Good but slightly less so: | |
| 720 | |
| 721 -- symbols (could be uninterned, but that is not likely) | |
| 722 | |
| 723 Somewhat less good: | |
| 724 | |
| 725 -- buffers, frames, devices (could get deleted) | |
| 726 | |
| 727 | |
| 728 It is expected that you work with range tables in the normal | |
| 729 format and then convert to unified format when you are done | |
| 730 making modifications. As such, no functions are provided | |
| 731 for modifying a unified range table. The only operations | |
| 732 you can do to unified range tables are | |
| 733 | |
| 734 -- look up a value | |
| 735 -- retrieve all the ranges in an iterative fashion | |
| 736 | |
| 737 */ | |
| 738 | |
| 739 /* The format of a unified range table is as follows: | |
| 740 | |
| 741 -- The first byte contains the number of bytes to skip to find the | |
| 742 actual start of the table. This deals with alignment constraints, | |
| 743 since the table might want to go at any arbitrary place in memory. | |
| 744 -- The next three bytes contain the number of bytes to skip (from the | |
| 745 *first* byte) to find the stuff after the table. It's stored in | |
| 746 little-endian format because that's how God intended things. We don't | |
| 747 necessarily start the stuff at the very end of the table because | |
| 748 we want to have at least ALIGNOF (EMACS_INT) extra space in case | |
| 749 we have to move the range table around. (It appears that some | |
| 750 architectures don't maintain alignment when reallocing.) | |
| 751 -- At the prescribed offset is a struct unified_range_table, containing | |
| 752 some number of `struct range_table_entry' entries. */ | |
| 753 | |
| 754 struct unified_range_table | |
| 755 { | |
| 756 int nentries; | |
| 757 struct range_table_entry first; | |
| 758 }; | |
| 759 | |
| 760 /* Return size in bytes needed to store the data in a range table. */ | |
| 761 | |
| 762 int | |
| 763 unified_range_table_bytes_needed (Lisp_Object rangetab) | |
| 764 { | |
| 765 return (sizeof (struct range_table_entry) * | |
| 766 (Dynarr_length (XRANGE_TABLE (rangetab)->entries) - 1) + | |
| 767 sizeof (struct unified_range_table) + | |
| 768 /* ALIGNOF a struct may be too big. */ | |
| 769 /* We have four bytes for the size numbers, and an extra | |
| 770 four or eight bytes for making sure we get the alignment | |
| 771 OK. */ | |
| 772 ALIGNOF (EMACS_INT) + 4); | |
| 773 } | |
| 774 | |
| 775 /* Convert a range table into unified format and store in DEST, | |
| 776 which must be able to hold the number of bytes returned by | |
| 777 range_table_bytes_needed(). */ | |
| 778 | |
| 779 void | |
| 780 unified_range_table_copy_data (Lisp_Object rangetab, void *dest) | |
| 781 { | |
| 782 /* We cast to the above structure rather than just casting to | |
| 783 char * and adding sizeof(int), because that will lead to | |
| 784 mis-aligned data on the Alpha machines. */ | |
| 785 struct unified_range_table *un; | |
| 786 range_table_entry_dynarr *rted = XRANGE_TABLE (rangetab)->entries; | |
| 787 int total_needed = unified_range_table_bytes_needed (rangetab); | |
| 826 | 788 void *new_dest = ALIGN_PTR ((char *) dest + 4, EMACS_INT); |
| 428 | 789 |
| 790 * (char *) dest = (char) ((char *) new_dest - (char *) dest); | |
| 791 * ((unsigned char *) dest + 1) = total_needed & 0xFF; | |
| 792 total_needed >>= 8; | |
| 793 * ((unsigned char *) dest + 2) = total_needed & 0xFF; | |
| 794 total_needed >>= 8; | |
| 795 * ((unsigned char *) dest + 3) = total_needed & 0xFF; | |
| 796 un = (struct unified_range_table *) new_dest; | |
| 797 un->nentries = Dynarr_length (rted); | |
| 798 memcpy (&un->first, Dynarr_atp (rted, 0), | |
| 799 sizeof (struct range_table_entry) * Dynarr_length (rted)); | |
| 800 } | |
| 801 | |
| 802 /* Return number of bytes actually used by a unified range table. */ | |
| 803 | |
| 804 int | |
| 805 unified_range_table_bytes_used (void *unrangetab) | |
| 806 { | |
| 807 return ((* ((unsigned char *) unrangetab + 1)) | |
| 808 + ((* ((unsigned char *) unrangetab + 2)) << 8) | |
| 809 + ((* ((unsigned char *) unrangetab + 3)) << 16)); | |
| 810 } | |
| 811 | |
| 812 /* Make sure the table is aligned, and move it around if it's not. */ | |
| 813 static void | |
| 814 align_the_damn_table (void *unrangetab) | |
| 815 { | |
| 816 void *cur_dest = (char *) unrangetab + * (char *) unrangetab; | |
| 826 | 817 if (cur_dest != ALIGN_PTR (cur_dest, EMACS_INT)) |
| 428 | 818 { |
| 819 int count = (unified_range_table_bytes_used (unrangetab) - 4 | |
| 820 - ALIGNOF (EMACS_INT)); | |
| 821 /* Find the proper location, just like above. */ | |
| 826 | 822 void *new_dest = ALIGN_PTR ((char *) unrangetab + 4, EMACS_INT); |
| 428 | 823 /* memmove() works in the presence of overlapping data. */ |
| 824 memmove (new_dest, cur_dest, count); | |
| 825 * (char *) unrangetab = (char) ((char *) new_dest - (char *) unrangetab); | |
| 826 } | |
| 827 } | |
| 828 | |
| 829 /* Look up a value in a unified range table. */ | |
| 830 | |
| 831 Lisp_Object | |
| 832 unified_range_table_lookup (void *unrangetab, EMACS_INT pos, | |
| 833 Lisp_Object default_) | |
| 834 { | |
| 835 void *new_dest; | |
| 836 struct unified_range_table *un; | |
| 837 | |
| 838 align_the_damn_table (unrangetab); | |
| 839 new_dest = (char *) unrangetab + * (char *) unrangetab; | |
| 840 un = (struct unified_range_table *) new_dest; | |
| 841 | |
| 842 return get_range_table (pos, un->nentries, &un->first, default_); | |
| 843 } | |
| 844 | |
| 845 /* Return number of entries in a unified range table. */ | |
| 846 | |
| 847 int | |
| 848 unified_range_table_nentries (void *unrangetab) | |
| 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 return un->nentries; | |
| 857 } | |
| 858 | |
| 859 /* Return the OFFSETth range (counting from 0) in UNRANGETAB. */ | |
| 860 void | |
| 861 unified_range_table_get_range (void *unrangetab, int offset, | |
| 862 EMACS_INT *min, EMACS_INT *max, | |
| 863 Lisp_Object *val) | |
| 864 { | |
| 865 void *new_dest; | |
| 866 struct unified_range_table *un; | |
| 867 struct range_table_entry *tab; | |
| 868 | |
| 869 align_the_damn_table (unrangetab); | |
| 870 new_dest = (char *) unrangetab + * (char *) unrangetab; | |
| 871 un = (struct unified_range_table *) new_dest; | |
| 872 | |
| 873 assert (offset >= 0 && offset < un->nentries); | |
| 874 tab = (&un->first) + offset; | |
| 875 *min = tab->first; | |
| 876 *max = tab->last; | |
| 877 *val = tab->val; | |
| 878 } | |
| 879 | |
| 880 | |
| 881 /************************************************************************/ | |
| 882 /* Initialization */ | |
| 883 /************************************************************************/ | |
| 884 | |
| 885 void | |
| 886 syms_of_rangetab (void) | |
| 887 { | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
888 INIT_LISP_OBJECT (range_table); |
| 442 | 889 |
| 563 | 890 DEFSYMBOL_MULTIWORD_PREDICATE (Qrange_tablep); |
| 891 DEFSYMBOL (Qrange_table); | |
| 428 | 892 |
| 2421 | 893 DEFSYMBOL (Qstart_closed_end_open); |
| 894 DEFSYMBOL (Qstart_open_end_open); | |
| 895 DEFSYMBOL (Qstart_closed_end_closed); | |
| 896 DEFSYMBOL (Qstart_open_end_closed); | |
| 897 | |
| 428 | 898 DEFSUBR (Frange_table_p); |
| 2421 | 899 DEFSUBR (Frange_table_type); |
| 428 | 900 DEFSUBR (Fmake_range_table); |
| 901 DEFSUBR (Fcopy_range_table); | |
| 902 DEFSUBR (Fget_range_table); | |
| 903 DEFSUBR (Fput_range_table); | |
| 904 DEFSUBR (Fremove_range_table); | |
| 905 DEFSUBR (Fclear_range_table); | |
| 906 DEFSUBR (Fmap_range_table); | |
| 907 } | |
| 908 | |
| 909 void | |
| 910 structure_type_create_rangetab (void) | |
| 911 { | |
| 912 struct structure_type *st; | |
| 913 | |
| 914 st = define_structure_type (Qrange_table, 0, rangetab_instantiate); | |
| 915 | |
| 916 define_structure_type_keyword (st, Qdata, rangetab_data_validate); | |
| 2421 | 917 define_structure_type_keyword (st, Qtype, rangetab_type_validate); |
| 428 | 918 } |