xemacs-beta: src/data.c comparison

comparison src/data.c @ 858:2c12fe2da451

[xemacs-hg @ 2002-05-31 09:38:45 by michaels] 2002-05-28 Martin Köbele <mkoebele@mkoebele.de>, Jens Müller <jmueller@informatik.uni-tuebingen.de> * lrecord.h (lrecord_type): Add lrecord_type_weak_box to lrecord_type enumeration. * alloc.c (garbage_collect_1): Call prune_weak_boxes(). * lisp.h (struct weak_box): * data.c: (prune_weak_boxes): (mark_weak_box): (print_weak_box): (weak_box_equal): (weak_box_hash): (make_weak_box): (Fmake_weak_box): (Fweak_box_ref): (Fweak_boxp): (syms_of_data): (vars_of_data): Add implementation of weak boxes.

author	michaels
date	Fri, 31 May 2002 09:38:49 +0000
parents	6728e641994e
children	804517e16990

comparison

equal deleted inserted replaced

-:b5278486690c
+:2c12fe2da451
 CHECK_WEAK_LIST (weak);
 XWEAK_LIST_LIST (weak) = new_list;
 return new_list;
 }
+/************************************************************************/
+/*                              weak boxes                              */
+/************************************************************************/
+static Lisp_Object Vall_weak_boxes; /* Gemarke es niemals ever!!! */
+void
+prune_weak_boxes (void)
+{
+Lisp_Object rest, prev = Qnil;
+for (rest = Vall_weak_boxes;
+!NILP(rest);
+rest = XWEAK_BOX (rest)->next_weak_box)
+{
+if (! (marked_p (rest)))
+	/* This weak box itself is garbage.  Remove it from the list. */
+	if (NILP (prev))
+	  Vall_weak_boxes = XWEAK_BOX (rest)->next_weak_box;
+	else
+	  XWEAK_BOX (prev)->next_weak_box = XWEAK_BOX (rest)->next_weak_box;
+else if (!marked_p(XWEAK_BOX (rest)->value))
+	XSET_WEAK_BOX (rest, Qnil);
+}
+}
+static Lisp_Object
+mark_weak_box (Lisp_Object obj)
+{
+return Qnil;
+}
+static void
+print_weak_box (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
+{
+if (print_readably)
+printing_unreadable_object ("#<weak_box>");
+write_fmt_string (printcharfun, "#<weak_box>");
+}
+static int
+weak_box_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
+{
+struct weak_box *b1 = XWEAK_BOX (obj1);
+struct weak_box *b2 = XWEAK_BOX (obj2);
+return (internal_equal (b1->value, b2->value, depth + 1));
+}
+static Hashcode
+weak_box_hash (Lisp_Object obj, int depth)
+{
+struct weak_box *b = XWEAK_BOX (obj);
+return internal_hash (b->value, depth + 1);
+}
+Lisp_Object
+make_weak_box (Lisp_Object value)
+{
+Lisp_Object result;
+struct weak_box *wb =
+alloc_lcrecord_type (struct weak_box, &lrecord_weak_box);
+wb->value = value;
+result = wrap_weak_box (wb);
+wb->next_weak_box = Vall_weak_boxes;
+Vall_weak_boxes = result;
+return result;
+}
+static const struct lrecord_description weak_box_description[] = {
+{ XD_LO_LINK, offsetof (struct weak_box, value) },
+{ XD_END}
+};
+DEFINE_LRECORD_IMPLEMENTATION ("weak_box", weak_box,
+			       mark_weak_box, print_weak_box,
+			       0, weak_box_equal, weak_box_hash,
+			       weak_box_description,
+			       struct weak_box);
+DEFUN ("make-weak-box", Fmake_weak_box, 1, 1, 0, /*
+Return a new weak box from value CONTENTS.
+The weak box is a reference to CONTENTS which may be extracted with
+`weak-box-ref'.  However, the weak box does not contribute to the
+reachability of CONTENTS.  When CONTENTS is garbage-collected,
+`weak-box-ref' will return NIL.
+*/
+(value))
+{
+return make_weak_box(value);
+}
+DEFUN ("weak-box-ref", Fweak_box_ref, 1, 1, 0, /*
+Return the contents of weak box WEAK-BOX.
+If the contents have been GCed, return NIL.
+*/
+(box))
+{
+return XWEAK_BOX(box)->value;
+}
+DEFUN ("weak-box-p", Fweak_boxp, 1, 1, 0, /*
+Return non-nil if OBJECT is a weak box.
+*/
+(object))
+{
+return WEAK_BOXP (object) ? Qt : Qnil;
+}
 /************************************************************************/
 /*                            initialization                            */
 /************************************************************************/
 void
 syms_of_data (void)
 {
 INIT_LRECORD_IMPLEMENTATION (weak_list);
+INIT_LRECORD_IMPLEMENTATION (weak_box);
 DEFSYMBOL (Qquote);
 DEFSYMBOL (Qlambda);
 DEFSYMBOL (Qlistp);
 DEFSYMBOL (Qtrue_list_p);
 DEFSUBR (Fweak_list_p);
 DEFSUBR (Fmake_weak_list);
 DEFSUBR (Fweak_list_type);
 DEFSUBR (Fweak_list_list);
 DEFSUBR (Fset_weak_list_list);
+DEFSUBR (Fmake_weak_box);
+DEFSUBR (Fweak_box_ref);
+DEFSUBR (Fweak_boxp);
 }
 void
 vars_of_data (void)
 {
 /* This must not be staticpro'd */
 Vall_weak_lists = Qnil;
 dump_add_weak_object_chain (&Vall_weak_lists);
+Vall_weak_boxes = Qnil;
+dump_add_weak_object_chain (&Vall_weak_boxes);
 #ifdef DEBUG_XEMACS
 DEFVAR_BOOL ("debug-issue-ebola-notices", &debug_issue_ebola_notices /*
 If non-zero, note when your code may be suffering from char-int confoundance.
 That is to say, if XEmacs encounters a usage of `eq', `memq', `equal',

Mercurial > hg > xemacs-beta

comparison src/data.c @ 858:2c12fe2da451