From 4ca189028e7da5b4a6c4ebfe9f34980677774033 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Mon, 10 Apr 2000 19:10:53 +0000 Subject: [PATCH] REMOVE-FROM-GC-FINALIZER! must return the value of the finalization procedure for the object being finalized. --- v7/src/runtime/gcfinal.scm | 29 ++++++++++++++--------------- 1 file changed, 14 insertions(+), 15 deletions(-) diff --git a/v7/src/runtime/gcfinal.scm b/v7/src/runtime/gcfinal.scm index 8ce1e8ea4..9798b53dc 100644 --- a/v7/src/runtime/gcfinal.scm +++ b/v7/src/runtime/gcfinal.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: gcfinal.scm,v 14.1 2000/04/10 18:32:17 cph Exp $ +$Id: gcfinal.scm,v 14.2 2000/04/10 19:10:53 cph Exp $ Copyright (c) 2000 Massachusetts Institute of Technology @@ -62,20 +62,19 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (define (remove-from-gc-finalizer! finalizer object) (guarantee-gc-finalizer finalizer 'REMOVE-FROM-GC-FINALIZER!) - (if (object-pointer? object) - (let ((procedure (gc-finalizer-procedure finalizer))) - (without-interrupts - (lambda () - (let loop ((items (gc-finalizer-items finalizer)) (prev #f)) - (if (pair? items) - (if (eq? object (weak-car (car items))) - (let ((next (cdr items))) - (if prev - (set-cdr! prev next) - (set-gc-finalizer-items! finalizer next)) - (procedure (weak-cdr (car items))) - (loop next prev)) - (loop (cdr items) items))))))))) + (and (object-pointer? object) + (let ((procedure (gc-finalizer-procedure finalizer))) + (without-interrupts + (lambda () + (let loop ((items (gc-finalizer-items finalizer)) (prev #f)) + (and (pair? items) + (if (eq? object (weak-car (car items))) + (let ((next (cdr items))) + (if prev + (set-cdr! prev next) + (set-gc-finalizer-items! finalizer next)) + (procedure (weak-cdr (car items)))) + (loop (cdr items) items))))))))) (define (remove-all-from-gc-finalizer! finalizer) (guarantee-gc-finalizer finalizer 'REMOVE-ALL-FROM-GC-FINALIZER!) -- 2.25.1