If a lambda expression was traced twice, it was being added to the

advice population twice, despite the fact that it was already there.
However, only one copy of the trace advice would be installed.  Then,
do untrace would cause a failure because the second time that the
lambda expression was looked at it would contain no advice of that type.

diff --git a/v7/src/runtime/advice.scm b/v7/src/runtime/advice.scm
index b700cbc83b30e8362a8823fc3b0808728a61da7d..d24890f9f3c80822e8c67cb6dc02d5f606dc45be 100644 (file)
--- a/v7/src/runtime/advice.scm
+++ b/v7/src/runtime/advice.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/advice.scm,v 13.42 1987/03/17 18:48:26 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/advice.scm,v 13.43 1987/05/06 04:54:08 cph Exp $
 ;;;
 ;;;    Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -167,9 +167,9 @@
     (lambda (entry-advice exit-advice cont)
       (cont (if (memq advice entry-advice)
                entry-advice
-               (cons advice entry-advice))
-           exit-advice)))
-  (add-to-population! entry-advice-population lambda))
+               (begin (add-to-population! entry-advice-population lambda)
+                      (cons advice entry-advice)))
+           exit-advice))))
 
 (define (primitive-advise-exit lambda advice)
   (add-lambda-advice! lambda
@@ -177,20 +177,20 @@
       (cont entry-advice
            (if (memq advice exit-advice)
                exit-advice
-               (append! exit-advice (list advice))))))
-  (add-to-population! exit-advice-population lambda))
+               (begin (add-to-population! exit-advice-population lambda)
+                      (append! exit-advice (list advice))))))))
 
 (define ((primitive-advise-both new-entry-advice new-exit-advice) lambda)
   (add-lambda-advice! lambda
     (lambda (entry-advice exit-advice cont)
       (cont (if (memq new-entry-advice entry-advice)
                entry-advice
-               (cons new-entry-advice entry-advice))
+               (begin (add-to-population! entry-advice-population lambda)
+                      (cons new-entry-advice entry-advice)))
            (if (memq new-exit-advice exit-advice)
                exit-advice
-               (append! exit-advice (list new-exit-advice))))))
-  (add-to-population! entry-advice-population lambda)
-  (add-to-population! exit-advice-population lambda))
+               (begin (add-to-population! exit-advice-population lambda)
+                      (append! exit-advice (list new-exit-advice))))))))
 
 (define (eq?-adjoin object list)
   (if (memq object list)