2 dllist.c -- Doubly Linked Lists
3 Copyright (C) 2005, 2006, 2007 Sebastian Freundt
5 Author: Sebastian Freundt <hroptatyr@sxemacs.org>
7 This file is part of SXEmacs
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.
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.
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/>. */
23 /* Synched up with: Not in FSF. */
37 /* for the category subsystem */
45 mark_dllist(Lisp_Object obj)
47 dllist_t dllist = XDLLIST(obj);
50 /* lock the entire dllist */
53 /* traverse the list */
54 tmp = dllist_first(dllist);
56 mark_object((Lisp_Object)tmp->item);
60 /* unlock everything */
63 mark_object(XDLLIST_PLIST(obj));
64 return XDLLIST_PLIST(obj);
68 print_dllist(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
70 dllist_t dllist = XDLLIST(obj);
73 write_c_string("(dllist", printcharfun);
75 /* traverse the list */
76 tmp = dllist_first(dllist);
81 /* lock the entire dllist */
83 ti = (Lisp_Object)tmp->item;
85 /* unlock the entire dllist */
88 write_c_string(" ", printcharfun);
89 print_internal(ti, printcharfun, escapeflag);
93 write_c_string(")", printcharfun);
97 dllist_equalp(Lisp_Object o1, Lisp_Object o2, int depth)
99 dllist_t d1 = XDLLIST(o1);
100 dllist_t d2 = XDLLIST(o2);
101 dllist_item_t t1, t2;
104 /* before locking stuff, look if d1 and d2 coincide */
108 /* lock both lists */
113 s1 = dllist_size(d1);
114 s2 = dllist_size(d2);
116 /* compare sizes first */
123 /* traverse the list */
124 t1 = dllist_first(d1);
125 t2 = dllist_first(d2);
127 Lisp_Object l1 = (Lisp_Object)t1->item;
128 Lisp_Object l2 = (Lisp_Object)t2->item;
129 if (!internal_equal(l1, l2, depth + 1)) {
138 /* unlock them two */
145 dllist_hash(Lisp_Object obj, int depth)
147 dllist_t dll = XDLLIST(obj);
152 hash = dllist_size(dll);
153 t = dllist_first(dll);
155 Lisp_Object i = (Lisp_Object)t->item;
156 hash = HASH2(hash, internal_hash(i, depth+1));
163 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
165 finalise_dllist(void *header, int UNUSED(for_disksave))
167 SXE_DEBUG_GC("finalising dllist %p\n", header);
169 /* finish the mutex */
170 DLL_MUTEX_FINI((dllist_t)header);
172 memset(header, 0, sizeof(struct dllist_s));
179 finalise_dllist(void *header, int UNUSED(for_disksave))
181 volatile dllist_t dllist = header;
183 /* lock the entire dllist */
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);
193 dllist_first(dllist) = NULL;
194 dllist_last(dllist) = NULL;
195 dllist_size(dllist) = 0;
197 /* unlock and finish the mutices */
199 DLL_MUTEX_FINI(dllist);
201 dllist->noseeum_data = NULL;
207 dllist_getprop(Lisp_Object obj, Lisp_Object property)
209 return external_plist_get(&XDLLIST_PLIST(obj), property, 0, ERROR_ME);
213 dllist_putprop(Lisp_Object obj, Lisp_Object property, Lisp_Object value)
215 external_plist_put(&XDLLIST_PLIST(obj), property, value, 0, ERROR_ME);
220 dllist_remprop(Lisp_Object obj, Lisp_Object property)
222 return external_remprop(&XDLLIST_PLIST(obj), property, 0, ERROR_ME);
225 DEFUN("dllist-plist", Fdllist_plist, 1, 1, 0, /*
226 Return the property list of DLLIST.
230 CHECK_DLLIST(dllist);
231 return XDLLIST_PLIST(dllist);
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)},
243 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS("dllist", dllist,
244 mark_dllist, print_dllist,
246 dllist_equalp, dllist_hash,
254 /* the seq implementation */
256 dll_length(const seq_t dll)
258 return dllist_size((const dllist_t)dll);
262 dll_iter_init(seq_t dll, seq_iter_t si)
265 DLL_LOCK((dllist_t)dll);
266 si->data = dllist_first((dllist_t)dll);
267 DLL_UNLOCK((dllist_t)dll);
272 dll_iter_reset(seq_iter_t si)
274 DLL_LOCK((dllist_t)si->seq);
275 si->data = dllist_first((dllist_t)si->seq);
276 DLL_UNLOCK((dllist_t)si->seq);
281 dll_iter_next(seq_iter_t si, void **elt)
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);
295 dll_iter_fini(seq_iter_t si)
297 si->data = si->seq = NULL;
302 dll_explode(void *restrict tgt[], size_t ntgt, const seq_t s)
304 volatile dllist_item_t di = NULL;
305 volatile size_t i = 0;
307 DLL_LOCK((const dllist_t)s);
308 di = dllist_first((const dllist_t)s);
309 while (di != NULL && i < ntgt) {
313 DLL_UNLOCK((const dllist_t)s);
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,
328 allocate_dllist(void)
331 alloc_lcrecord_type(struct dllist_s, &lrecord_dllist);
336 make_noseeum_dllist(void)
338 dllist_t dllist = xnew(struct dllist_s);
339 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
340 GC_finalization_proc *foo = NULL;
343 SXE_DEBUG_GC("created dllist %p\n", dllist);
344 GC_REGISTER_FINALIZER(dllist, (GC_finalization_proc)finalise_dllist,
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;
354 DLL_MUTEX_INIT(dllist);
356 /* set the seq implementation */
357 dllist->lheader.lheader.morphisms = (1<<cat_mk_lc);
361 void free_noseeum_dllist(dllist_t dllist)
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);
370 if (dllist->noseeum_data)
371 xfree(dllist->noseeum_data);
374 finalise_dllist(dllist, 0);
383 dllist_t dllist = allocate_dllist();
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;
391 DLL_MUTEX_INIT(dllist);
393 /* set the seq implementation */
394 dllist->lheader.lheader.morphisms = (1<<cat_mk_lc);
400 DEFUN("dllist", Fdllist, 0, MANY, 0, /*
401 Return a doubly-linked list.
403 Optionally passed arguments are filled into the resulting dllist.
405 (int nargs, Lisp_Object *args))
407 dllist_t dllist = make_dllist();
411 for (i = 0; i < nargs; i++)
412 dllist_append(dllist, (void*)args[i]);
414 XSETDLLIST(result, dllist);
419 DEFUN("dllistp", Fdllistp, 1, 1, 0, /*
420 Return non-nil if OBJECT is a dllist.
430 DEFUN("dllist-empty-p", Fdllist_empty_p, 1, 1, 0, /*
431 Return non-nil if DLLIST is empty.
435 CHECK_DLLIST(dllist);
437 if (XDLLIST_SIZE(dllist) == 0)
443 /* modifiers and accessors */
444 DEFUN("dllist-car", Fdllist_car, 1, 1, 0, /*
445 Return the front element of DLLIST.
450 CHECK_DLLIST(dllist);
451 if ((result = dllist_car(XDLLIST(dllist))) != NULL)
452 return (Lisp_Object)result;
457 DEFUN("dllist-rac", Fdllist_rac, 1, 1, 0, /*
458 Return the back element of DLLIST.
463 CHECK_DLLIST(dllist);
464 if ((result = dllist_rac(XDLLIST(dllist))) != NULL)
465 return (Lisp_Object)result;
471 dllist_prepend(dllist_t dllist, void *element)
473 dllist_item_t new = new_dllist_item();
476 dllist_prepend_item(dllist, new);
479 DEFUN("dllist-prepend", Fdllist_prepend, 2, 2, 0, /*
480 Add ELEMENT to the front of DLLIST.
484 CHECK_DLLIST(dllist);
486 dllist_prepend(XDLLIST(dllist), (void*)element);
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.
498 CHECK_DLLIST(src_dll);
499 CHECK_DLLIST(tgt_dll);
501 item = dllist_transfer_car(XDLLIST(src_dll));
505 dllist_prepend_item(XDLLIST(tgt_dll), item);
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.
517 CHECK_DLLIST(src_dll);
518 CHECK_DLLIST(tgt_dll);
520 item = dllist_transfer_rac(XDLLIST(src_dll));
524 dllist_prepend_item(XDLLIST(tgt_dll), item);
530 dllist_append(dllist_t dllist, void *element)
532 dllist_item_t new = new_dllist_item();
535 dllist_append_item(dllist, new);
538 DEFUN("dllist-append", Fdllist_append, 2, 2, 0, /*
539 Add ELEMENT to the back of DLLIST.
543 CHECK_DLLIST(dllist);
545 dllist_append(XDLLIST(dllist), (void*)element);
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.
558 CHECK_DLLIST(src_dll);
559 CHECK_DLLIST(tgt_dll);
561 item = dllist_transfer_car(XDLLIST(src_dll));
565 dllist_append_item(XDLLIST(tgt_dll), item);
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.
577 CHECK_DLLIST(src_dll);
578 CHECK_DLLIST(tgt_dll);
580 item = dllist_transfer_rac(XDLLIST(src_dll));
584 dllist_append_item(XDLLIST(tgt_dll), item);
590 dllist_pop_car(dllist_t dllist)
595 if ((old = dllist_transfer_car(dllist)) == NULL)
598 /* save the lisp data and free the item */
600 free_dllist_item(old);
604 DEFUN("dllist-pop-car", Fdllist_pop_car, 1, 1, 0, /*
605 Remove the front element of DLLIST and return it.
610 CHECK_DLLIST(dllist);
611 if ((result = dllist_pop_car(XDLLIST(dllist))) != NULL)
612 return (Lisp_Object)result;
618 dllist_pop_rac(dllist_t dllist)
623 if ((old = dllist_transfer_rac(dllist)) == NULL)
626 /* save the lisp data and free the item */
628 free_dllist_item(old);
632 DEFUN("dllist-pop-rac", Fdllist_pop_rac, 1, 1, 0, /*
633 Remove the back element of DLLIST and return it.
638 CHECK_DLLIST(dllist);
639 if ((result = dllist_pop_rac(XDLLIST(dllist))) != NULL)
640 return (Lisp_Object)result;
646 dllist_rrotate(dllist_t dllist)
653 ofr = dllist_first(dllist);
654 oba = dllist_last(dllist);
657 /* unlock the mutex due to non-local exit */
662 oba->prev->next = NULL;
663 dllist_last(dllist) = oba->prev;
666 dllist_first(dllist) = oba;
669 /* save the lisp data and free the item */
675 DEFUN("dllist-rrotate", Fdllist_rrotate, 1, 1, 0, /*
676 Remove the back element of DLLIST and prepend it to the front.
680 CHECK_DLLIST(dllist);
681 dllist_rrotate(XDLLIST(dllist));
686 dllist_lrotate(dllist_t dllist)
693 ofr = dllist_first(dllist);
694 oba = dllist_last(dllist);
697 /* unlock the mutex due to non-local exit */
702 ofr->next->prev = NULL;
703 dllist_first(dllist) = ofr->next;
706 dllist_last(dllist) = ofr;
709 /* save the lisp data and free the item */
715 DEFUN("dllist-lrotate", Fdllist_lrotate, 1, 1, 0, /*
716 Remove the head element of DLLIST and append it to the back.
720 CHECK_DLLIST(dllist);
721 dllist_lrotate(XDLLIST(dllist));
726 DEFUN("dllist-size", Fdllist_size, 1, 1, 0, /*
727 Return the size of DLLIST, that is the number of elements.
732 CHECK_DLLIST(dllist);
733 WITH_DLL_LOCK(XDLLIST(dllist), result = XDLLIST_SIZE(dllist));
734 return make_int(result);
739 copy_dllist(dllist_t dllist)
741 dllist_t dl_copy = make_dllist();
745 elm = dllist_first(dllist);
748 dllist_append(dl_copy, elm->item);
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
763 CHECK_DLLIST(dllist);
765 return wrap_dllist(copy_dllist(XDLLIST(dllist)));
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.
776 /* this function can GC */
778 Lisp_Object result = Qnil;
779 struct gcpro gcpro1, gcpro2;
781 CHECK_DLLIST(dllist);
783 GCPRO2(dllist, result);
785 DLL_LOCK(XDLLIST(dllist));
786 /* traverse the list */
787 tmp = XDLLIST_LAST(dllist);
789 result = Fcons((Lisp_Object)tmp->item, result);
792 DLL_UNLOCK(XDLLIST(dllist));
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
806 Lisp_Object result = Qnil;
807 struct gcpro gcpro1, gcpro2;
809 CHECK_DLLIST(dllist);
811 GCPRO2(dllist, result);
813 DLL_LOCK(XDLLIST(dllist));
814 /* traverse the list */
815 tmp = XDLLIST_FIRST(dllist);
817 result = Fcons((Lisp_Object)tmp->item, result);
820 DLL_UNLOCK(XDLLIST(dllist));
827 dllist_map_inplace(Lisp_Object function, Lisp_Object dllist)
830 struct gcpro gcpro1, gcpro2;
832 GCPRO2(function, dllist);
834 WITH_DLLIST_TRAVERSE(
837 arr[1] = (long int)dllist_item;
838 tmp = Ffuncall(2, arr);
839 dllist_item = (void*)tmp);
844 dllist_map_inplace_C(void*(*fun)(void*), dllist_t dllist)
846 /* This cannot GC, it is intended for noseeum dllists anyway */
847 WITH_DLLIST_TRAVERSE(dllist, dllist_item = fun(dllist_item));
851 dllist_map_C(void(*fun)(void*), dllist_t dllist)
853 /* This cannot GC, it is intended for noseeum dllists anyway */
854 WITH_DLLIST_TRAVERSE(dllist, fun(dllist_item));
858 * Initialisation stuff
863 INIT_LRECORD_IMPLEMENTATION(dllist);
865 defsymbol(&Qdllistp, "dllistp");
866 defsymbol(&Qdllist, "dllist");
869 DEFSUBR(Fdllist_plist);
872 DEFSUBR(Fdllist_empty_p);
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);
888 DEFSUBR(Fcopy_dllist);
890 DEFSUBR(Fdllist_to_list);
891 DEFSUBR(Fdllist_to_list_reversed);
897 /* the category subsystem */
898 morphisms[lrecord_type_dllist].seq_impl = &__sdll;
908 /* dllist.c ends here */