src/rangetab.c

   1 /* XEmacs routines to deal with range tables.
   2    Copyright (C) 1995 Sun Microsystems, Inc.
   3    Copyright (C) 1995 Ben Wing.
   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
  33 \f
  34 /************************************************************************/
  35 /*                            Range table object                        */
  36 /************************************************************************/
  37
  38 /* We use a sorted array of ranges.
  39
  40    #### We should be using the gap array stuff from extents.c.  This
  41    is not hard but just requires moving that stuff out of that file. */
  42
  43 static Lisp_Object
  44 mark_range_table (Lisp_Object obj)
  45 {
  46   Lisp_Range_Table *rt = XRANGE_TABLE (obj);
  47   int i;
  48
  49   for (i = 0; i < Dynarr_length (rt->entries); i++)
  50     mark_object (Dynarr_at (rt->entries, i).val);
  51   return Qnil;
  52 }
  53
  54 static void
  55 print_range_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
  56 {
  57   Lisp_Range_Table *rt = XRANGE_TABLE (obj);
  58   char buf[200];
  59   int i;
  60
  61   write_c_string ("#s(range-table data (", printcharfun);
  62   for (i = 0; i < Dynarr_length (rt->entries); i++)
  63     {
  64       struct range_table_entry *rte = Dynarr_atp (rt->entries, i);
  65       if (i > 0)
  66         write_c_string (" ", printcharfun);
  67       if (rte->first == rte->last)
  68         sprintf (buf, "%ld ", (long) (rte->first));
  69       else
  70         sprintf (buf, "(%ld %ld) ", (long) (rte->first), (long) (rte->last));
  71       write_c_string (buf, printcharfun);
  72       print_internal (rte->val, printcharfun, 1);
  73     }
  74   write_c_string ("))", printcharfun);
  75 }
  76
  77 static int
  78 range_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
  79 {
  80   Lisp_Range_Table *rt1 = XRANGE_TABLE (obj1);
  81   Lisp_Range_Table *rt2 = XRANGE_TABLE (obj2);
  82   int i;
  83
  84   if (Dynarr_length (rt1->entries) != Dynarr_length (rt2->entries))
  85     return 0;
  86
  87   for (i = 0; i < Dynarr_length (rt1->entries); i++)
  88     {
  89       struct range_table_entry *rte1 = Dynarr_atp (rt1->entries, i);
  90       struct range_table_entry *rte2 = Dynarr_atp (rt2->entries, i);
  91
  92       if (rte1->first != rte2->first
  93           || rte1->last != rte2->last
  94           || !internal_equal (rte1->val, rte2->val, depth + 1))
  95         return 0;
  96     }
  97
  98   return 1;
  99 }
 100
 101 static unsigned long
 102 range_table_entry_hash (struct range_table_entry *rte, int depth)
 103 {
 104   return HASH3 (rte->first, rte->last, internal_hash (rte->val, depth + 1));
 105 }
 106
 107 static unsigned long
 108 range_table_hash (Lisp_Object obj, int depth)
 109 {
 110   Lisp_Range_Table *rt = XRANGE_TABLE (obj);
 111   int i;
 112   int size = Dynarr_length (rt->entries);
 113   unsigned long hash = size;
 114
 115   /* approach based on internal_array_hash(). */
 116   if (size <= 5)
 117     {
 118       for (i = 0; i < size; i++)
 119         hash = HASH2 (hash,
 120                       range_table_entry_hash (Dynarr_atp (rt->entries, i),
 121                                               depth));
 122       return hash;
 123     }
 124
 125   /* just pick five elements scattered throughout the array.
 126      A slightly better approach would be to offset by some
 127      noise factor from the points chosen below. */
 128   for (i = 0; i < 5; i++)
 129     hash = HASH2 (hash, range_table_entry_hash (Dynarr_atp (rt->entries,
 130                                                             i*size/5),
 131                                                 depth));
 132   return hash;
 133 }
 134
 135 static const struct lrecord_description rte_description_1[] = {
 136   { XD_LISP_OBJECT, offsetof (range_table_entry, val) },
 137   { XD_END }
 138 };
 139
 140 static const struct struct_description rte_description = {
 141   sizeof (range_table_entry),
 142   rte_description_1
 143 };
 144
 145 static const struct lrecord_description rted_description_1[] = {
 146   XD_DYNARR_DESC (range_table_entry_dynarr, &rte_description),
 147   { XD_END }
 148 };
 149
 150 static const struct struct_description rted_description = {
 151   sizeof (range_table_entry_dynarr),
 152   rted_description_1
 153 };
 154
 155 static const struct lrecord_description range_table_description[] = {
 156   { XD_STRUCT_PTR,  offsetof (Lisp_Range_Table, entries),  1, &rted_description },
 157   { XD_END }
 158 };
 159
 160 DEFINE_LRECORD_IMPLEMENTATION ("range-table", range_table,
 161                                mark_range_table, print_range_table, 0,
 162                                range_table_equal, range_table_hash,
 163                                range_table_description,
 164                                Lisp_Range_Table);
 165 \f
 166 /************************************************************************/
 167 /*                        Range table operations                        */
 168 /************************************************************************/
 169
 170 #ifdef ERROR_CHECK_TYPECHECK
 171
 172 static void
 173 verify_range_table (Lisp_Range_Table *rt)
 174 {
 175   int i;
 176
 177   for (i = 0; i < Dynarr_length (rt->entries); i++)
 178     {
 179       struct range_table_entry *rte = Dynarr_atp (rt->entries, i);
 180       assert (rte->last >= rte->first);
 181       if (i > 0)
 182         assert (Dynarr_at (rt->entries, i - 1).last < rte->first);
 183     }
 184 }
 185
 186 #else
 187
 188 #define verify_range_table(rt)
 189
 190 #endif
 191
 192 /* Look up in a range table without the Dynarr wrapper.
 193    Used also by the unified range table format. */
 194
 195 static Lisp_Object
 196 get_range_table (EMACS_INT pos, int nentries, struct range_table_entry *tab,
 197                  Lisp_Object default_)
 198 {
 199   int left = 0, right = nentries;
 200
 201   /* binary search for the entry.  Based on similar code in
 202      extent_list_locate(). */
 203   while (left != right)
 204     {
 205       /* RIGHT might not point to a valid entry (i.e. it's at the end
 206          of the list), so NEWPOS must round down. */
 207       unsigned int newpos = (left + right) >> 1;
 208       struct range_table_entry *entry = tab + newpos;
 209       if (pos > entry->last)
 210         left = newpos+1;
 211       else if (pos < entry->first)
 212         right = newpos;
 213       else
 214         return entry->val;
 215     }
 216
 217   return default_;
 218 }
 219
 220 DEFUN ("range-table-p", Frange_table_p, 1, 1, 0, /*
 221 Return non-nil if OBJECT is a range table.
 222 */
 223        (object))
 224 {
 225   return RANGE_TABLEP (object) ? Qt : Qnil;
 226 }
 227
 228 DEFUN ("make-range-table", Fmake_range_table, 0, 0, 0, /*
 229 Return a new, empty range table.
 230 You can manipulate it using `put-range-table', `get-range-table',
 231 `remove-range-table', and `clear-range-table'.
 232 */
 233        ())
 234 {
 235   Lisp_Object obj;
 236   Lisp_Range_Table *rt = alloc_lcrecord_type (Lisp_Range_Table,
 237                                               &lrecord_range_table);
 238   rt->entries = Dynarr_new (range_table_entry);
 239   XSETRANGE_TABLE (obj, rt);
 240   return obj;
 241 }
 242
 243 DEFUN ("copy-range-table", Fcopy_range_table, 1, 1, 0, /*
 244 Return a new range table which is a copy of RANGE-TABLE.
 245 It will contain the same values for the same ranges as RANGE-TABLE.
 246 The values will not themselves be copied.
 247 */
 248        (range_table))
 249 {
 250   Lisp_Range_Table *rt, *rtnew;
 251   Lisp_Object obj;
 252
 253   CHECK_RANGE_TABLE (range_table);
 254   rt = XRANGE_TABLE (range_table);
 255
 256   rtnew = alloc_lcrecord_type (Lisp_Range_Table, &lrecord_range_table);
 257   rtnew->entries = Dynarr_new (range_table_entry);
 258
 259   Dynarr_add_many (rtnew->entries, Dynarr_atp (rt->entries, 0),
 260                    Dynarr_length (rt->entries));
 261   XSETRANGE_TABLE (obj, rtnew);
 262   return obj;
 263 }
 264
 265 DEFUN ("get-range-table", Fget_range_table, 2, 3, 0, /*
 266 Find value for position POS in RANGE-TABLE.
 267 If there is no corresponding value, return DEFAULT (defaults to nil).
 268 */
 269        (pos, range_table, default_))
 270 {
 271   Lisp_Range_Table *rt;
 272
 273   CHECK_RANGE_TABLE (range_table);
 274   rt = XRANGE_TABLE (range_table);
 275
 276   CHECK_INT_COERCE_CHAR (pos);
 277
 278   return get_range_table (XINT (pos), Dynarr_length (rt->entries),
 279                           Dynarr_atp (rt->entries, 0), default_);
 280 }
 281
 282 void
 283 put_range_table (Lisp_Object table, EMACS_INT first,
 284                  EMACS_INT last, Lisp_Object val)
 285 {
 286   int i;
 287   int insert_me_here = -1;
 288   Lisp_Range_Table *rt = XRANGE_TABLE (table);
 289
 290   /* Now insert in the proper place.  This gets tricky because
 291      we may be overlapping one or more existing ranges and need
 292      to fix them up. */
 293
 294   /* First delete all sections of any existing ranges that overlap
 295      the new range. */
 296   for (i = 0; i < Dynarr_length (rt->entries); i++)
 297     {
 298       struct range_table_entry *entry = Dynarr_atp (rt->entries, i);
 299       /* We insert before the first range that begins at or after the
 300          new range. */
 301       if (entry->first >= first && insert_me_here < 0)
 302         insert_me_here = i;
 303       if (entry->last < first)
 304         /* completely before the new range. */
 305         continue;
 306       if (entry->first > last)
 307         /* completely after the new range.  No more possibilities of
 308            finding overlapping ranges. */
 309         break;
 310       if (entry->first < first && entry->last <= last)
 311         {
 312           /* looks like:
 313
 314                          [ NEW ]
 315                  [ EXISTING ]
 316
 317            */
 318           /* truncate the end off of it. */
 319           entry->last = first - 1;
 320         }
 321       else if (entry->first < first && entry->last > last)
 322         /* looks like:
 323
 324                  [ NEW ]
 325                [ EXISTING ]
 326
 327          */
 328         /* need to split this one in two. */
 329         {
 330           struct range_table_entry insert_me_too;
 331
 332           insert_me_too.first = last + 1;
 333           insert_me_too.last = entry->last;
 334           insert_me_too.val = entry->val;
 335           entry->last = first - 1;
 336           Dynarr_insert_many (rt->entries, &insert_me_too, 1, i + 1);
 337         }
 338       else if (entry->last > last)
 339         {
 340           /* looks like:
 341
 342                [ NEW ]
 343                  [ EXISTING ]
 344
 345            */
 346           /* truncate the start off of it. */
 347           entry->first = last + 1;
 348         }
 349       else
 350         {
 351           /* existing is entirely within new. */
 352           Dynarr_delete_many (rt->entries, i, 1);
 353           i--; /* back up since everything shifted one to the left. */
 354         }
 355     }
 356
 357   /* Someone asked us to delete the range, not insert it. */
 358   if (UNBOUNDP (val))
 359     return;
 360
 361   /* Now insert the new entry, maybe at the end. */
 362
 363   if (insert_me_here < 0)
 364     insert_me_here = i;
 365
 366   {
 367     struct range_table_entry insert_me;
 368
 369     insert_me.first = first;
 370     insert_me.last = last;
 371     insert_me.val = val;
 372
 373     Dynarr_insert_many (rt->entries, &insert_me, 1, insert_me_here);
 374   }
 375
 376   /* Now see if we can combine this entry with adjacent ones just
 377      before or after. */
 378
 379   if (insert_me_here > 0)
 380     {
 381       struct range_table_entry *entry = Dynarr_atp (rt->entries,
 382                                                     insert_me_here - 1);
 383       if (EQ (val, entry->val) && entry->last == first - 1)
 384         {
 385           entry->last = last;
 386           Dynarr_delete_many (rt->entries, insert_me_here, 1);
 387           insert_me_here--;
 388           /* We have morphed into a larger range.  Update our records
 389              in case we also combine with the one after. */
 390           first = entry->first;
 391         }
 392     }
 393
 394   if (insert_me_here < Dynarr_length (rt->entries) - 1)
 395     {
 396       struct range_table_entry *entry = Dynarr_atp (rt->entries,
 397                                                     insert_me_here + 1);
 398       if (EQ (val, entry->val) && entry->first == last + 1)
 399         {
 400           entry->first = first;
 401           Dynarr_delete_many (rt->entries, insert_me_here, 1);
 402         }
 403     }
 404 }
 405
 406 DEFUN ("put-range-table", Fput_range_table, 4, 4, 0, /*
 407 Set the value for range (START, END) to be VALUE in RANGE-TABLE.
 408 */
 409        (start, end, value, range_table))
 410 {
 411   EMACS_INT first, last;
 412
 413   CHECK_RANGE_TABLE (range_table);
 414   CHECK_INT_COERCE_CHAR (start);
 415   first = XINT (start);
 416   CHECK_INT_COERCE_CHAR (end);
 417   last = XINT (end);
 418   if (first > last)
 419     signal_simple_error_2 ("start must be <= end", start, end);
 420
 421   put_range_table (range_table, first, last, value);
 422   verify_range_table (XRANGE_TABLE (range_table));
 423   return Qnil;
 424 }
 425
 426 DEFUN ("remove-range-table", Fremove_range_table, 3, 3, 0, /*
 427 Remove the value for range (START, END) in RANGE-TABLE.
 428 */
 429        (start, end, range_table))
 430 {
 431   return Fput_range_table (start, end, Qunbound, range_table);
 432 }
 433
 434 DEFUN ("clear-range-table", Fclear_range_table, 1, 1, 0, /*
 435 Flush RANGE-TABLE.
 436 */
 437        (range_table))
 438 {
 439   CHECK_RANGE_TABLE (range_table);
 440   Dynarr_reset (XRANGE_TABLE (range_table)->entries);
 441   return Qnil;
 442 }
 443
 444 DEFUN ("map-range-table", Fmap_range_table, 2, 2, 0, /*
 445 Map FUNCTION over entries in RANGE-TABLE, calling it with three args,
 446 the beginning and end of the range and the corresponding value.
 447
 448 Results are guaranteed to be correct (i.e. each entry processed
 449 exactly once) if FUNCTION modifies or deletes the current entry
 450 \(i.e. passes the current range to `put-range-table' or
 451 `remove-range-table'), but not otherwise.
 452 */
 453        (function, range_table))
 454 {
 455   Lisp_Range_Table *rt;
 456   int i;
 457
 458   CHECK_RANGE_TABLE (range_table);
 459   CHECK_FUNCTION (function);
 460
 461   rt = XRANGE_TABLE (range_table);
 462
 463   /* Do not "optimize" by pulling out the length computation below!
 464      FUNCTION may have changed the table. */
 465   for (i = 0; i < Dynarr_length (rt->entries); i++)
 466     {
 467       struct range_table_entry *entry = Dynarr_atp (rt->entries, i);
 468       EMACS_INT first, last;
 469       Lisp_Object args[4];
 470       int oldlen;
 471
 472     again:
 473       first = entry->first;
 474       last = entry->last;
 475       oldlen = Dynarr_length (rt->entries);
 476       args[0] = function;
 477       args[1] = make_int (first);
 478       args[2] = make_int (last);
 479       args[3] = entry->val;
 480       Ffuncall (countof (args), args);
 481       /* Has FUNCTION removed the entry? */
 482       if (oldlen > Dynarr_length (rt->entries)
 483           && i < Dynarr_length (rt->entries)
 484           && (first != entry->first || last != entry->last))
 485         goto again;
 486       }
 487
 488   return Qnil;
 489 }
 490
 491 \f
 492 /************************************************************************/
 493 /*                         Range table read syntax                      */
 494 /************************************************************************/
 495
 496 static int
 497 rangetab_data_validate (Lisp_Object keyword, Lisp_Object value,
 498                         Error_behavior errb)
 499 {
 500   Lisp_Object rest;
 501
 502   /* #### should deal with errb */
 503   EXTERNAL_LIST_LOOP (rest, value)
 504     {
 505       Lisp_Object range = XCAR (rest);
 506       rest = XCDR (rest);
 507       if (!CONSP (rest))
 508         signal_simple_error ("Invalid list format", value);
 509       if (!INTP (range) && !CHARP (range)
 510           && !(CONSP (range) && CONSP (XCDR (range))
 511                && NILP (XCDR (XCDR (range)))
 512                && (INTP (XCAR (range)) || CHARP (XCAR (range)))
 513                && (INTP (XCAR (XCDR (range))) || CHARP (XCAR (XCDR (range))))))
 514         signal_simple_error ("Invalid range format", range);
 515     }
 516
 517   return 1;
 518 }
 519
 520 static Lisp_Object
 521 rangetab_instantiate (Lisp_Object data)
 522 {
 523   Lisp_Object rangetab = Fmake_range_table ();
 524
 525   if (!NILP (data))
 526     {
 527       data = Fcar (Fcdr (data)); /* skip over 'data keyword */
 528       while (!NILP (data))
 529         {
 530           Lisp_Object range = Fcar (data);
 531           Lisp_Object val = Fcar (Fcdr (data));
 532
 533           data = Fcdr (Fcdr (data));
 534           if (CONSP (range))
 535             Fput_range_table (Fcar (range), Fcar (Fcdr (range)), val,
 536                               rangetab);
 537           else
 538             Fput_range_table (range, range, val, rangetab);
 539         }
 540     }
 541
 542   return rangetab;
 543 }
 544
 545 \f
 546 /************************************************************************/
 547 /*                         Unified range tables                         */
 548 /************************************************************************/
 549
 550 /* A "unified range table" is a format for storing range tables
 551    as contiguous blocks of memory.  This is used by the regexp
 552    code, which needs to use range tables to properly handle []
 553    constructs in the presence of extended characters but wants to
 554    store an entire compiled pattern as a contiguous block of memory.
 555
 556    Unified range tables are designed so that they can be placed
 557    at an arbitrary (possibly mis-aligned) place in memory.
 558    (Dealing with alignment is a pain in the ass.)
 559
 560    WARNING: No provisions for garbage collection are currently made.
 561    This means that there must not be any Lisp objects in a unified
 562    range table that need to be marked for garbage collection.
 563    Good candidates for objects that can go into a range table are
 564
 565    -- numbers and characters (do not need to be marked)
 566    -- nil, t (marked elsewhere)
 567    -- charsets and coding systems (automatically marked because
 568                                    they are in a marked list,
 569                                    and can't be removed)
 570
 571    Good but slightly less so:
 572
 573    -- symbols (could be uninterned, but that is not likely)
 574
 575    Somewhat less good:
 576
 577    -- buffers, frames, devices (could get deleted)
 578
 579
 580    It is expected that you work with range tables in the normal
 581    format and then convert to unified format when you are done
 582    making modifications.  As such, no functions are provided
 583    for modifying a unified range table.  The only operations
 584    you can do to unified range tables are
 585
 586    -- look up a value
 587    -- retrieve all the ranges in an iterative fashion
 588
 589 */
 590
 591 /* The format of a unified range table is as follows:
 592
 593    -- The first byte contains the number of bytes to skip to find the
 594       actual start of the table.  This deals with alignment constraints,
 595       since the table might want to go at any arbitrary place in memory.
 596    -- The next three bytes contain the number of bytes to skip (from the
 597       *first* byte) to find the stuff after the table.  It's stored in
 598       little-endian format because that's how God intended things.  We don't
 599       necessarily start the stuff at the very end of the table because
 600       we want to have at least ALIGNOF (EMACS_INT) extra space in case
 601       we have to move the range table around. (It appears that some
 602       architectures don't maintain alignment when reallocing.)
 603    -- At the prescribed offset is a struct unified_range_table, containing
 604       some number of `struct range_table_entry' entries. */
 605
 606 struct unified_range_table
 607 {
 608   int nentries;
 609   struct range_table_entry first;
 610 };
 611
 612 /* Return size in bytes needed to store the data in a range table. */
 613
 614 int
 615 unified_range_table_bytes_needed (Lisp_Object rangetab)
 616 {
 617   return (sizeof (struct range_table_entry) *
 618           (Dynarr_length (XRANGE_TABLE (rangetab)->entries) - 1) +
 619           sizeof (struct unified_range_table) +
 620           /* ALIGNOF a struct may be too big. */
 621           /* We have four bytes for the size numbers, and an extra
 622              four or eight bytes for making sure we get the alignment
 623              OK. */
 624           ALIGNOF (EMACS_INT) + 4);
 625 }
 626
 627 /* Convert a range table into unified format and store in DEST,
 628    which must be able to hold the number of bytes returned by
 629    range_table_bytes_needed(). */
 630
 631 void
 632 unified_range_table_copy_data (Lisp_Object rangetab, void *dest)
 633 {
 634   /* We cast to the above structure rather than just casting to
 635      char * and adding sizeof(int), because that will lead to
 636      mis-aligned data on the Alpha machines. */
 637   struct unified_range_table *un;
 638   range_table_entry_dynarr *rted = XRANGE_TABLE (rangetab)->entries;
 639   int total_needed = unified_range_table_bytes_needed (rangetab);
 640   void *new_dest = ALIGN_PTR ((char *) dest + 4, ALIGNOF (EMACS_INT));
 641
 642   * (char *) dest = (char) ((char *) new_dest - (char *) dest);
 643   * ((unsigned char *) dest + 1) = total_needed & 0xFF;
 644   total_needed >>= 8;
 645   * ((unsigned char *) dest + 2) = total_needed & 0xFF;
 646   total_needed >>= 8;
 647   * ((unsigned char *) dest + 3) = total_needed & 0xFF;
 648   un = (struct unified_range_table *) new_dest;
 649   un->nentries = Dynarr_length (rted);
 650   memcpy (&un->first, Dynarr_atp (rted, 0),
 651           sizeof (struct range_table_entry) * Dynarr_length (rted));
 652 }
 653
 654 /* Return number of bytes actually used by a unified range table. */
 655
 656 int
 657 unified_range_table_bytes_used (void *unrangetab)
 658 {
 659   return ((* ((unsigned char *) unrangetab + 1))
 660           + ((* ((unsigned char *) unrangetab + 2)) << 8)
 661           + ((* ((unsigned char *) unrangetab + 3)) << 16));
 662 }
 663
 664 /* Make sure the table is aligned, and move it around if it's not. */
 665 static void
 666 align_the_damn_table (void *unrangetab)
 667 {
 668   void *cur_dest = (char *) unrangetab + * (char *) unrangetab;
 669 #if LONGBITS == 64
 670   if ((((long) cur_dest) & 7) != 0)
 671 #else
 672   if ((((int) cur_dest) & 3) != 0)
 673 #endif
 674     {
 675       int count = (unified_range_table_bytes_used (unrangetab) - 4
 676                    - ALIGNOF (EMACS_INT));
 677       /* Find the proper location, just like above. */
 678       void *new_dest = ALIGN_PTR ((char *) unrangetab + 4,
 679                                   ALIGNOF (EMACS_INT));
 680       /* memmove() works in the presence of overlapping data. */
 681       memmove (new_dest, cur_dest, count);
 682       * (char *) unrangetab = (char) ((char *) new_dest - (char *) unrangetab);
 683     }
 684 }
 685
 686 /* Look up a value in a unified range table. */
 687
 688 Lisp_Object
 689 unified_range_table_lookup (void *unrangetab, EMACS_INT pos,
 690                             Lisp_Object default_)
 691 {
 692   void *new_dest;
 693   struct unified_range_table *un;
 694
 695   align_the_damn_table (unrangetab);
 696   new_dest = (char *) unrangetab + * (char *) unrangetab;
 697   un = (struct unified_range_table *) new_dest;
 698
 699   return get_range_table (pos, un->nentries, &un->first, default_);
 700 }
 701
 702 /* Return number of entries in a unified range table. */
 703
 704 int
 705 unified_range_table_nentries (void *unrangetab)
 706 {
 707   void *new_dest;
 708   struct unified_range_table *un;
 709
 710   align_the_damn_table (unrangetab);
 711   new_dest = (char *) unrangetab + * (char *) unrangetab;
 712   un = (struct unified_range_table *) new_dest;
 713   return un->nentries;
 714 }
 715
 716 /* Return the OFFSETth range (counting from 0) in UNRANGETAB. */
 717 void
 718 unified_range_table_get_range (void *unrangetab, int offset,
 719                                EMACS_INT *min, EMACS_INT *max,
 720                                Lisp_Object *val)
 721 {
 722   void *new_dest;
 723   struct unified_range_table *un;
 724   struct range_table_entry *tab;
 725
 726   align_the_damn_table (unrangetab);
 727   new_dest = (char *) unrangetab + * (char *) unrangetab;
 728   un = (struct unified_range_table *) new_dest;
 729
 730   assert (offset >= 0 && offset < un->nentries);
 731   tab = (&un->first) + offset;
 732   *min = tab->first;
 733   *max = tab->last;
 734   *val = tab->val;
 735 }
 736
 737 \f
 738 /************************************************************************/
 739 /*                            Initialization                            */
 740 /************************************************************************/
 741
 742 void
 743 syms_of_rangetab (void)
 744 {
 745   INIT_LRECORD_IMPLEMENTATION (range_table);
 746
 747   defsymbol (&Qrange_tablep, "range-table-p");
 748   defsymbol (&Qrange_table, "range-table");
 749
 750   DEFSUBR (Frange_table_p);
 751   DEFSUBR (Fmake_range_table);
 752   DEFSUBR (Fcopy_range_table);
 753   DEFSUBR (Fget_range_table);
 754   DEFSUBR (Fput_range_table);
 755   DEFSUBR (Fremove_range_table);
 756   DEFSUBR (Fclear_range_table);
 757   DEFSUBR (Fmap_range_table);
 758 }
 759
 760 void
 761 structure_type_create_rangetab (void)
 762 {
 763   struct structure_type *st;
 764
 765   st = define_structure_type (Qrange_table, 0, rangetab_instantiate);
 766
 767   define_structure_type_keyword (st, Qdata, rangetab_data_validate);
 768 }