[COMMIT] Move the weak-box implementation to Lisp.

APPROVE COMMIT NOTE: This patch has been committed # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net&gt; # 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&gt; * 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&gt; * 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&gt; + + * 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&gt; * 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&gt; + + * 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&gt; * 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)