cgit.sxemacs.org Git - sxemacs/blob - src/skiplist.c

   1 /*** skiplist.c -- Pugh's Skiplists
   2  *
   3  * Copyright (C) 2006, 2007, 2008 Sebastian Freundt
   4  *
   5  * Author:  Sebastian Freundt <hroptatyr@sxemacs.org>
   6  *
   7  * This file is part of SXEmacs.
   8  *
   9  * Redistribution and use in source and binary forms, with or without
  10  * modification, are permitted provided that the following conditions
  11  * are met:
  12  *
  13  * 1. Redistributions of source code must retain the above copyright
  14  *    notice, this list of conditions and the following disclaimer.
  15  *
  16  * 2. Redistributions in binary form must reproduce the above copyright
  17  *    notice, this list of conditions and the following disclaimer in the
  18  *    documentation and/or other materials provided with the distribution.
  19  *
  20  * 3. Neither the name of the author nor the names of any contributors
  21  *    may be used to endorse or promote products derived from this
  22  *    software without specific prior written permission.
  23  *
  24  * THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
  25  * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  26  * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  27  * DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  28  * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  29  * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  30  * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
  31  * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  32  * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
  33  * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
  34  * IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  35  *
  36  ***/
  37
  38 /* Synched up with: Not in FSF. */
  39
  40 #include <config.h>
  41
  42 #include "lisp.h"
  43
  44 #include "buffer.h"
  45 #include "sysdep.h"
  46 #include "lrecord.h"
  47 #include "lstream.h"
  48
  49 /* for __ase_ffs() */
  50 #include "ent/ent.h"
  51 #include "skiplist.h"
  52
  53 #define __SKIPLIST_DEBUG__(args...)     fprintf(stderr, "SKIPLIST " args)
  54 #ifndef SKIPLIST_DEBUG_FLAG
  55 #define SL_DEBUG(args...)
  56 #else
  57 #define SL_DEBUG(args...)               __SKIPLIST_DEBUG__(args)
  58 #endif
  59 #define SL_CRITICAL(args...)            __SKIPLIST_DEBUG__("CRITICAL: " args)
  60 #define SL_DEBUG_LEVEL(args...)         SL_DEBUG("[level]: " args)
  61 #define SL_DEBUG_NODE(args...)          SL_DEBUG("[node]: " args)
  62 #define SL_DEBUG_DATA(args...)          SL_DEBUG("[data]: " args)
  63 #define SL_DEBUG_PATH(args...)          SL_DEBUG("[path]: " args)
  64
  65 #define ALIGNED(n)      __attribute__((aligned(n), packed))
  66
  67 Lisp_Object Qskiplistp;
  68
  69 \f
  70 struct skiplist_data_s {
  71         hcode_t hash;
  72         Lisp_Object key;
  73         Lisp_Object value;
  74 };
  75
  76 struct skiplist_level_s {
  77         skiplist_level_t nextnode;  /* pointer to neighbour node */
  78         skiplist_level_t nextlevel; /* pointer to above level */
  79         skiplist_node_t node;   /* parent */
  80 };
  81
  82 struct skiplist_node_s {
  83         skiplist_level_t head;  /* pointer to first level */
  84         skiplist_level_t foot;  /* pointer to lowest level */
  85         size_t nlevels;         /* number of levels in this node */
  86
  87         struct skiplist_data_s data;    /* pointer to node's data cell */
  88 };
  89
  90 /* paths stuff, just internal */
  91 #define skiplist_path_nil               (skiplist_level_t)NULL
  92
  93 /* inlines */
  94 static inline size_t
  95 skiplist_size(const skiplist_t sl)
  96         __attribute__((always_inline));
  97 static inline size_t
  98 skiplist_size(const skiplist_t sl)
  99 {
 100         /* what a fooking name, no? */
 101         return (size_t)skiplist_nnodes(sl);
 102 }
 103
 104 /* static bindings */
 105 /* low level bindings */
 106 static skiplist_level_t make_skiplist_levels(skiplist_node_t, size_t);
 107
 108 static inline int
 109 skiplist_find_key_path(skiplist_t, Lisp_Object, skiplist_level_t[])
 110         __attribute__((always_inline));
 111 static inline int
 112 skiplist_find_hash_path(skiplist_t, hcode_t, skiplist_level_t[])
 113         __attribute__((always_inline));
 114 static inline skiplist_level_t
 115 skiplist_find_hash_return_level(skiplist_t, hcode_t)
 116         __attribute__((always_inline));
 117
 118 /* high level bindings */
 119 \f
 120 /* low level bindings */
 121 #define node_head_level(node)   (node)->head
 122 #define node_foot_level(node)   (node)->foot
 123 #define node_data(node)         (node)->data
 124 #define node_nlevels(node)      (node)->nlevels
 125 #define node_data_hash(node)    (node)->data.hash
 126 #define node_data_key(node)     (node)->data.key
 127 #define node_data_value(node)   (node)->data.value
 128
 129 #define next_node(level)        (level)->nextnode
 130 #define next_level(level)       (level)->nextlevel
 131 #define parent_node(level)      (level)->node
 132
 133 #define next_hash(level)        node_data_hash(parent_node(next_node(level)))
 134 #define next_key(level)         node_data_key(parent_node(next_node(level)))
 135 #define next_value(level)       node_data_value(parent_node(next_node(level)))
 136
 137 #define level_hash(l)                                                   \
 138         (l ? (l->node) ? (l->node->data.hash) : 0 : 0)
 139 #define level_key(l)                                                    \
 140         (l ? (l->node) ? (l->node->data.key) : 0 : 0)
 141
 142 /* static hcode_t skiplist_hash(Lisp_Object); */
 143 #define skiplist_hash(obj)      internal_hash((obj), 0)
 144 #define skiplist_keyeq(o1, o2)  internal_equal((o1), (o2), 0)
 145
 146 /* this is p^n - 1 */
 147 /* here: p=2 n=2 */
 148 #define SL_PROBABILITY_MASK     3
 149
 150 \f
 151 static inline skiplist_level_t
 152 make_skiplist_levels(skiplist_node_t node, size_t nlevels)
 153         __attribute__((always_inline));
 154 static inline skiplist_level_t
 155 make_skiplist_levels(skiplist_node_t node, size_t nlevels)
 156 {
 157 /* creates an array of NLEVEL levels and returns a pointer */
 158         skiplist_level_t levels =
 159                 xnew_array(struct skiplist_level_s, nlevels+1);
 160
 161         /* initialise the parent, it's at least one level we hope */
 162         parent_node(levels) = node;
 163         next_level(levels) = NULL;
 164         next_node(levels) = NULL;
 165         while (nlevels > 0) {
 166                 levels[nlevels].node = node;
 167                 levels[nlevels].nextnode = NULL;
 168                 levels[nlevels].nextlevel = &levels[nlevels-1];
 169                 --nlevels;
 170         }
 171         return levels;
 172 }
 173
 174 static inline void
 175 __fill_skiplist_node(skiplist_node_t n, hcode_t h,
 176                      Lisp_Object key, Lisp_Object value)
 177         __attribute__((always_inline));
 178 static inline void
 179 __fill_skiplist_node(skiplist_node_t n, hcode_t h,
 180                      Lisp_Object key, Lisp_Object value)
 181 {
 182         /* initialise an empty node */
 183         node_data_hash(n) = h;
 184         node_data_key(n) = key;
 185         node_data_value(n) = value;
 186         return;
 187 }
 188
 189 static inline skiplist_node_t
 190 _make_skiplist_node(hcode_t h, Lisp_Object key, Lisp_Object val, size_t nl)
 191         __attribute__((always_inline));
 192 static inline skiplist_node_t
 193 _make_skiplist_node(hcode_t h, Lisp_Object key, Lisp_Object val, size_t nl)
 194 {
 195         skiplist_node_t node = xnew_and_zero(struct skiplist_node_s);
 196         skiplist_level_t levs = make_skiplist_levels(node, nl);
 197
 198         /* fill in the values */
 199         __fill_skiplist_node(node, h, key, val);
 200
 201         node->nlevels = nl;
 202         node->foot = levs;
 203         node->head = &(levs[nl]);
 204         return node;
 205 }
 206
 207 static inline skiplist_node_t
 208 make_skiplist_node(Lisp_Object key, Lisp_Object value, size_t nlevels)
 209         __attribute__((always_inline));
 210 static inline skiplist_node_t
 211 make_skiplist_node(Lisp_Object key, Lisp_Object value, size_t nlevels)
 212 {
 213         return _make_skiplist_node(skiplist_hash(key), key, value, nlevels);
 214 }
 215
 216 static inline skiplist_level_t
 217 raise_head_level(skiplist_t sl)
 218 {
 219         skiplist_nlevels(sl)++;
 220         return skiplist_head(sl);
 221 }
 222
 223 static inline skiplist_level_t
 224 lower_head_level(skiplist_t sl)
 225 {
 226         if (skiplist_nlevels(sl)-- > 0) {
 227                 skiplist_nlevels(sl) = 0;
 228         }
 229         return skiplist_head(sl);
 230 }
 231
 232 static inline void
 233 reconcile_levelling(skiplist_t sl)
 234 {
 235         for (; skiplist_nlevels(sl) > 0; skiplist_nlevels(sl)--) {
 236                 if (next_node(skiplist_head(sl)) != NULL) {
 237                         return;
 238                 }
 239         }
 240         return;
 241 }
 242
 243 static inline void
 244 free_skiplist_levels(skiplist_level_t level_array)
 245         __attribute__((always_inline));
 246 static inline void
 247 free_skiplist_levels(skiplist_level_t level_array)
 248 {
 249         xfree(level_array);
 250         return;
 251 }
 252
 253 static inline void
 254 free_skiplist_node(skiplist_node_t node)
 255         __attribute__((always_inline));
 256 static inline void
 257 free_skiplist_node(skiplist_node_t node)
 258 {
 259         /* free the level array */
 260         SL_DEBUG_LEVEL("freeing level array 0x%p", node->foot);
 261 #if defined LET_GCC_BUGS_BITE_US
 262         /* must be the inline code plus write-combining :( */
 263         free_skiplist_levels(node->foot);
 264 #else
 265         xfree(node->foot);
 266 #endif
 267
 268         xfree(node);
 269         return;
 270 }
 271
 272 static inline void
 273 add_level_neighbour(skiplist_level_t level, skiplist_level_t neighbour)
 274         __attribute__((always_inline));
 275 static inline void
 276 add_level_neighbour(skiplist_level_t level, skiplist_level_t neighbour)
 277 {
 278         next_node(neighbour) = next_node(level);
 279         next_node(level) = neighbour;
 280         return;
 281 }
 282
 283 /* higher level bindings */
 284 static inline int
 285 skiplist_find_key_path(skiplist_t slist, Lisp_Object key, skiplist_level_t p[])
 286 {
 287         return skiplist_find_hash_path(slist, skiplist_hash(key), p);
 288 }
 289
 290 static inline skiplist_level_t
 291 skiplist_find_level(skiplist_t slist, Lisp_Object key)
 292 {
 293         return skiplist_find_hash_return_level(slist, skiplist_hash(key));
 294 }
 295
 296 static inline skiplist_level_t
 297 pop_node_level(skiplist_node_t node)
 298 {
 299         skiplist_level_t tmp;
 300
 301         tmp = node->head;
 302         if (!tmp)
 303                 return tmp;
 304
 305         node->head = tmp->nextlevel;
 306         tmp->nextlevel = NULL;  /* does not make sense for isolated levels */
 307         node->nlevels--;
 308
 309         if (node->head == NULL) {
 310                 node->foot = NULL;
 311         }
 312
 313         SL_DEBUG_LEVEL("popped level 0x%lx\n", (long unsigned int)tmp);
 314         return tmp;
 315 }
 316
 317 static inline int
 318 skiplist_find_hash_path(skiplist_t slist, hcode_t hash, skiplist_level_t p[])
 319 {
 320         skiplist_level_t tmp = NULL;
 321         hcode_t tmphash;
 322         /* result is the index of the last element */
 323         int result = 0;
 324
 325         if (!(tmp = skiplist_head(slist))) {
 326                 p[0] = NULL;
 327                 return 0;
 328         }
 329
 330         p[result] = tmp; /* just push the skiplist head */
 331         for (; tmp; tmp = next_level(tmp)) {
 332                 for (; next_node(tmp) &&
 333                              (tmphash = next_hash(tmp)) &&
 334                              (tmphash < hash);
 335                      tmp = next_node(tmp)) { }
 336                 p[++result] = tmp;
 337         }
 338         return result;
 339 }
 340
 341 static inline skiplist_level_t
 342 skiplist_find_hash_return_level(skiplist_t slist, hcode_t hash)
 343 {
 344         skiplist_level_t result, tmp;
 345         hcode_t tmphash;
 346
 347         if (UNLIKELY((result = tmp = skiplist_head(slist)) == NULL)) {
 348                 return NULL;
 349         }
 350
 351         for (; tmp; tmp = next_level(tmp)) {
 352                 for (; next_node(tmp) &&
 353                              (tmphash = next_hash(tmp)) &&
 354                              (tmphash < hash);
 355                      tmp = next_node(tmp) ) {}
 356                 result = tmp;
 357         }
 358
 359         return result;
 360 }
 361
 362 /* debugging only ... what's the global #define for it? */
 363 #ifdef SKIPLIST_DEBUG_FLAG
 364 static void
 365 list_skiplist(skiplist_t sl)
 366 {
 367         skiplist_level_t head, tmp;
 368
 369         __SKIPLIST_DEBUG__("*** SXEmacs: internal skiplist structure\n");
 370         head = skiplist_head(sl);
 371         while (head) {
 372                 tmp = head;
 373                 while (tmp) {
 374                         __SKIPLIST_DEBUG__("%lu->", level_hash(tmp));
 375                         tmp = next_node(tmp);
 376                 }
 377                 __SKIPLIST_DEBUG__("0\n");
 378                 head = next_level(head);
 379         }
 380 }
 381
 382 /* debugging only */
 383 DEFUN("list-skiplist", Flist_skiplist, 1, 1, 0, /*
 384 Do not use me!
 385 */
 386       (skiplist))
 387 {
 388         list_skiplist(XSKIPLIST(skiplist));
 389
 390         return Qt;
 391 }
 392 #endif
 393
 394 \f
 395 /* lisp bindings */
 396 static Lisp_Object
 397 mark_skiplist(Lisp_Object obj)
 398 {
 399         /* traverse the skiplist, we simply use the lowest level since
 400          * that should be a single-linked list */
 401         for (skiplist_level_t tmp = next_node(XSKIPLIST_FOOT(obj));
 402              tmp; tmp = next_node(tmp)) {
 403                 mark_object(node_data_key(parent_node(tmp)));
 404                 mark_object(node_data_value(parent_node(tmp)));
 405         }
 406
 407         mark_object(XSKIPLIST_PLIST(obj));
 408         return XSKIPLIST_PLIST(obj);
 409 }
 410
 411 static void
 412 print_skiplist(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 413 {
 414         write_fmt_str(printcharfun, "#<skiplist :size %lu  :levels %lu >",
 415                       (long unsigned int)XSKIPLIST_NNODES(obj),
 416                       (long unsigned int)XSKIPLIST_NLEVELS(obj));
 417 }
 418
 419 static void
 420 finalise_skiplist(void *header, int SXE_UNUSED(for_disksave))
 421 {
 422         skiplist_t sl = header;
 423
 424         SL_DEBUG("*** SXEmacs: skiplist finalisation 0x%lx\n",
 425                  (long unsigned int)sl);
 426
 427         /* traverse the skiplist and free all node and data cells */
 428         for (skiplist_level_t tmp = next_node(skiplist_foot(sl)); tmp; ) {
 429                 volatile skiplist_level_t nex = next_node(tmp);
 430                 SL_DEBUG_NODE("freeing 0x%lx\n",
 431                               (long unsigned int)tmp->node);
 432                 free_skiplist_node(tmp->node);
 433                 tmp = nex;
 434         }
 435
 436         /* free skiplist head levels */
 437         xfree(sl->headlevs);
 438
 439         /* and finally commit suicide */
 440         return;
 441 }
 442
 443 static Lisp_Object
 444 skiplist_getprop(Lisp_Object obj, Lisp_Object property)
 445 {
 446         return external_plist_get(&XSKIPLIST_PLIST(obj), property, 0, ERROR_ME);
 447 }
 448
 449 static int
 450 skiplist_putprop(Lisp_Object obj, Lisp_Object property, Lisp_Object value)
 451 {
 452         external_plist_put(&XSKIPLIST_PLIST(obj), property, value, 0, ERROR_ME);
 453         return 1;
 454 }
 455
 456 static int
 457 skiplist_remprop(Lisp_Object obj, Lisp_Object property)
 458 {
 459         return external_remprop(&XSKIPLIST_PLIST(obj), property, 0, ERROR_ME);
 460 }
 461
 462 DEFUN("skiplist-plist", Fskiplist_plist, 1, 1, 0, /*
 463 Return the property list of SKIPLIST.
 464 */
 465       (skiplist))
 466 {
 467         CHECK_SKIPLIST(skiplist);
 468         return XSKIPLIST_PLIST(skiplist);
 469 }
 470
 471 static const struct lrecord_description skiplist_description[] = {
 472         {XD_OPAQUE_PTR, offsetof(struct skiplist_s, headlevs)},
 473         {XD_INT, offsetof(struct skiplist_s, nnodes)},
 474         {XD_INT, offsetof(struct skiplist_s, nlevels)},
 475         {XD_LISP_OBJECT, offsetof(struct skiplist_s, plist)},
 476         {XD_END}
 477 };
 478
 479 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS("skiplist", skiplist,
 480                                          mark_skiplist, print_skiplist,
 481                                          finalise_skiplist,
 482                                          NULL, NULL,
 483                                          skiplist_description,
 484                                          skiplist_getprop,
 485                                          skiplist_putprop,
 486                                          skiplist_remprop,
 487                                          Fskiplist_plist,
 488                                          struct skiplist_s);
 489
 490 static inline skiplist_t
 491 allocate_skiplist(void)
 492         __attribute__((always_inline));
 493 static inline skiplist_t
 494 allocate_skiplist(void)
 495 {
 496         skiplist_t skiplist =
 497                 alloc_lcrecord_type(struct skiplist_s, &lrecord_skiplist);
 498         return skiplist;
 499 }
 500
 501 Lisp_Object
 502 make_skiplist(void)
 503 {
 504         skiplist_t sl = allocate_skiplist();
 505         Lisp_Object result;
 506
 507         /* the categories are actually seq and dict, but use the per-type
 508            implementation for a start */
 509         sl->lheader.lheader.morphisms = (1<<cat_mk_lc);
 510
 511         sl->headlevs = make_skiplist_levels(NULL, MAX_SKIPLIST_HEIGHT);
 512         skiplist_nnodes(sl) = 0;
 513         skiplist_nlevels(sl) = 0;       /* means 1 actually */
 514         skiplist_plist(sl) = Qnil;
 515
 516         XSETSKIPLIST(result, sl);
 517         return result;
 518 }
 519
 520 /* constructor */
 521 DEFUN("make-skiplist", Fmake_skiplist, 0, 0, 0, /*
 522 Return a new empty skiplist object.
 523 */
 524       ())
 525 {
 526         /* gotta seed our oracle; this is a stupid seed value though */
 527         return make_skiplist();
 528 }
 529
 530
 531 /* predicate */
 532 DEFUN("skiplistp", Fskiplistp, 1, 1, 0, /*
 533 Return non-nil if OBJECT is a skiplist.
 534 */
 535       (object))
 536 {
 537         if (SKIPLISTP(object)) {
 538                 return Qt;
 539         } else {
 540                 return Qnil;
 541         }
 542 }
 543
 544 DEFUN("skiplist-empty-p", Fskiplist_empty_p, 1, 1, 0, /*
 545 Return non-nil if SKIPLIST is empty.
 546 */
 547       (skiplist))
 548 {
 549         CHECK_SKIPLIST(skiplist);
 550
 551         if (XSKIPLIST_NNODES(skiplist) == 0) {
 552                 return Qt;
 553         } else {
 554                 return Qnil;
 555         }
 556 }
 557
 558 /* modifiers and accessors */
 559 static inline void
 560 _put_skiplist(skiplist_t sl, skiplist_level_t *path, size_t psz,
 561               hcode_t h, Lisp_Object key, Lisp_Object value)
 562 {
 563         /* entirely new data, build a node for it */
 564         /* determine the number of levels to add, this is a log distribution
 565          * so we use ffs(3) of a random number */
 566         size_t nlevels = __ase_ffsl(random());
 567         size_t cnt;
 568         skiplist_level_t levels, last = path[psz--];
 569         skiplist_node_t node;
 570
 571         node = _make_skiplist_node(h, key, value, nlevels);
 572         sl->nnodes++;
 573         levels = node->foot;
 574
 575         /* and add them */
 576         add_level_neighbour(last, node->foot /* level[0] */);
 577
 578         if (LIKELY(nlevels <= psz)) {
 579                 cnt = nlevels;
 580         } else {
 581                 cnt = psz;
 582         }
 583         for (size_t i = 1; i <= cnt; i++) {
 584                 skiplist_level_t level = &levels[i];
 585
 586                 SL_DEBUG_LEVEL("created level 0x%lx\n",
 587                                (long unsigned int)level);
 588
 589                 last = /* skiplist_path_pop(path) */ path[psz--];
 590                 SL_DEBUG("last 0x%lx  "
 591                          "level 0x%lx\n",
 592                          (long unsigned int)last,
 593                          (long unsigned int)level);
 594                 add_level_neighbour(last, level);
 595         }
 596         for (size_t i = cnt+1; i <= nlevels; i++) {
 597                 skiplist_level_t newhlevel = raise_head_level(sl);
 598                 skiplist_level_t level = &levels[i];
 599
 600                 SL_DEBUG("head level 0x%lx  "
 601                          "level 0x%lx\n",
 602                          (long unsigned int)newhlevel,
 603                          (long unsigned int)level);
 604                 add_level_neighbour(newhlevel, level);
 605         }
 606         return;
 607 }
 608
 609 void
 610 put_skiplist(skiplist_t sl, Lisp_Object key, Lisp_Object value)
 611 {
 612         skiplist_level_t last;
 613         /* C99 we need you */
 614         skiplist_level_t path[skiplist_nlevels(sl)+2];
 615         hcode_t hkey = skiplist_hash(key);
 616         int lastidx;
 617         hcode_t h;
 618
 619         last = path[lastidx = skiplist_find_hash_path(sl, hkey, path)];
 620
 621         if (UNLIKELY(/* skiplist_path_size(path) == 0 */ lastidx == 0 ||
 622                      /* skiplist_pop(path) == NULL */ last == NULL)) {
 623                 return;
 624         }
 625
 626         /* hash this prick */
 627         h = skiplist_hash(key);
 628
 629         /* now either we have to insert, or replace */
 630         /* for that we check if the element right of left is by chance
 631          * the thing we look for */
 632         if (UNLIKELY(h == level_hash(next_node(last)))) {
 633                 skiplist_level_t level = next_node(last);
 634
 635                 if (UNLIKELY(!skiplist_keyeq(key, level_key(level)))) {
 636                         SL_CRITICAL("*** SXEmacs CRITICAL: "
 637                                     "non trivial skiplist collision :(\n");
 638                 }
 639
 640                 /* oh, we have to replace, we just nuke the old
 641                  * data cell and replace it with the new one
 642                  * created above */
 643                 SL_DEBUG("*** SXEmacs: skiplist collision, replace\n");
 644                 node_data_key(parent_node(level)) = key;
 645                 node_data_value(parent_node(level)) = value;
 646                 return;
 647         } else {
 648                 _put_skiplist(sl, path, lastidx, h, key, value);
 649         }
 650         return;
 651 }
 652
 653 DEFUN("put-skiplist", Fput_skiplist, 3, 3, 0, /*
 654 Add KEY to the SKIPLIST and assign VALUE.
 655 */
 656       (skiplist, key, value))
 657 {
 658         CHECK_SKIPLIST(skiplist);
 659
 660         put_skiplist(XSKIPLIST(skiplist), key, value);
 661
 662         return skiplist;
 663 }
 664
 665 Lisp_Object
 666 get_skiplist(skiplist_t sl, Lisp_Object key, Lisp_Object default_)
 667 {
 668         skiplist_node_t node;
 669         skiplist_level_t level;
 670
 671         if (UNLIKELY((level = skiplist_find_level(sl, key)) == NULL)) {
 672                 return default_;
 673         }
 674
 675         /* level points to rightmost and footmost level to the left of key */
 676         if (next_node(level)) {
 677                 level = next_node(level);
 678         }
 679
 680         if (!(node = level->node)) {
 681                 return default_;
 682         }
 683
 684         if (!(skiplist_keyeq(node_data_key(node), key))) {
 685                 return default_;
 686         }
 687
 688         return node_data_value(node);
 689 }
 690
 691 DEFUN("get-skiplist", Fget_skiplist, 2, 3, 0, /*
 692 Return the value of KEY in SKIPLIST.
 693 If KEY is not an element, return `nil' instead or --
 694 if specified -- DEFAULT.
 695 */
 696       (skiplist, key, default_))
 697 {
 698         CHECK_SKIPLIST(skiplist);
 699
 700         return get_skiplist(XSKIPLIST(skiplist), key, default_);
 701 }
 702
 703 void
 704 remove_skiplist(skiplist_t sl, Lisp_Object key)
 705 /* remove KEY from SKIPLIST (pathless approach) */
 706 {
 707         skiplist_node_t node;
 708         skiplist_level_t level, last;
 709         /* C99 we need you! */
 710         skiplist_level_t path[skiplist_nlevels(sl)+2];
 711         hcode_t hkey = skiplist_hash(key);
 712         int lastidx;
 713
 714         lastidx = skiplist_find_hash_path(sl, hkey, path);
 715         last = path[lastidx];
 716
 717         if (/* skiplist_path_size(path) == 0 */ lastidx == 0 ||
 718             /* skiplist_last(path) == NULL */ path[0] == NULL) {
 719                 return;
 720         }
 721
 722         if (hkey == level_hash(next_node(last)) &&
 723             skiplist_keyeq(key, level_key(next_node(last)))) {
 724                 node = parent_node(next_node(last));
 725
 726                 /* traverse (bottom-up) the level structure
 727                  * and free any occurring level pointers */
 728                 while (lastidx > 0 /* because we `popped' the head */ &&
 729                        (last =
 730                         /* skiplist_path_pop(path) */
 731                         path[lastidx--]) != skiplist_path_nil &&
 732                        next_node(last) &&
 733                        parent_node(next_node(last)) == node) {
 734                         level = next_node(last);
 735                         next_node(last) = next_node(level);
 736                 }
 737
 738                 /* free node (kill data cell and levels with it) */
 739                 free_skiplist_node(node);
 740                 /* decrement skiplist size */
 741                 skiplist_nnodes(sl)--;
 742
 743                 /* now, the skiplist head might have many nil pointers
 744                  * we reduce the overall levelling in that case */
 745                 reconcile_levelling(sl);
 746         }
 747         return;
 748 }
 749
 750 DEFUN("remove-skiplist", Fremove_skiplist, 2, 2, 0, /*
 751 Remove the element specified by KEY from SKIPLIST.
 752 If KEY is not an element, this is a no-op.
 753 */
 754       (skiplist, key))
 755 {
 756         CHECK_SKIPLIST(skiplist);
 757
 758         remove_skiplist(XSKIPLIST(skiplist), key);
 759
 760         return skiplist;
 761 }
 762
 763 /* C99 where are you? */
 764 bool
 765 skiplist_owns_p(skiplist_t skiplist, Lisp_Object key)
 766 /* return !0 iff SKIPLIST has a node for KEY */
 767 {
 768         skiplist_node_t node;
 769         skiplist_level_t level;
 770         hcode_t hkey = skiplist_hash(key);
 771
 772         level = skiplist_find_hash_return_level(skiplist, hkey);
 773
 774         if (level == skiplist_path_nil) {
 775                 return false;
 776         }
 777
 778         /* level points to rightmost and footmost level to the left of key */
 779         if (next_node(level))
 780                 level = next_node(level);
 781
 782         if ((node = level->node) == NULL) {
 783                 return false;
 784         }
 785
 786         if (!(skiplist_keyeq(node_data_key(node), key))) {
 787                 return false;
 788         }
 789
 790         return true;
 791 }
 792
 793 DEFUN("skiplist-owns-p", Fskiplist_owns_p, 2, 2, 0, /*
 794 Return non-nil if KEY is associated with a value in SKIPLIST.
 795 */
 796       (skiplist, key))
 797 {
 798         CHECK_SKIPLIST(skiplist);
 799
 800         return (skiplist_owns_p(XSKIPLIST(skiplist), key) ? Qt : Qnil);
 801 }
 802
 803 \f
 804 /* informational cruft */
 805 DEFUN("skiplist-size", Fskiplist_size, 1, 1, 0, /*
 806 Return the size of SKIPLIST, that is the number of elements.
 807 */
 808       (skiplist))
 809 {
 810         CHECK_SKIPLIST(skiplist);
 811         return make_int((int32_t)XSKIPLIST_NNODES(skiplist));
 812 }
 813
 814
 815 Lisp_Object
 816 copy_skiplist(skiplist_t skiplist)
 817 {
 818         Lisp_Object result = make_skiplist();
 819         skiplist_t sl_copy = XSKIPLIST(result);
 820         skiplist_level_t tmp;
 821         Lisp_Object key, val;
 822
 823         /* traverse the skiplist */
 824         tmp = next_node(skiplist_foot(skiplist));
 825         while (tmp) {
 826                 key = node_data_key(parent_node(tmp));
 827                 val = node_data_value(parent_node(tmp));
 828                 put_skiplist(sl_copy, key, val);
 829                 tmp = next_node(tmp);
 830         }
 831
 832         return result;
 833 }
 834 DEFUN("copy-skiplist", Fcopy_skiplist, 1, 1, 0, /*
 835 Return a copy of skiplist SKIPLIST.
 836 The elements of SKIPLIST are not copied; they are shared
 837 with the original.
 838 */
 839       (skiplist))
 840 {
 841
 842         CHECK_SKIPLIST(skiplist);
 843
 844         return copy_skiplist(XSKIPLIST(skiplist));
 845 }
 846
 847 void unite_skiplist(skiplist_t target, skiplist_t source)
 848 {
 849         /* unite target and source and store result in target */
 850         Lisp_Object key, value;
 851         skiplist_level_t lev;
 852
 853         lev = next_node(skiplist_foot(source)); /* start at the bottom */
 854         while (lev) {
 855                 key = node_data_key(parent_node(lev));
 856                 value = node_data_value(parent_node(lev));
 857                 put_skiplist(target, key, value);
 858                 lev = next_node(lev);
 859         }
 860 }
 861
 862 DEFUN("skiplist-union", Fskiplist_union, 0, MANY, 0, /*
 863 Return the union skiplist of SKIPLISTS.
 864 Args are &rest SKIPLIST.
 865
 866 The union is a skiplist containing all key-value-pairs which are
 867 in at least one of the SKIPLISTS.
 868
 869 Note: Key-value-pairs with equal keys and distinct values are
 870 processed from left to right, that is the final union for such pairs
 871 contains the value of the rightmost skiplist in @var{skiplists}.
 872 */
 873       (int nargs, Lisp_Object *args))
 874 {
 875         int i;
 876         Lisp_Object result;
 877
 878         for (i=0; i<nargs; i++)
 879                 CHECK_SKIPLIST(args[i]);
 880
 881         result = make_skiplist();
 882         for (i=0; i<nargs; i++) {
 883                 unite_skiplist(XSKIPLIST(result), XSKIPLIST(args[i]));
 884         }
 885         return result;
 886 }
 887
 888 void intersect_skiplist(skiplist_t target, skiplist_t source)
 889 {
 890         /* intersect target and source and store result in target */
 891         Lisp_Object key;
 892         skiplist_level_t lev;
 893
 894         lev = next_node(skiplist_foot(target)); /* start at the bottom */
 895         while (lev) {
 896                 key = node_data_key(parent_node(lev));
 897                 lev = next_node(lev);
 898                 if (!skiplist_owns_p(source, key)) {
 899                         remove_skiplist(target, key);
 900                 } else {
 901                         lev = next_node(lev);
 902                 }
 903         }
 904 }
 905
 906 DEFUN("skiplist-intersection", Fskiplist_intersection, 0, MANY, 0, /*
 907 Return the intersection skiplist of SKIPLISTS.
 908 Args are &rest SKIPLIST.
 909
 910 The intersection is a skiplist containing all key-value-pairs
 911 which are in all skiplists of SKIPLISTS.
 912
 913 Note: Key-value-pairs with equal keys and distinct values are
 914 processed from right to left, that is the final intersection for such
 915 pairs contains the value of the leftmost skiplist in SKIPLISTS.
 916 */
 917       (int nargs, Lisp_Object *args))
 918 {
 919         int i;
 920         Lisp_Object result;
 921
 922         if (nargs == 0)
 923                 return make_skiplist();
 924
 925         for (i=0; i<nargs; i++)
 926                 CHECK_SKIPLIST(args[i]);
 927
 928         result = copy_skiplist(XSKIPLIST(args[0]));
 929         for (i=1; i<nargs; i++) {
 930                 intersect_skiplist(XSKIPLIST(result), XSKIPLIST(args[i]));
 931         }
 932         return result;
 933 }
 934
 935 void
 936 map_skiplist(skiplist_t sl, skiplist_map_f mapf)
 937 {
 938         skiplist_level_t lev;
 939
 940         lev = next_node(skiplist_foot(sl)); /* start at the bottom */
 941         while (lev) {
 942                 Lisp_Object k, v;
 943                 k = node_data_key(parent_node(lev));
 944                 v = node_data_value(parent_node(lev));
 945                 /* apply */
 946                 mapf(k, v);
 947                 lev = next_node(lev);
 948         }
 949         return;
 950 }
 951
 952 void
 953 map2_skiplist(skiplist_t sl, skiplist_map2_f mapf, void *ptr)
 954 {
 955         skiplist_level_t lev;
 956
 957         lev = next_node(skiplist_foot(sl)); /* start at the bottom */
 958         while (lev) {
 959                 Lisp_Object k, v;
 960                 k = node_data_key(parent_node(lev));
 961                 v = node_data_value(parent_node(lev));
 962                 /* apply */
 963                 mapf(k, v, ptr);
 964                 lev = next_node(lev);
 965         }
 966         return;
 967 }
 968
 969 DEFUN("map-skiplist", Fmap_skiplist, 2, 2, 0,   /*
 970 Map FUNCTION over entries in SKIPLIST, calling it with two args,
 971 each key and value in SKIPLIST.
 972
 973 FUNCTION may not modify SKIPLIST, with the one exception that FUNCTION
 974 may remove or reput the entry currently being processed by FUNCTION.
 975 */
 976       (function, skiplist))
 977 {
 978         skiplist_t sl;
 979         Lisp_Object args[3];
 980         skiplist_level_t lev;
 981         struct gcpro gcpro1, gcpro2;
 982
 983         CHECK_SKIPLIST(skiplist);
 984
 985         GCPRO2(function, skiplist);
 986         sl = XSKIPLIST(skiplist);
 987         lev = next_node(skiplist_foot(sl)); /* start at the bottom */
 988         while (lev) {
 989                 args[0] = function;
 990                 args[1] = node_data_key(parent_node(lev));
 991                 args[2] = node_data_value(parent_node(lev));
 992                 /* apply */
 993                 Ffuncall(countof(args), args);
 994                 lev = next_node(lev);
 995         }
 996
 997         UNGCPRO;
 998         return skiplist;
 999 }
1000
1001 \f
1002 /* converters */
1003 DEFUN("skiplist-to-alist", Fskiplist_to_alist, 1, 1, 0, /*
1004 Return the ordinary association list induced by SKIPLIST.
1005 */
1006       (skiplist))
1007 {
1008         Lisp_Object result = Qnil;
1009         skiplist_level_t tmp;
1010         Lisp_Object key, val;
1011
1012         CHECK_SKIPLIST(skiplist);
1013
1014         /* traverse the skiplist */
1015         tmp = next_node(XSKIPLIST_FOOT(skiplist));
1016         while (tmp) {
1017                 key = node_data_key(parent_node(tmp));
1018                 val = node_data_value(parent_node(tmp));
1019                 result = Fcons(Fcons(key, val), result);
1020                 tmp = next_node(tmp);
1021         }
1022
1023         return result;
1024 }
1025
1026 DEFUN("skiplist-to-plist", Fskiplist_to_plist, 1, 1, 0, /*
1027 Return the ordinary association list induced by SKIPLIST.
1028 */
1029       (skiplist))
1030 {
1031         Lisp_Object result = Qnil;
1032         skiplist_level_t tmp;
1033         Lisp_Object key, val;
1034
1035         CHECK_SKIPLIST(skiplist);
1036
1037         /* traverse the skiplist */
1038         tmp = next_node(XSKIPLIST_FOOT(skiplist));
1039         while (tmp) {
1040                 key = node_data_key(parent_node(tmp));
1041                 val = node_data_value(parent_node(tmp));
1042                 result = Fcons(val, result);
1043                 result = Fcons(key, result);
1044                 tmp = next_node(tmp);
1045         }
1046
1047         return result;
1048 }
1049
1050 DEFUN("alist-to-skiplist", Falist_to_skiplist, 1, 1, 0, /*
1051 Return a skiplist from ALIST with equal key space and image.
1052 */
1053       (alist))
1054 {
1055         Lisp_Object result = make_skiplist();
1056         skiplist_t sl = XSKIPLIST(result);
1057         Lisp_Object tmp, key, val;
1058
1059         CHECK_LIST(alist);
1060
1061         /* traverse the alist */
1062         tmp = alist;
1063         while (!NILP(tmp)) {
1064                 key = XCAR(XCAR(tmp));
1065                 val = XCDR(XCAR(tmp));
1066
1067                 put_skiplist(sl, key, val);
1068
1069                 tmp = Fcdr(tmp);
1070         }
1071
1072         return result;
1073 }
1074
1075 DEFUN("plist-to-skiplist", Fplist_to_skiplist, 1, 1, 0, /*
1076 Return a skiplist from PLIST with equal key space and image.
1077 */
1078       (plist))
1079 {
1080         Lisp_Object result = make_skiplist();
1081         skiplist_t sl = XSKIPLIST(result);
1082         Lisp_Object tmp, key, val;
1083
1084         CHECK_LIST(plist);
1085
1086         /* traverse the plist */
1087         tmp = plist;
1088         while (!NILP(tmp)) {
1089                 key = XCAR(tmp);
1090                 val = XCAR(XCDR(tmp));
1091
1092                 put_skiplist(sl, key, val);
1093
1094                 tmp = Fcdr(Fcdr(tmp));
1095         }
1096
1097         return result;
1098 }
1099
1100 \f
1101 /* iterator crap, only needed for dict so make it static */
1102 static void
1103 skiplist_iter_init(dict_t d, dict_iter_t di)
1104 {
1105         di->dict = d;
1106         /* go to the bottommost level */
1107         di->data = next_node(skiplist_foot((skiplist_t)d));
1108         return;
1109 }
1110
1111 static void
1112 skiplist_iter_fini(dict_iter_t di)
1113 {
1114         di->dict = di->data = NULL;
1115         return;
1116 }
1117
1118 /* the next one is for dicts only */
1119 static void
1120 skiplist_diter_next(dict_iter_t di, Lisp_Object *key, Lisp_Object *val)
1121 {
1122         skiplist_level_t sll = di->data;
1123
1124         if (LIKELY(sll != NULL)) {
1125                 *key = node_data_key(parent_node(sll));
1126                 *val = node_data_value(parent_node(sll));
1127                 di->data = next_node(sll);
1128         } else {
1129                 *key = *val = Qnull_pointer;
1130         }
1131         return;
1132 }
1133
1134 /* and the one for seqs */
1135 static void
1136 skiplist_siter_next(seq_iter_t di, void **elm)
1137 {
1138         skiplist_level_t sll = di->data;
1139
1140         if (LIKELY(sll != NULL)) {
1141                 *elm = (void*)node_data_key(parent_node(sll));
1142                 di->data = next_node(sll);
1143         } else {
1144                 *elm = Qnull_pointer;
1145         }
1146         return;
1147 }
1148
1149 static void
1150 skiplist_iter_reset(seq_iter_t si)
1151 {
1152         /* go to the bottommost level */
1153         si->data = next_node(skiplist_foot((skiplist_t)si->seq));
1154         return;
1155 }
1156
1157 static size_t
1158 skiplist_explode(void *restrict tgt[], size_t ntgt, const seq_t s)
1159 {
1160         volatile size_t i = 0;
1161         volatile skiplist_level_t n = next_node(skiplist_foot((skiplist_t)s));
1162
1163         while (n != NULL && i < ntgt) {
1164                 tgt[i++] = (void*)node_data_key(parent_node(n));
1165                 n = next_node(n);
1166         }
1167         return i;
1168 }
1169
1170 \f
1171 /*
1172  * Initialisation stuff
1173  */
1174 static struct dict_impl_s __dskiplist = {
1175         .size_f = (dict_size_f)skiplist_size,
1176         .put_f = (dict_put_f)put_skiplist,
1177         .get_f = (dict_get_f)get_skiplist,
1178         .remove_f = (dict_remove_f)remove_skiplist,
1179         .iter_init_f = skiplist_iter_init,
1180         .iter_next_f = skiplist_diter_next,
1181         .iter_fini_f = skiplist_iter_fini,
1182 };
1183
1184 static struct seq_impl_s __sskiplist = {
1185         .length_f = (seq_length_f)skiplist_size,
1186         .iter_init_f = (seq_iter_init_f)skiplist_iter_init,
1187         .iter_next_f = skiplist_siter_next,
1188         .iter_fini_f = (seq_iter_fini_f)skiplist_iter_fini,
1189         .iter_reset_f = skiplist_iter_reset,
1190         .explode_f = skiplist_explode,
1191 };
1192
1193 /* deal with dict interface */
1194 const dict_impl_t dict_skiplist = &__dskiplist;
1195 /* deal with the seq interface (actually a set interface) */
1196 const seq_impl_t seq_skiplist = &__sskiplist;
1197
1198 void syms_of_skiplist(void)
1199 {
1200         INIT_LRECORD_IMPLEMENTATION(skiplist);
1201
1202         defsymbol(&Qskiplistp, "skiplistp");
1203
1204         DEFSUBR(Fmake_skiplist);
1205         DEFSUBR(Fskiplist_plist);
1206
1207         DEFSUBR(Fskiplistp);
1208         DEFSUBR(Fskiplist_empty_p);
1209
1210         DEFSUBR(Fput_skiplist);
1211         DEFSUBR(Fget_skiplist);
1212         DEFSUBR(Fremove_skiplist);
1213         DEFSUBR(Fskiplist_owns_p);
1214
1215         DEFSUBR(Fskiplist_size);
1216
1217         DEFSUBR(Fcopy_skiplist);
1218         DEFSUBR(Fskiplist_union);
1219         DEFSUBR(Fskiplist_intersection);
1220         DEFSUBR(Fmap_skiplist);
1221
1222 #ifdef SKIPLIST_DEBUG_FLAG
1223         DEFSUBR(Flist_skiplist);
1224 #endif
1225
1226         DEFSUBR(Fskiplist_to_alist);
1227         DEFSUBR(Fskiplist_to_plist);
1228         DEFSUBR(Falist_to_skiplist);
1229         DEFSUBR(Fplist_to_skiplist);
1230 }
1231
1232 void
1233 skiplist_reinit(void)
1234 {
1235         morphisms[lrecord_type_skiplist].seq_impl = seq_skiplist;
1236         morphisms[lrecord_type_skiplist].aset_impl = dict_skiplist;
1237         return;
1238 }
1239
1240 void vars_of_skiplist(void)
1241 {
1242         Fprovide(intern("skiplist"));
1243 }
1244
1245 /* skiplist.c ends here*/