From c140a7819b9dae778aae8c4e01b6ed545f57244c Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Tue, 30 Jul 1991 00:40:04 +0000 Subject: [PATCH] Initial revision --- code/scavhook.lisp | 55 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 55 insertions(+) create mode 100644 code/scavhook.lisp diff --git a/code/scavhook.lisp b/code/scavhook.lisp new file mode 100644 index 000000000..78851b051 --- /dev/null +++ b/code/scavhook.lisp @@ -0,0 +1,55 @@ +;;; -*- Package: EXT -*- +;;; +;;; ********************************************************************** +;;; This code was written as part of the CMU Common Lisp project at +;;; Carnegie Mellon University, and has been placed in the public domain. +;;; If you want to use this code or any part of CMU Common Lisp, please contact +;;; Scott Fahlman or slisp-group@cs.cmu.edu. +;;; +(ext:file-comment + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/scavhook.lisp,v 1.1 1991/07/30 00:40:04 wlott Exp $") +;;; +;;; ********************************************************************** +;;; +;;; This file implements the ``Scavenger Hook'' extension. +;;; +;;; Written by William Lott +;;; + +(in-package "EXT") + +(export '(scavenger-hook scavenger-hook-p make-scavenger-hook + scavenger-hook-value scavenger-hook-function)) + +(defun scavenger-hook-p (object) + "Returns T if OBJECT is a scavenger-hook, and NIL if not." + (scavenger-hook-p object)) + +(defun make-scavenger-hook (&key value (function (required-argument))) + "Create a new scavenger-hook with the specified VALUE and FUNCTION. For + as long as the scavenger-hook is alive, the scavenger in the garbage + collector will note whenever VALUE is moved, and arrange for FUNCTION + to be funcalled." + (declare (type function function)) + (c::%make-scavenger-hook value function)) + +(defun scavenger-hook-value (scavhook) + "Returns the VALUE being monitored by SCAVHOOK. Can be setf." + (declare (type scavenger-hook scavhook)) + (scavenger-hook-value scavhook)) + +(defun (setf scavenger-hook-value) (value scavhook) + (declare (type scavenger-hook scavhook)) + (setf (scavenger-hook-value scavhook) value)) + +(defun scavenger-hook-function (scavhook) + "Returns the FUNCTION invoked when the monitored value is moved. Can be + setf." + (declare (type scavenger-hook scavhook)) + (scavenger-hook-function scavhook)) + +(defun (setf scavenger-hook-function) (function scavhook) + (declare (type function function) + (type scavenger-hook scavhook)) + (setf (scavenger-hook-function scavhook) function)) + -- GitLab