Repositories / ecl.git / commitdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: c490e11)
Make TRACE write complete output lines instead of small fragments.
authorPhilipp Marek <philipp@marek.priv.at>
Sun, 2 Mar 2014 19:25:22 +0000 (20:25 +0100)
committerPhilipp Marek <philipp@marek.priv.at>
Sun, 2 Mar 2014 19:25:22 +0000 (20:25 +0100)
This increases performance, as eg. for SWANK much fewer packets have
to go across the wire.

The effective change is this:
  (princ
    (with-output-to-string (*trace-output*)
      ...
    *trace-output*))

src/lsp/trace.lsp patch | blob | blame | history

diff --git a/src/lsp/trace.lsp b/src/lsp/trace.lsp
index d67b694..8551fcb 100644 (file)
--- a/src/lsp/trace.lsp
+++ b/src/lsp/trace.lsp
@@ -148,35 +148,38 @@ all functions."
 
 (defun trace-print (direction fname vals &rest extras)
   (let ((indent (min (* (1- *trace-level*) 2) *trace-max-indent*))
-       (*print-circle* t))
-    (fresh-line *trace-output*)
-    (case direction
-      (ENTER
-       (multiple-value-bind (bars rem)
-          (floor indent 4)
-        (dotimes (i bars) (princ (if (< i 10) "|   " "|    ") *trace-output*))
-        (when (plusp rem) (format *trace-output* "~V,,,' A" rem "|")))
-       (format *trace-output*
-              "~D> (~S~{ ~S~})~%"
-              *trace-level* fname vals))
-      (EXIT
-       (multiple-value-bind (bars rem)
-          (floor indent 4)
-        (dotimes (i bars) (princ "|   " *trace-output*))
-        (when (plusp rem) (format *trace-output* "~V,,,' A" rem "|")))
-       (format *trace-output*
-              "<~D (~S~{ ~S~})~%"
-              *trace-level*
-              fname vals)
-       ))
-    (when extras
-      (multiple-value-bind (bars rem)
-         (floor indent 4)
-       (dotimes (i bars) (princ "|   " *trace-output*))
-       (when (plusp rem) (format *trace-output* "~V,,,' A" rem "|")))
-      (format *trace-output*
-             "~0,4@T\\\\ ~{ ~S~}~%"
-             extras))))
+        (*print-circle* t))
+    (princ
+      (with-output-to-string (*trace-output*)
+        (fresh-line *trace-output*)
+        (case direction
+          (ENTER
+            (multiple-value-bind (bars rem)
+              (floor indent 4)
+              (dotimes (i bars) (princ (if (< i 10) "|   " "|    ") *trace-output*))
+              (when (plusp rem) (format *trace-output* "~V,,,' A" rem "|")))
+            (format *trace-output*
+                    "~D> (~S~{ ~S~})~%"
+                    *trace-level* fname vals))
+          (EXIT
+            (multiple-value-bind (bars rem)
+              (floor indent 4)
+              (dotimes (i bars) (princ "|   " *trace-output*))
+              (when (plusp rem) (format *trace-output* "~V,,,' A" rem "|")))
+            (format *trace-output*
+                    "<~D (~S~{ ~S~})~%"
+                    *trace-level*
+                    fname vals)
+            ))
+        (when extras
+          (multiple-value-bind (bars rem)
+            (floor indent 4)
+            (dotimes (i bars) (princ "|   " *trace-output*))
+            (when (plusp rem) (format *trace-output* "~V,,,' A" rem "|")))
+          (format *trace-output*
+                  "~0,4@T\\\\ ~{ ~S~}~%"
+                  extras))
+        *trace-output*))))
 
 (defun trace-record (fname)
   (declare (si::c-local))
Embeddable Common Lisp (Official: https://gitlab.com/embeddable-common-lisp/ecl)