branch: externals/sly
commit 678583314f94fcb450c751c2caf8e59dd4152b5c
Author: Karsten Poeck <[email protected]>
Commit: João Távora <[email protected]>
clasp: implement profiling via metering
* slynk/backend/clasp.lisp: Use monitor.
* slynk/metering.lisp: Define Clasp on a bunch of things.
Cherry-picked-from: SLIME commit d7b27f75d172c34c8e2ad78bae1d7953f536040b
Co-authored-by: João Távora <[email protected]>
---
slynk/backend/clasp.lisp | 28 ++++++++++++----------------
slynk/metering.lisp | 32 +++++++++++++++++++++++++++-----
2 files changed, 39 insertions(+), 21 deletions(-)
diff --git a/slynk/backend/clasp.lisp b/slynk/backend/clasp.lisp
index 415f830..c5d2c9d 100644
--- a/slynk/backend/clasp.lisp
+++ b/slynk/backend/clasp.lisp
@@ -542,33 +542,29 @@
;;;; Profiling
-#+profile
-(progn
+;;;; as clisp and ccl
(defimplementation profile (fname)
- (when fname (eval `(profile:profile ,fname))))
+ (eval `(slynk-monitor:monitor ,fname))) ;monitor is a macro
+
+(defimplementation profiled-functions ()
+ slynk-monitor:*monitored-functions*)
(defimplementation unprofile (fname)
- (when fname (eval `(profile:unprofile ,fname))))
+ (eval `(slynk-monitor:unmonitor ,fname))) ;unmonitor is a macro
(defimplementation unprofile-all ()
- (profile:unprofile-all)
- "All functions unprofiled.")
+ (slynk-monitor:unmonitor))
(defimplementation profile-report ()
- (profile:report))
+ (slynk-monitor:report-monitoring))
(defimplementation profile-reset ()
- (profile:reset)
- "Reset profiling counters.")
-
-(defimplementation profiled-functions ()
- (profile:profile))
+ (slynk-monitor:reset-all-monitoring))
-(defimplementation profile-package (package callers methods)
- (declare (ignore callers methods))
- (eval `(profile:profile ,(package-name (find-package package)))))
-) ; #+profile (progn ...
+(defimplementation profile-package (package callers-p methods)
+ (declare (ignore callers-p methods))
+ (slynk-monitor:monitor-all package))
;;;; Threads
diff --git a/slynk/metering.lisp b/slynk/metering.lisp
index d5eab93..7226b09 100644
--- a/slynk/metering.lisp
+++ b/slynk/metering.lisp
@@ -351,7 +351,7 @@ Estimated total monitoring overhead: 0.88 seconds
;;; Warn people using the wrong Lisp
;;; ********************************
-#-(or clisp openmcl)
+#-(or clisp openmcl clasp)
(warn "metering.lisp does not support your Lisp implementation!")
;;; ********************************
@@ -395,14 +395,14 @@ Estimated total monitoring overhead: 0.88 seconds
;;; the beginning of time. time-units-per-second allows us to convert units
;;; to seconds.
-#-(or clisp openmcl)
+#-(or clasp clisp openmcl)
(eval-when (compile eval)
(warn
"You may want to supply implementation-specific get-time functions."))
(defconstant time-units-per-second internal-time-units-per-second)
-#+openmcl
+#+(or clasp openmcl)
(progn
(deftype time-type () 'unsigned-byte)
(deftype consing-type () 'unsigned-byte))
@@ -449,7 +449,11 @@ Estimated total monitoring overhead: 0.88 seconds
#+openmcl
(defmacro get-cons () `(the consing-type (ccl::total-bytes-allocated)))
-#-(or clisp openmcl)
+#+clasp
+(defmacro get-cons ()
+ `(the consing-type (gctools::bytes-allocated)))
+
+#-(or clasp clisp openmcl)
(progn
(eval-when (compile eval)
(warn "No consing will be reported unless a get-cons function is ~
@@ -550,7 +554,25 @@ Estimated total monitoring overhead: 0.88 seconds
(values req-num (or (/= 0 opt-num) rest-p key-p keywords allow-p))
(values 0 t))))
-#-(or clisp openmcl)
+#+clasp
+(defun required-arguments (name)
+ (multiple-value-bind (arglist foundp)
+ (core:function-lambda-list name)
+ (if foundp
+ (let ((position-and
+ (position-if #'(lambda (x)
+ (and (symbolp x)
+ (let ((name (symbol-name x)))
+ (and (>= (length name) 1)
+ (char= (schar name 0)
+ #\&)))))
+ arglist)))
+ (if position-and
+ (values position-and t)
+ (values (length arglist) nil)))
+ (values 0 t))))
+
+#-(or clasp clisp openmcl)
(progn
(eval-when (compile eval)
(warn
