[prev in list] [next in list] [prev in thread] [next in thread] 

List:       sbcl-help
Subject:    Re: [Sbcl-help] Customizing trace output
From:       Luís_Oliveira <luismbo () gmail ! com>
Date:       2021-04-05 11:34:34
Message-ID: CAB-HnLTOLMge708-0h8CQdCzCvzMiyhPQ5GnGzszLNTp0k06qg () mail ! gmail ! com
[Download RAW message or body]

On Mon, 5 Apr 2021 at 00:25, Stavros Macrakis <macrakis@alum.mit.edu> wrote=
:
> I would like to customize the printout of SBCL's trace. Doug Katzman ment=
ioned last month that he had some code for this, but that he can't put his =
hands on it....
>
> Does anyone have an example of customizing trace output that I could use =
as a model? Trying to read ntrace, I am really getting lost in the weeds...=
.

I have some work-in-progress patches related to tracing, one of which
allows an arbitrary function as the :report argument to trace. I hope
to send them very soon, but I've attached that particular patch in
case you'd like to play with it.

Example usage:
  (defun custom-report (depth what when frame values)
    (format t "~&~a: ~a ~a ~a ~a~%" depth what when frame values))

  (trace foo :report custom-report)

Cheers,
Lu=C3=ADs

["01-custom-trace-reports.patch" (application/octet-stream)]

From 94fedccab4c7570d431b56e8005d7b6d8b5bfa3c Mon Sep 17 00:00:00 2001
From: =?utf-8?q?Luís Borges de Oliveira?= <lbo@siscog.pt>
Date: Thu, 14 Jan 2021 18:30:28 +0000
Subject: WIP: custom trace reports

Change-Id: Iaad5e0e6f18943e7fdf2420295bc34a70984e4a8

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 09bbe4707..846e64e99 100644
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -479,6 +479,7 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*."
                "INTERNAL-DEBUG" "VAR"
                "*STACK-TOP-HINT*"
                "*TRACE-ENCAPSULATE-DEFAULT*"
+               "*TRACE-REPORT-DEFAULT*"
                "FRAME-HAS-DEBUG-TAG-P"
                "UNWIND-TO-FRAME-AND-CALL"
                ;; Deprecated
diff --git a/src/code/early-ntrace.lisp b/src/code/early-ntrace.lisp
index c57382260..f429eb738 100644
--- a/src/code/early-ntrace.lisp
+++ b/src/code/early-ntrace.lisp
@@ -20,6 +20,10 @@ defvar *max-trace-indentation*

 (defvar *trace-encapsulate-default* t
   "the default value for the :ENCAPSULATE option to TRACE")
+
+(defvar *trace-report-default* 'trace
+  "the default value for the :REPORT option to TRACE")
+
 
 ;;;; internal state

@@ -29,7 +33,7 @@ define-load-time-global *traced-funs*
     (make-hash-table :test 'eq :synchronized t))

 (deftype trace-report-type ()
-  '(member nil trace))
+  '(or symbol function))

 ;;; A TRACE-INFO object represents all the information we need to
 ;;; trace a given function.
@@ -64,7 +68,7 @@ defstruct (trace-info
   ;; (the default.)

   ;; report type
-  (report 'trace :type trace-report-type)
+  (report *trace-report-default* :type trace-report-type)
   ;; current environment forms
   (condition nil)
   (break nil)
diff --git a/src/code/ntrace.lisp b/src/code/ntrace.lisp
index 9740ff000..5999fd111 100644
--- a/src/code/ntrace.lisp
+++ b/src/code/ntrace.lisp
@@ -183,7 +183,7 @@ defun trace-start-breakpoint-fun
                  (*current-level-in-print* 0)
                  (*standard-output* (make-string-output-stream))
                  (*in-trace* t))
-             (ecase (trace-info-report info)
+             (case (trace-info-report info)
                (trace
                 (fresh-line)
                 (print-trace-indentation)
@@ -194,6 +194,11 @@ defun trace-start-breakpoint-fun
                 (terpri)
                 (apply #'trace-print frame (trace-info-print info) args))
                ((nil)
+                (apply #'trace-print-unadorned frame (trace-info-print info) args))
+               (t
+                (funcall (trace-info-report info)
+                         (count-if #'cdr *traced-entries*)
+                         (trace-info-what info) :enter frame args)
                 (apply #'trace-print-unadorned frame (trace-info-print info) args)))
              (write-sequence (get-output-stream-string *standard-output*)
                              *trace-output*)
@@ -226,7 +231,7 @@ defun trace-end-breakpoint-fun
         (let ((*current-level-in-print* 0)
               (*standard-output* (make-string-output-stream))
               (*in-trace* t))
-          (ecase (trace-info-report info)
+          (case (trace-info-report info)
             (trace
              (fresh-line)
              (let ((*print-pretty* t))
@@ -241,6 +246,11 @@ defun trace-end-breakpoint-fun
                (terpri))
              (apply #'trace-print frame (trace-info-print-after info) values))
             ((nil)
+             (apply #'trace-print-unadorned frame (trace-info-print-after info) values))
+            (t
+             (funcall (trace-info-report info)
+                      (count-if #'cdr *traced-entries*)
+                      (trace-info-what info) :exit frame values)
              (apply #'trace-print-unadorned frame (trace-info-print-after info) values)))
           (write-sequence (get-output-stream-string *standard-output*)
                           *trace-output*)




_______________________________________________
Sbcl-help mailing list
Sbcl-help@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-help


[prev in list] [next in list] [prev in thread] [next in thread]