[Sbcl-commits] master: sb-profile: use ENCAPSULATE to wrap functions around.

[stassats <sta...@us...>]

The branch "master" has been updated in SBCL:
       via  1d97281c2848293be067267f21065b451d9e070c (commit)
      from  c89ad479253aa806c7d2f5ed1e9cd7d3a0ac2281 (commit)

- Log -----------------------------------------------------------------
commit 1d97281c2848293be067267f21065b451d9e070c
Author: Stas Boukarev <sta...@gm...>
Date:   Sun Feb 23 22:09:12 2014 +0400

    sb-profile: use ENCAPSULATE to wrap functions around.
    
    For better compatibility with generic functions, use ENCAPSULATE.
    
    Fixes lp#309086.
---
 NEWS                      |    2 ++
 src/code/fdefinition.lisp |    3 ++-
 src/code/profile.lisp     |   45 ++++++++++++++++++++++++---------------------
 src/pcl/methods.lisp      |    6 +++---
 4 files changed, 31 insertions(+), 25 deletions(-)

diff --git a/NEWS b/NEWS
index 3b265df..0302c8d 100644
--- a/NEWS
+++ b/NEWS
@@ -20,6 +20,8 @@ changes relative to sbcl-1.1.15:
     into code, prevent code with errors from being compiled. (lp#1276282)
   * bug fix: pathnames with :back in their directory component are succeffully
     resolved.
+  * bug fix: the deterministic profiler now uses ENCAPSULATE functionality to
+    wrap functions around. (lp#309086)
 
 changes in sbcl-1.1.15 relative to sbcl-1.1.14:
   * new feature: the iterative spilling/coloring register allocator developed
diff --git a/src/code/fdefinition.lisp b/src/code/fdefinition.lisp
index 87b8074..ae82197 100644
--- a/src/code/fdefinition.lisp
+++ b/src/code/fdefinition.lisp
@@ -121,7 +121,8 @@
     (let ((info (make-encapsulation-info type (fdefn-fun fdefn))))
       (setf (fdefn-fun fdefn)
             (named-lambda encapsulation (&rest arg-list)
-              (declare (special arg-list))
+              (declare (special arg-list)
+                       (dynamic-extent arg-list))
               (let ((basic-definition (encapsulation-info-definition info)))
                 (declare (special basic-definition))
                 (funcall function)))))))
diff --git a/src/code/profile.lisp b/src/code/profile.lisp
index da4f0b6..eaa8fbb 100644
--- a/src/code/profile.lisp
+++ b/src/code/profile.lisp
@@ -153,8 +153,7 @@
 ;;; (The reason for implementing this as coupled closures, with the
 ;;; counts built into the lexical environment, is that we hope this
 ;;; will minimize profiling overhead.)
-(defun profile-encapsulation-lambdas (encapsulated-fun)
-  (declare (type function encapsulated-fun))
+(defun profile-encapsulation-lambdas ()
   (let* ((count (make-counter))
          (ticks (make-counter))
          (consing (make-counter))
@@ -163,8 +162,9 @@
     (declare (counter count ticks consing profiles gc-run-time))
     (values
      ;; ENCAPSULATION-FUN
-     (lambda (&more arg-context arg-count)
-       (declare (optimize speed safety))
+     (lambda ()
+       (declare (optimize speed safety)
+                (special sb-int:basic-definition))
        ;; Make sure that we're not recursing infinitely.
        (when (boundp '*computing-profiling-data-for*)
          (unprofile-all) ; to avoid further recursion
@@ -173,14 +173,15 @@
                     functions have been unprofiled. (Since the profiling system evidently ~
                     uses ~S in its computations, it looks as though it's a bad idea to ~
                     profile it.)~:@>"
-                *computing-profiling-data-for* encapsulated-fun
-                encapsulated-fun))
+                *computing-profiling-data-for* sb-int:basic-definition sb-int:basic-definition))
        (incf-counter count 1)
-       (let ((dticks 0)
+       (let ((encapsulated-fun sb-int:basic-definition)
+             (dticks 0)
              (dconsing 0)
              (inner-enclosed-profiles 0)
              (dgc-run-time 0))
-         (declare (truly-dynamic-extent dticks dconsing inner-enclosed-profiles))
+         (declare (function encapsulated-fun)
+                  (truly-dynamic-extent dticks dconsing inner-enclosed-profiles))
          (unwind-protect
              (let* ((start-ticks (get-internal-ticks))
                     (start-gc-run-time *gc-run-time*)
@@ -190,12 +191,18 @@
                     (nbf0 *n-bytes-freed-or-purified*)
                     (dynamic-usage-0 (sb-kernel:dynamic-usage))
                     (*enclosed-gc-run-time* (make-counter)))
-               (declare (dynamic-extent *enclosed-ticks* *enclosed-consing* *enclosed-profiles* *enclosed-gc-run-time*))
+               (declare (dynamic-extent *enclosed-ticks* *enclosed-consing*
+                                        *enclosed-profiles* *enclosed-gc-run-time*)
+                        (special sb-int:arg-list))
                (unwind-protect
-                   (multiple-value-call encapsulated-fun
-                                        (sb-c:%more-arg-values arg-context
-                                                               0
-                                                               arg-count))
+                    ;; It used to use &more to call the original function, but
+                    ;; with transition to ENCAPSULATE it has to use a list,
+                    ;; until ENCAPSULATE has a better mechanism.
+                    ;; (multiple-value-call encapsulated-fun
+                    ;;   (sb-c:%more-arg-values arg-context
+                    ;;                          0
+                    ;;                          arg-count))
+                    (apply encapsulated-fun arg-list)
                  (let ((*computing-profiling-data-for* encapsulated-fun)
                        (dynamic-usage-1 (sb-kernel:dynamic-usage)))
                    (setf dticks (- (get-internal-ticks) start-ticks)
@@ -260,10 +267,9 @@
 (defun profile-1-unprofiled-fun (name)
   (let ((encapsulated-fun (fdefinition name)))
     (multiple-value-bind (encapsulation-fun read-stats-fun clear-stats-fun)
-        (profile-encapsulation-lambdas encapsulated-fun)
+        (profile-encapsulation-lambdas)
       (without-package-locks
-       (setf (fdefinition name)
-             encapsulation-fun))
+        (encapsulate name 'profile encapsulation-fun))
       (setf (gethash name *profiled-fun-name->info*)
             (make-profile-info :name name
                                :encapsulated-fun encapsulated-fun
@@ -288,11 +294,8 @@
   (let ((pinfo (gethash name *profiled-fun-name->info*)))
     (cond (pinfo
            (remhash name *profiled-fun-name->info*)
-           (if (eq (fdefinition name) (profile-info-encapsulation-fun pinfo))
-               (without-package-locks
-                (setf (fdefinition name) (profile-info-encapsulated-fun pinfo)))
-               (warn "preserving current definition of redefined function ~S"
-                     name)))
+           (without-package-locks
+             (unencapsulate name 'profile)))
           (t
            (warn "~S is not a profiled function." name))))
   (values))
diff --git a/src/pcl/methods.lisp b/src/pcl/methods.lisp
index c8dcba2..02ce256 100644
--- a/src/pcl/methods.lisp
+++ b/src/pcl/methods.lisp
@@ -1649,9 +1649,9 @@
       (let ((inner (maybe-encapsulate-discriminating-function
                     gf (cdr encs) std))
             (function (cdar encs)))
-        (lambda (&rest args)
-          (let ((sb-int:arg-list args)
-                (sb-int:basic-definition inner))
+        (lambda (&rest sb-int:arg-list)
+          (declare (special sb-int:arg-list))
+          (let ((sb-int:basic-definition inner))
             (declare (special sb-int:arg-list sb-int:basic-definition))
             (funcall function))))))
 (defmethod compute-discriminating-function ((gf standard-generic-function))

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL