APPROVE COMMIT
NOTE: This patch has been committed
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1534094075 -3600
# Sun Aug 12 18:14:35 2018 +0100
# Node ID ab23fd48c3f8a61e865ba71d810104fd96610aee
# Parent 39f424909e0c055c65f16e855a9de8b806b04f0f
Move the weak-box implementation to Lisp.
lisp/ChangeLog addition:
2018-08-12 Aidan Kehoe <kehoea(a)parhasard.net>
* misc.el:
* misc.el (weak-box-p): New.
* misc.el (make-weak-box): New.
* misc.el (weak-box-ref): New.
Move all these functions here from data.c.
src/ChangeLog addition:
2018-08-12 Aidan Kehoe <kehoea(a)parhasard.net>
* data.c:
* data.c (syms_of_data):
* data.c (vars_of_data):
* gc.c (gc_finish_mark):
* gc.c (gc_finalize):
* lisp.h:
* lrecord.h (enum lrecord_type):
Remove the weak-box implementation from C. It was never used
enough to merit being in C, and it is easily implemented in Lisp
using the weak list infrastructure.
diff -r 39f424909e0c -r ab23fd48c3f8 lisp/ChangeLog
--- a/lisp/ChangeLog Sun Aug 12 17:52:59 2018 +0100
+++ b/lisp/ChangeLog Sun Aug 12 18:14:35 2018 +0100
@@ -1,3 +1,11 @@
+2018-08-12 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * misc.el:
+ * misc.el (weak-box-p): New.
+ * misc.el (make-weak-box): New.
+ * misc.el (weak-box-ref): New.
+ Move all these functions here from data.c.
+
2018-07-17 Aidan Kehoe <kehoea(a)parhasard.net>
* backquote.el (bq-process):
diff -r 39f424909e0c -r ab23fd48c3f8 lisp/misc.el
--- a/lisp/misc.el Sun Aug 12 17:52:59 2018 +0100
+++ b/lisp/misc.el Sun Aug 12 18:14:35 2018 +0100
@@ -63,4 +63,40 @@
(+ n (point)))))))
(insert string)))
+
+;;; Weak boxes, formerly in data.c, but never used enough to merit a C
+;;; implementation.
+
+(autoload 'all-weak-boxes-list "misc")
+
+(defun weak-box-p (object)
+ "Return non-nil if OBJECT is a weak box."
+ (and (vectorp object) (eql (length object) 1)
+ (eq 'cl-weak-box (aref object 0))))
+
+(defun make-weak-box (contents)
+ "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."
+ (caar (set-weak-list-list
+ (load-time-value
+ (progn
+ (defvar #1=#:all-weak-boxes (make-weak-list 'assoc))
+ (defalias 'all-weak-boxes-list
+ ;; If the weak box code is actually used, this #'copy-list
+ ;; might be an issue in terms of GC. It isn't, currently, and
+ ;; so the protection against other callers modifying the list
+ ;; out from under the feet of our code is preferred.
+ #'(lambda () (copy-list (weak-list-list #1#))))
+ #1#))
+ (acons (vector 'cl-weak-box) contents (all-weak-boxes-list)))))
+
+(defun weak-box-ref (weak-box)
+ "Return the contents of weak box WEAK-BOX.
+If the contents have been GCed, return NIL."
+ (check-argument-type 'weak-box-p weak-box)
+ (cdr (assq weak-box (all-weak-boxes-list))))
+
;;; misc.el ends here
diff -r 39f424909e0c -r ab23fd48c3f8 src/ChangeLog
--- a/src/ChangeLog Sun Aug 12 17:52:59 2018 +0100
+++ b/src/ChangeLog Sun Aug 12 18:14:35 2018 +0100
@@ -1,3 +1,16 @@
+2018-08-12 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * data.c:
+ * data.c (syms_of_data):
+ * data.c (vars_of_data):
+ * gc.c (gc_finish_mark):
+ * gc.c (gc_finalize):
+ * lisp.h:
+ * lrecord.h (enum lrecord_type):
+ Remove the weak-box implementation from C. It was never used
+ enough to merit being in C, and it is easily implemented in Lisp
+ using the weak list infrastructure.
+
2018-08-12 Aidan Kehoe <kehoea(a)parhasard.net>
* gc.c (gc_finish_mark):
diff -r 39f424909e0c -r ab23fd48c3f8 src/data.c
--- a/src/data.c Sun Aug 12 17:52:59 2018 +0100
+++ b/src/data.c Sun Aug 12 18:14:35 2018 +0100
@@ -3637,135 +3637,6 @@
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;
- int removep = 0;
-
- for (rest = Vall_weak_boxes;
- !NILP(rest);
- rest = XWEAK_BOX (rest)->next_weak_box)
- {
- if (! (marked_p (rest)))
- /* This weak box itself is garbage. */
- removep = 1;
-
- if (! marked_p (XWEAK_BOX (rest)->value))
- {
- XSET_WEAK_BOX (rest, Qnil);
- removep = 1;
- }
-
- if (removep)
- {
- /* Remove weak box from 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;
- removep = 0;
- }
- else
- prev = rest;
- }
-}
-
-static Lisp_Object
-mark_weak_box (Lisp_Object UNUSED (obj))
-{
- return Qnil;
-}
-
-static void
-print_weak_box (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
-{
- if (print_readably)
- {
- printing_unreadable_lisp_object (obj, 0);
- }
-
- write_ascstring (printcharfun, "#<weak-box ");
- print_internal (XWEAK_BOX (obj)->value, printcharfun, escapeflag);
- write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj));
-}
-
-static int
-weak_box_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, int foldcase)
-{
- struct weak_box *wb1 = XWEAK_BOX (obj1);
- struct weak_box *wb2 = XWEAK_BOX (obj2);
-
- return (internal_equal_0 (wb1->value, wb2->value, depth + 1, foldcase));
-}
-
-static Hashcode
-weak_box_hash (Lisp_Object obj, int depth, Boolint equalp)
-{
- struct weak_box *wb = XWEAK_BOX (obj);
-
- return internal_hash (wb->value, depth + 1, equalp);
-}
-
-Lisp_Object
-make_weak_box (Lisp_Object value)
-{
- Lisp_Object result = ALLOC_NORMAL_LISP_OBJECT (weak_box);
- struct weak_box *wb = XWEAK_BOX (result);
-
- wb->value = value;
- result = wrap_weak_box (wb);
- wb->next_weak_box = Vall_weak_boxes;
- Vall_weak_boxes = result;
- return result;
-}
-
-static const struct memory_description weak_box_description[] = {
- { XD_LO_LINK, offsetof (struct weak_box, value) },
- { XD_END}
-};
-
-DEFINE_NODUMP_LISP_OBJECT ("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.
-*/
- (weak_box))
-{
- return XWEAK_BOX (weak_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;
-}
-
/************************************************************************/
/* ephemerons */
/************************************************************************/
@@ -4357,7 +4228,6 @@
{
INIT_LISP_OBJECT (weak_list);
INIT_LISP_OBJECT (ephemeron);
- INIT_LISP_OBJECT (weak_box);
DEFSYMBOL (Qlambda);
DEFSYMBOL (Qlistp);
@@ -4467,9 +4337,6 @@
DEFSUBR (Fmake_ephemeron);
DEFSUBR (Fephemeron_ref);
DEFSUBR (Fephemeronp);
- DEFSUBR (Fmake_weak_box);
- DEFSUBR (Fweak_box_ref);
- DEFSUBR (Fweak_boxp);
}
void
@@ -4482,8 +4349,6 @@
Vfinalize_list = Qnil;
staticpro (&Vfinalize_list);
- DUMP_ADD_WEAK_OBJECT_CHAIN (Vall_weak_boxes);
-
DEFVAR_CONST_INT ("most-negative-fixnum", &Vmost_negative_fixnum /*
The fixnum closest in value to negative infinity.
*/);
diff -r 39f424909e0c -r ab23fd48c3f8 src/gc.c
--- a/src/gc.c Sun Aug 12 17:52:59 2018 +0100
+++ b/src/gc.c Sun Aug 12 18:14:35 2018 +0100
@@ -2146,14 +2146,15 @@
;
#endif /* not USE_KKCC */
- /* And prune (this needs to be called after everything else has been
- marked and before we do any sweeping). */
- /* #### this is somewhat ad-hoc and should probably be an object
- method */
+ /* And prune (this needs to be called after everything else has been marked
+ and before we do any sweeping). If you're considering whether you would
+ like to add a prune function for a new object type you have added,
+ consider implementing the mark-and-prune approach as a weak list first of
+ all, and only if that doesn't work or is uneconomic of memory, consider
+ adding another entry here. */
prune_weak_lists ();
prune_weak_hash_tables ();
prune_ephemerons ();
- prune_weak_boxes ();
}
#ifdef NEW_GC
diff -r 39f424909e0c -r ab23fd48c3f8 src/lisp.h
--- a/src/lisp.h Sun Aug 12 17:52:59 2018 +0100
+++ b/src/lisp.h Sun Aug 12 18:14:35 2018 +0100
@@ -3416,28 +3416,6 @@
Lisp_Object value,
Error_Behavior errb));
-/*---------------------------- weak boxes ------------------------------*/
-
-struct weak_box
-{
- NORMAL_LISP_OBJECT_HEADER header;
- Lisp_Object value;
-
- Lisp_Object next_weak_box; /* don't mark through this! */
-};
-
-void prune_weak_boxes (void);
-Lisp_Object make_weak_box (Lisp_Object value);
-Lisp_Object weak_box_ref (Lisp_Object value);
-
-DECLARE_LISP_OBJECT (weak_box, struct weak_box);
-#define XWEAK_BOX(x) XRECORD (x, weak_box, struct weak_box)
-#define XSET_WEAK_BOX(x, v) (XWEAK_BOX (x)->value = (v))
-#define wrap_weak_box(p) wrap_record (p, weak_box)
-#define WEAK_BOXP(x) RECORDP (x, weak_box)
-#define CHECK_WEAK_BOX(x) CHECK_RECORD (x, weak_box)
-#define CONCHECK_WEAK_BOX(x) CONCHECK_RECORD (x, weak_box)
-
/*--------------------------- ephemerons ----------------------------*/
struct ephemeron
diff -r 39f424909e0c -r ab23fd48c3f8 src/lrecord.h
--- a/src/lrecord.h Sun Aug 12 17:52:59 2018 +0100
+++ b/src/lrecord.h Sun Aug 12 18:14:35 2018 +0100
@@ -395,7 +395,6 @@
lrecord_type_tooltalk_message, /* Lisp_Tooltalk_Message */
lrecord_type_tooltalk_pattern, /* Lisp_Tooltalk_Pattern */
lrecord_type_vector, /* Lisp_Vector */
- lrecord_type_weak_box, /* struct weak_box */
lrecord_type_weak_list, /* struct weak_list */
lrecord_type_window, /* struct window */
lrecord_type_window_mirror, /* struct window_mirror */
--
‘As I sat looking up at the Guinness ad, I could never figure out /
How your man stayed up on the surfboard after forty pints of stout’
(C. Moore)