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

   1 /*
   2   dllist.c -- Doubly Linked Lists
   3   Copyright (C) 2005, 2006, 2007 Sebastian Freundt
   4
   5   Author:  Sebastian Freundt <hroptatyr@sxemacs.org>
   6
   7 This file is part of SXEmacs
   8
   9 SXEmacs is free software: you can redistribute it and/or modify
  10 it under the terms of the GNU General Public License as published by
  11 the Free Software Foundation, either version 3 of the License, or
  12 (at your option) any later version.
  13
  14 SXEmacs is distributed in the hope that it will be useful,
  15 but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 GNU General Public License for more details.
  18
  19 You should have received a copy of the GNU General Public License
  20 along with this program.  If not, see <http://www.gnu.org/licenses/>. */
  21
  22
  23 /* Synched up with: Not in FSF. */
  24
  25 #include <config.h>
  26
  27 #include "lisp.h"
  28
  29 #include "buffer.h"
  30 #include "sysdep.h"
  31 #include "lrecord.h"
  32 #include "lstream.h"
  33 #include "opaque.h"
  34
  35 #include "dllist.h"
  36
  37 /* for the category subsystem */
  38 #include "category.h"
  39 #include "seq.h"
  40
  41 Lisp_Object Qdllistp;
  42 Lisp_Object Qdllist;
  43
  44 static Lisp_Object
  45 mark_dllist(Lisp_Object obj)
  46 {
  47         dllist_t dllist = XDLLIST(obj);
  48         dllist_item_t tmp;
  49
  50         /* lock the entire dllist */
  51         DLL_LOCK(dllist);
  52
  53         /* traverse the list */
  54         tmp = dllist_first(dllist);
  55         while (tmp) {
  56                 mark_object((Lisp_Object)tmp->item);
  57                 tmp = tmp->next;
  58         }
  59
  60         /* unlock everything */
  61         DLL_UNLOCK(dllist);
  62
  63         mark_object(XDLLIST_PLIST(obj));
  64         return XDLLIST_PLIST(obj);
  65 }
  66
  67 static void
  68 print_dllist(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
  69 {
  70         dllist_t dllist = XDLLIST(obj);
  71         dllist_item_t tmp;
  72
  73         write_c_string("(dllist", printcharfun);
  74
  75         /* traverse the list */
  76         tmp = dllist_first(dllist);
  77         while (tmp) {
  78                 Lisp_Object ti;
  79                 dllist_item_t nex;
  80
  81                 /* lock the entire dllist */
  82                 DLL_LOCK(dllist);
  83                 ti = (Lisp_Object)tmp->item;
  84                 nex = tmp->next;
  85                 /* unlock the entire dllist */
  86                 DLL_UNLOCK(dllist);
  87
  88                 write_c_string(" ", printcharfun);
  89                 print_internal(ti, printcharfun, escapeflag);
  90                 tmp = nex;
  91         }
  92
  93         write_c_string(")", printcharfun);
  94 }
  95
  96 static int
  97 dllist_equalp(Lisp_Object o1, Lisp_Object o2, int depth)
  98 {
  99         dllist_t d1 = XDLLIST(o1);
 100         dllist_t d2 = XDLLIST(o2);
 101         dllist_item_t t1, t2;
 102         size_t s1, s2;
 103
 104         /* before locking stuff, look if d1 and d2 coincide */
 105         if (d1 == d2)
 106                 return 1;
 107
 108         /* lock both lists */
 109         DLL_LOCK(d1);
 110         DLL_LOCK(d2);
 111
 112         /* grab the sizes */
 113         s1 = dllist_size(d1);
 114         s2 = dllist_size(d2);
 115
 116         /* compare sizes first */
 117         if (s1 != s2) {
 118                 DLL_UNLOCK(d1);
 119                 DLL_UNLOCK(d2);
 120                 return 0;
 121         }
 122
 123         /* traverse the list */
 124         t1 = dllist_first(d1);
 125         t2 = dllist_first(d2);
 126         while (t1 && t2) {
 127                 Lisp_Object l1 = (Lisp_Object)t1->item;
 128                 Lisp_Object l2 = (Lisp_Object)t2->item;
 129                 if (!internal_equal(l1, l2, depth + 1)) {
 130                         DLL_UNLOCK(d2);
 131                         DLL_UNLOCK(d1);
 132                         return 0;
 133                 }
 134                 t1 = t1->next;
 135                 t2 = t2->next;
 136         }
 137
 138         /* unlock them two */
 139         DLL_UNLOCK(d2);
 140         DLL_UNLOCK(d1);
 141         return 1;
 142 }
 143
 144 static unsigned long
 145 dllist_hash(Lisp_Object obj, int depth)
 146 {
 147         dllist_t dll = XDLLIST(obj);
 148         unsigned int hash;
 149         dllist_item_t t;
 150
 151         DLL_LOCK(dll);
 152         hash = dllist_size(dll);
 153         t = dllist_first(dll);
 154         while (t) {
 155                 Lisp_Object i = (Lisp_Object)t->item;
 156                 hash = HASH2(hash, internal_hash(i, depth+1));
 157                 t = t->next;
 158         }
 159         DLL_UNLOCK(dll);
 160         return hash;
 161 }
 162
 163 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
 164 static void
 165 finalise_dllist(void *header, int UNUSED(for_disksave))
 166 {
 167         SXE_DEBUG_GC("finalising dllist %p\n", header);
 168
 169         /* finish the mutex */
 170         DLL_MUTEX_FINI((dllist_t)header);
 171         /* clean sweep */
 172         memset(header, 0, sizeof(struct dllist_s));
 173         return;
 174 }
 175
 176 #else  /* !BDWGC */
 177
 178 static void
 179 finalise_dllist(void *header, int UNUSED(for_disksave))
 180 {
 181         volatile dllist_t dllist = header;
 182
 183         /* lock the entire dllist */
 184         DLL_LOCK(dllist);
 185
 186         /* traverse the list */
 187         for (dllist_item_t tmp = dllist_first(dllist); tmp; ) {
 188                 volatile dllist_item_t tmp2 = tmp->next;
 189                 free_dllist_item(tmp);
 190                 tmp = tmp2;
 191         }
 192
 193         dllist_first(dllist) = NULL;
 194         dllist_last(dllist) = NULL;
 195         dllist_size(dllist) = 0;
 196
 197         /* unlock and finish the mutices */
 198         DLL_UNLOCK(dllist);
 199         DLL_MUTEX_FINI(dllist);
 200
 201         dllist->noseeum_data = NULL;
 202         return;
 203 }
 204 #endif  /* BDWGC */
 205
 206 static Lisp_Object
 207 dllist_getprop(Lisp_Object obj, Lisp_Object property)
 208 {
 209         return external_plist_get(&XDLLIST_PLIST(obj), property, 0, ERROR_ME);
 210 }
 211
 212 static int
 213 dllist_putprop(Lisp_Object obj, Lisp_Object property, Lisp_Object value)
 214 {
 215         external_plist_put(&XDLLIST_PLIST(obj), property, value, 0, ERROR_ME);
 216         return 1;
 217 }
 218
 219 static int
 220 dllist_remprop(Lisp_Object obj, Lisp_Object property)
 221 {
 222         return external_remprop(&XDLLIST_PLIST(obj), property, 0, ERROR_ME);
 223 }
 224
 225 DEFUN("dllist-plist", Fdllist_plist, 1, 1, 0, /*
 226 Return the property list of DLLIST.
 227 */
 228       (dllist))
 229 {
 230         CHECK_DLLIST(dllist);
 231         return XDLLIST_PLIST(dllist);
 232 }
 233
 234 static const struct lrecord_description dllist_description[] = {
 235         {XD_OPAQUE_PTR, offsetof(struct dllist_s, first)},
 236         {XD_OPAQUE_PTR, offsetof(struct dllist_s, last)},
 237         {XD_INT, offsetof(struct dllist_s, size)},
 238         {XD_LISP_OBJECT, offsetof(struct dllist_s, plist)},
 239         {XD_OPAQUE_PTR, offsetof(struct dllist_s, noseeum_data)},
 240         {XD_END}
 241 };
 242
 243 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS("dllist", dllist,
 244                                          mark_dllist, print_dllist,
 245                                          finalise_dllist,
 246                                          dllist_equalp, dllist_hash,
 247                                          dllist_description,
 248                                          dllist_getprop,
 249                                          dllist_putprop,
 250                                          dllist_remprop,
 251                                          Fdllist_plist,
 252                                          struct dllist_s);
 253
 254 /* the seq implementation */
 255 static size_t
 256 dll_length(const seq_t dll)
 257 {
 258         return dllist_size((const dllist_t)dll);
 259 }
 260
 261 static void
 262 dll_iter_init(seq_t dll, seq_iter_t si)
 263 {
 264         si->seq = dll;
 265         DLL_LOCK((dllist_t)dll);
 266         si->data = dllist_first((dllist_t)dll);
 267         DLL_UNLOCK((dllist_t)dll);
 268         return;
 269 }
 270
 271 static void
 272 dll_iter_reset(seq_iter_t si)
 273 {
 274         DLL_LOCK((dllist_t)si->seq);
 275         si->data = dllist_first((dllist_t)si->seq);
 276         DLL_UNLOCK((dllist_t)si->seq);
 277         return;
 278 }
 279
 280 static void
 281 dll_iter_next(seq_iter_t si, void **elt)
 282 {
 283         if (si->data != NULL) {
 284                 DLL_LOCK((dllist_t)si->seq);
 285                 *elt = (void*)((dllist_item_t)si->data)->item;
 286                 si->data = (void*)((dllist_item_t)si->data)->next;
 287                 DLL_UNLOCK((dllist_t)si->seq);
 288         } else {
 289                 *elt = NULL;
 290         }
 291         return;
 292 }
 293
 294 static void
 295 dll_iter_fini(seq_iter_t si)
 296 {
 297         si->data = si->seq = NULL;
 298         return;
 299 }
 300
 301 static size_t
 302 dll_explode(void *restrict tgt[], size_t ntgt, const seq_t s)
 303 {
 304         volatile dllist_item_t di = NULL;
 305         volatile size_t i = 0;
 306
 307         DLL_LOCK((const dllist_t)s);
 308         di = dllist_first((const dllist_t)s);
 309         while (di != NULL && i < ntgt) {
 310                 tgt[i++] = di->item;
 311                 di = di->next;
 312         }
 313         DLL_UNLOCK((const dllist_t)s);
 314         return i;
 315 }
 316
 317 static struct seq_impl_s __sdll = {
 318         .length_f = dll_length,
 319         .iter_init_f = dll_iter_init,
 320         .iter_next_f = dll_iter_next,
 321         .iter_fini_f = dll_iter_fini,
 322         .iter_reset_f = dll_iter_reset,
 323         .explode_f = dll_explode,
 324 };
 325
 326
 327 static dllist_t
 328 allocate_dllist(void)
 329 {
 330         dllist_t dllist =
 331                 alloc_lcrecord_type(struct dllist_s, &lrecord_dllist);
 332         return dllist;
 333 }
 334
 335 dllist_t
 336 make_noseeum_dllist(void)
 337 {
 338         dllist_t dllist = xnew(struct dllist_s);
 339 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
 340         GC_finalization_proc *foo = NULL;
 341         void **bar = NULL;
 342
 343         SXE_DEBUG_GC("created dllist %p\n", dllist);
 344         GC_REGISTER_FINALIZER(dllist, (GC_finalization_proc)finalise_dllist,
 345                               NULL, foo, bar);
 346 #endif  /* BDWGC */
 347
 348         dllist_first(dllist) = NULL;
 349         dllist_last(dllist) = NULL;
 350         dllist_size(dllist) = 0;
 351         dllist_plist(dllist) = Qnil;
 352         dllist->noseeum_data = NULL;
 353
 354         DLL_MUTEX_INIT(dllist);
 355
 356         /* set the seq implementation */
 357         dllist->lheader.lheader.morphisms = (1<<cat_mk_lc);
 358         return dllist;
 359 }
 360
 361 void free_noseeum_dllist(dllist_t dllist)
 362 {
 363 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
 364         SXE_DEBUG_GC("freeing noseeum dllist %p (again)\n", dllist);
 365         finalise_dllist(dllist, 0);
 366         return;
 367 #else  /* !BDWGC */
 368         WITH_DLL_LOCK(
 369                 dllist,
 370                 if (dllist->noseeum_data)
 371                         xfree(dllist->noseeum_data);
 372                 );
 373
 374         finalise_dllist(dllist, 0);
 375
 376         xfree(dllist);
 377 #endif  /* BDWGC */
 378 }
 379
 380 dllist_t
 381 make_dllist(void)
 382 {
 383         dllist_t dllist = allocate_dllist();
 384
 385         dllist_first(dllist) = NULL;
 386         dllist_last(dllist) = NULL;
 387         dllist_size(dllist) = 0;
 388         dllist_plist(dllist) = Qnil;
 389         dllist->noseeum_data = NULL;
 390
 391         DLL_MUTEX_INIT(dllist);
 392
 393         /* set the seq implementation */
 394         dllist->lheader.lheader.morphisms = (1<<cat_mk_lc);
 395         return dllist;
 396 }
 397
 398 \f
 399 /* constructor */
 400 DEFUN("dllist", Fdllist, 0, MANY, 0, /*
 401 Return a doubly-linked list.
 402
 403 Optionally passed arguments are filled into the resulting dllist.
 404 */
 405       (int nargs, Lisp_Object *args))
 406 {
 407         dllist_t dllist = make_dllist();
 408         Lisp_Object result;
 409         int i;
 410
 411         for (i = 0; i < nargs; i++)
 412                 dllist_append(dllist, (void*)args[i]);
 413
 414         XSETDLLIST(result, dllist);
 415         return result;
 416 }
 417
 418 /* predicate */
 419 DEFUN("dllistp", Fdllistp, 1, 1, 0, /*
 420 Return non-nil if OBJECT is a dllist.
 421 */
 422       (object))
 423 {
 424         if (DLLISTP(object))
 425                 return Qt;
 426         else
 427                 return Qnil;
 428 }
 429
 430 DEFUN("dllist-empty-p", Fdllist_empty_p, 1, 1, 0, /*
 431 Return non-nil if DLLIST is empty.
 432 */
 433       (dllist))
 434 {
 435         CHECK_DLLIST(dllist);
 436
 437         if (XDLLIST_SIZE(dllist) == 0)
 438                 return Qt;
 439         else
 440                 return Qnil;
 441 }
 442
 443 /* modifiers and accessors */
 444 DEFUN("dllist-car", Fdllist_car, 1, 1, 0, /*
 445 Return the front element of DLLIST.
 446 */
 447       (dllist))
 448 {
 449         void *result;
 450         CHECK_DLLIST(dllist);
 451         if ((result = dllist_car(XDLLIST(dllist))) != NULL)
 452                 return (Lisp_Object)result;
 453         else
 454                 return Qnil;
 455 }
 456
 457 DEFUN("dllist-rac", Fdllist_rac, 1, 1, 0, /*
 458 Return the back element of DLLIST.
 459 */
 460       (dllist))
 461 {
 462         void *result;
 463         CHECK_DLLIST(dllist);
 464         if ((result = dllist_rac(XDLLIST(dllist))) != NULL)
 465                 return (Lisp_Object)result;
 466         else
 467                 return Qnil;
 468 }
 469
 470 void
 471 dllist_prepend(dllist_t dllist, void *element)
 472 {
 473         dllist_item_t new = new_dllist_item();
 474
 475         new->item = element;
 476         dllist_prepend_item(dllist, new);
 477         return;
 478 }
 479 DEFUN("dllist-prepend", Fdllist_prepend, 2, 2, 0, /*
 480 Add ELEMENT to the front of DLLIST.
 481 */
 482       (dllist, element))
 483 {
 484         CHECK_DLLIST(dllist);
 485
 486         dllist_prepend(XDLLIST(dllist), (void*)element);
 487
 488         return dllist;
 489 }
 490
 491 DEFUN("dllist-transfer-car-car", Fdllist_transfer_car_car, 2, 2, 0, /*
 492 Pop off SRC-DLL's car and prepend it to TGT-DLL.
 493 */
 494       (src_dll, tgt_dll))
 495 {
 496         dllist_item_t item;
 497
 498         CHECK_DLLIST(src_dll);
 499         CHECK_DLLIST(tgt_dll);
 500
 501         item = dllist_transfer_car(XDLLIST(src_dll));
 502         if (item == NULL) {
 503                 return tgt_dll;
 504         }
 505         dllist_prepend_item(XDLLIST(tgt_dll), item);
 506
 507         return tgt_dll;
 508 }
 509
 510 DEFUN("dllist-transfer-rac-car", Fdllist_transfer_rac_car, 2, 2, 0, /*
 511 Pop off SRC-DLL's rac and prepend it to TGT-DLL.
 512 */
 513       (src_dll, tgt_dll))
 514 {
 515         dllist_item_t item;
 516
 517         CHECK_DLLIST(src_dll);
 518         CHECK_DLLIST(tgt_dll);
 519
 520         item = dllist_transfer_rac(XDLLIST(src_dll));
 521         if (item == NULL) {
 522                 return tgt_dll;
 523         }
 524         dllist_prepend_item(XDLLIST(tgt_dll), item);
 525
 526         return tgt_dll;
 527 }
 528
 529 void
 530 dllist_append(dllist_t dllist, void *element)
 531 {
 532         dllist_item_t new = new_dllist_item();
 533
 534         new->item = element;
 535         dllist_append_item(dllist, new);
 536         return;
 537 }
 538 DEFUN("dllist-append", Fdllist_append, 2, 2, 0, /*
 539 Add ELEMENT to the back of DLLIST.
 540 */
 541       (dllist, element))
 542 {
 543         CHECK_DLLIST(dllist);
 544
 545         dllist_append(XDLLIST(dllist), (void*)element);
 546
 547         return dllist;
 548 }
 549
 550
 551 DEFUN("dllist-transfer-car-rac", Fdllist_transfer_car_rac, 2, 2, 0, /*
 552 Pop off SRC-DLL's car and append it to TGT-DLL.
 553 */
 554       (src_dll, tgt_dll))
 555 {
 556         dllist_item_t item;
 557
 558         CHECK_DLLIST(src_dll);
 559         CHECK_DLLIST(tgt_dll);
 560
 561         item = dllist_transfer_car(XDLLIST(src_dll));
 562         if (item == NULL) {
 563                 return tgt_dll;
 564         }
 565         dllist_append_item(XDLLIST(tgt_dll), item);
 566
 567         return tgt_dll;
 568 }
 569
 570 DEFUN("dllist-transfer-rac-rac", Fdllist_transfer_rac_rac, 2, 2, 0, /*
 571 Pop off SRC-DLL's rac and append it to TGT-DLL.
 572 */
 573       (src_dll, tgt_dll))
 574 {
 575         dllist_item_t item;
 576
 577         CHECK_DLLIST(src_dll);
 578         CHECK_DLLIST(tgt_dll);
 579
 580         item = dllist_transfer_rac(XDLLIST(src_dll));
 581         if (item == NULL) {
 582                 return tgt_dll;
 583         }
 584         dllist_append_item(XDLLIST(tgt_dll), item);
 585
 586         return tgt_dll;
 587 }
 588
 589 void *
 590 dllist_pop_car(dllist_t dllist)
 591 {
 592         dllist_item_t old;
 593         void *result = NULL;
 594
 595         if ((old = dllist_transfer_car(dllist)) == NULL)
 596                 return NULL;
 597
 598         /* save the lisp data and free the item */
 599         result = old->item;
 600         free_dllist_item(old);
 601
 602         return result;
 603 }
 604 DEFUN("dllist-pop-car", Fdllist_pop_car, 1, 1, 0, /*
 605 Remove the front element of DLLIST and return it.
 606 */
 607       (dllist))
 608 {
 609         void *result;
 610         CHECK_DLLIST(dllist);
 611         if ((result = dllist_pop_car(XDLLIST(dllist))) != NULL)
 612                 return (Lisp_Object)result;
 613         else
 614                 return Qnil;
 615 }
 616
 617 void*
 618 dllist_pop_rac(dllist_t dllist)
 619 {
 620         dllist_item_t old;
 621         void *result = NULL;
 622
 623         if ((old = dllist_transfer_rac(dllist)) == NULL)
 624                 return NULL;
 625
 626         /* save the lisp data and free the item */
 627         result = old->item;
 628         free_dllist_item(old);
 629
 630         return result;
 631 }
 632 DEFUN("dllist-pop-rac", Fdllist_pop_rac, 1, 1, 0, /*
 633 Remove the back element of DLLIST and return it.
 634 */
 635       (dllist))
 636 {
 637         void *result;
 638         CHECK_DLLIST(dllist);
 639         if ((result = dllist_pop_rac(XDLLIST(dllist))) != NULL)
 640                 return (Lisp_Object)result;
 641         else
 642                 return Qnil;
 643 }
 644
 645 void*
 646 dllist_rrotate(dllist_t dllist)
 647 {
 648         dllist_item_t ofr;
 649         dllist_item_t oba;
 650         void *result = NULL;
 651
 652         DLL_LOCK(dllist);
 653         ofr = dllist_first(dllist);
 654         oba = dllist_last(dllist);
 655
 656         if (oba == ofr) {
 657                 /* unlock the mutex due to non-local exit */
 658                 DLL_UNLOCK(dllist);
 659                 return NULL;
 660         }
 661
 662         oba->prev->next = NULL;
 663         dllist_last(dllist) = oba->prev;
 664         oba->prev = NULL;
 665         oba->next = ofr;
 666         dllist_first(dllist) = oba;
 667         ofr->prev = oba;
 668
 669         /* save the lisp data and free the item */
 670         result = oba->item;
 671
 672         DLL_UNLOCK(dllist);
 673         return result;
 674 }
 675 DEFUN("dllist-rrotate", Fdllist_rrotate, 1, 1, 0, /*
 676 Remove the back element of DLLIST and prepend it to the front.
 677 */
 678       (dllist))
 679 {
 680         CHECK_DLLIST(dllist);
 681         dllist_rrotate(XDLLIST(dllist));
 682         return dllist;
 683 }
 684
 685 void*
 686 dllist_lrotate(dllist_t dllist)
 687 {
 688         dllist_item_t ofr;
 689         dllist_item_t oba;
 690         void *result = NULL;
 691
 692         DLL_LOCK(dllist);
 693         ofr = dllist_first(dllist);
 694         oba = dllist_last(dllist);
 695
 696         if (oba == ofr) {
 697                 /* unlock the mutex due to non-local exit */
 698                 DLL_UNLOCK(dllist);
 699                 return NULL;
 700         }
 701
 702         ofr->next->prev = NULL;
 703         dllist_first(dllist) = ofr->next;
 704         ofr->next = NULL;
 705         oba->next = ofr;
 706         dllist_last(dllist) = ofr;
 707         ofr->prev = oba;
 708
 709         /* save the lisp data and free the item */
 710         result = ofr->item;
 711
 712         DLL_UNLOCK(dllist);
 713         return result;
 714 }
 715 DEFUN("dllist-lrotate", Fdllist_lrotate, 1, 1, 0, /*
 716 Remove the head element of DLLIST and append it to the back.
 717 */
 718       (dllist))
 719 {
 720         CHECK_DLLIST(dllist);
 721         dllist_lrotate(XDLLIST(dllist));
 722         return dllist;
 723 }
 724
 725
 726 DEFUN("dllist-size", Fdllist_size, 1, 1, 0, /*
 727 Return the size of DLLIST, that is the number of elements.
 728 */
 729       (dllist))
 730 {
 731         int result;
 732         CHECK_DLLIST(dllist);
 733         WITH_DLL_LOCK(XDLLIST(dllist), result = XDLLIST_SIZE(dllist));
 734         return make_int(result);
 735 }
 736
 737
 738 dllist_t
 739 copy_dllist(dllist_t dllist)
 740 {
 741         dllist_t dl_copy = make_dllist();
 742         dllist_item_t elm;
 743
 744         DLL_LOCK(dllist);
 745         elm = dllist_first(dllist);
 746
 747         while (elm) {
 748                 dllist_append(dl_copy, elm->item);
 749                 elm = elm->next;
 750         }
 751         DLL_UNLOCK(dllist);
 752
 753         return dl_copy;
 754 }
 755
 756 DEFUN("copy-dllist", Fcopy_dllist, 1, 1, 0,     /*
 757 Return a copy of dllist DLLIST.
 758 The elements of DLLIST are not copied; they are shared
 759 with the original.
 760 */
 761       (dllist))
 762 {
 763         CHECK_DLLIST(dllist);
 764
 765         return wrap_dllist(copy_dllist(XDLLIST(dllist)));
 766 }
 767
 768
 769 /* converters */
 770 DEFUN("dllist-to-list", Fdllist_to_list, 1, 1, 0, /*
 771 Return the ordinary list induced by DLLIST, that is start with
 772 the first element in DLLIST and traverse through the back.
 773 */
 774       (dllist))
 775 {
 776         /* this function can GC */
 777         dllist_item_t tmp;
 778         Lisp_Object result = Qnil;
 779         struct gcpro gcpro1, gcpro2;
 780
 781         CHECK_DLLIST(dllist);
 782
 783         GCPRO2(dllist, result);
 784
 785         DLL_LOCK(XDLLIST(dllist));
 786         /* traverse the list */
 787         tmp = XDLLIST_LAST(dllist);
 788         while (tmp) {
 789                 result = Fcons((Lisp_Object)tmp->item, result);
 790                 tmp = tmp->prev;
 791         }
 792         DLL_UNLOCK(XDLLIST(dllist));
 793
 794         UNGCPRO;
 795         return result;
 796 }
 797
 798 DEFUN("dllist-to-list-reversed", Fdllist_to_list_reversed, 1, 1, 0, /*
 799 Return the ordinary list induced by DLLIST in reverse order,
 800 that is start with the last element in DLLIST and traverse through
 801 the front.
 802 */
 803       (dllist))
 804 {
 805         dllist_item_t tmp;
 806         Lisp_Object result = Qnil;
 807         struct gcpro gcpro1, gcpro2;
 808
 809         CHECK_DLLIST(dllist);
 810
 811         GCPRO2(dllist, result);
 812
 813         DLL_LOCK(XDLLIST(dllist));
 814         /* traverse the list */
 815         tmp = XDLLIST_FIRST(dllist);
 816         while (tmp) {
 817                 result = Fcons((Lisp_Object)tmp->item, result);
 818                 tmp = tmp->next;
 819         }
 820         DLL_UNLOCK(XDLLIST(dllist));
 821
 822         UNGCPRO;
 823         return result;
 824 }
 825
 826 void
 827 dllist_map_inplace(Lisp_Object function, Lisp_Object dllist)
 828 {
 829         Lisp_Object arr[2];
 830         struct gcpro gcpro1, gcpro2;
 831
 832         GCPRO2(function, dllist);
 833         arr[0] = function;
 834         WITH_DLLIST_TRAVERSE(
 835                 XDLLIST(dllist),
 836                 Lisp_Object tmp;
 837                 arr[1] = (long int)dllist_item;
 838                 tmp = Ffuncall(2, arr);
 839                 dllist_item = (void*)tmp);
 840         UNGCPRO;
 841 }
 842
 843 void
 844 dllist_map_inplace_C(void*(*fun)(void*), dllist_t dllist)
 845 {
 846         /* This cannot GC, it is intended for noseeum dllists anyway */
 847         WITH_DLLIST_TRAVERSE(dllist, dllist_item = fun(dllist_item));
 848 }
 849
 850 void
 851 dllist_map_C(void(*fun)(void*), dllist_t dllist)
 852 {
 853         /* This cannot GC, it is intended for noseeum dllists anyway */
 854         WITH_DLLIST_TRAVERSE(dllist, fun(dllist_item));
 855 }
 856
 857 /*
 858  * Initialisation stuff
 859  */
 860 void
 861 syms_of_dllist(void)
 862 {
 863         INIT_LRECORD_IMPLEMENTATION(dllist);
 864
 865         defsymbol(&Qdllistp, "dllistp");
 866         defsymbol(&Qdllist, "dllist");
 867
 868         DEFSUBR(Fdllist);
 869         DEFSUBR(Fdllist_plist);
 870
 871         DEFSUBR(Fdllistp);
 872         DEFSUBR(Fdllist_empty_p);
 873
 874         DEFSUBR(Fdllist_car);
 875         DEFSUBR(Fdllist_rac);
 876         DEFSUBR(Fdllist_prepend);
 877         DEFSUBR(Fdllist_append);
 878         DEFSUBR(Fdllist_transfer_car_car);
 879         DEFSUBR(Fdllist_transfer_rac_car);
 880         DEFSUBR(Fdllist_transfer_car_rac);
 881         DEFSUBR(Fdllist_transfer_rac_rac);
 882         DEFSUBR(Fdllist_pop_car);
 883         DEFSUBR(Fdllist_pop_rac);
 884         DEFSUBR(Fdllist_lrotate);
 885         DEFSUBR(Fdllist_rrotate);
 886         DEFSUBR(Fdllist_size);
 887
 888         DEFSUBR(Fcopy_dllist);
 889
 890         DEFSUBR(Fdllist_to_list);
 891         DEFSUBR(Fdllist_to_list_reversed);
 892 }
 893
 894 void
 895 dllist_reinit(void)
 896 {
 897         /* the category subsystem */
 898         morphisms[lrecord_type_dllist].seq_impl = &__sdll;
 899         return;
 900 }
 901
 902 void
 903 vars_of_dllist(void)
 904 {
 905         Fprovide(Qdllist);
 906 }
 907
 908 /* dllist.c ends here */