From 3e18100038a0514b1ea6bee01a141f1477fdfbf6 Mon Sep 17 00:00:00 2001
From: Andrea Corallo <andrea_corallo@yahoo.it>
Date: Sun, 11 Aug 2019 11:59:31 +0200
Subject: [PATCH] implement log-buffer

---
 lisp/emacs-lisp/comp.el | 50 +++++++++++++++++++++++++++++++----------
 1 file changed, 38 insertions(+), 12 deletions(-)

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 79f987bd4c8..29d1625009f 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -35,7 +35,13 @@
   "Emacs Lisp native compiler."
   :group 'lisp)
 
-(defconst comp-debug t)
+(defcustom comp-debug t
+  "Log compilation process."
+  :type 'boolean
+  :group 'comp)
+
+(defconst native-compile-log-buffer "*Native-compile-Log*"
+  "Name of the native-compiler's log buffer.")
 
 ;; FIXME these has to be removed
 (defvar comp-speed 2)
@@ -137,14 +143,35 @@ LIMPLE basic block.")
   (block-name nil :type 'symbol
     :documentation "Current basic block name."))
 
-(defun comp-pretty-print-func (func)
-  "Pretty print function FUNC in the current buffer."
-  (insert (format "\n\n Function: %s" (comp-func-symbol-name func)))
-  (cl-loop for block-name being each hash-keys of (comp-func-blocks func)
-           using (hash-value bb)
-           do (progn
-                (insert (concat "\n<" (symbol-name block-name) ">"))
-                (cl-prettyprint (comp-block-insns bb)))))
+(defmacro comp-within-log-buff (&rest body)
+  "Execute BODY while at the end the log-buffer.
+BODY is evaluate only if `comp-debug' is non nil."
+  (declare (debug (form body))
+           (indent defun))
+  `(when comp-debug
+     (with-current-buffer (get-buffer-create native-compile-log-buffer)
+       (setq buffer-read-only t)
+       (let ((inhibit-read-only t))
+         (goto-char (point-max))
+         ,@body))))
+
+(defun comp-log (string)
+  "Log a STRING into the log-buffer."
+  (comp-within-log-buff
+    (cond (noninteractive
+	   (message " %s" string))
+	  (t
+	   (insert (format "%s\n" string))))))
+
+(defun comp-log-func (func)
+  "Pretty print function FUNC in the log-buffer."
+  (comp-within-log-buff
+    (insert (format "\n\n Function: %s" (comp-func-symbol-name func)))
+    (cl-loop for block-name being each hash-keys of (comp-func-blocks func)
+             using (hash-value bb)
+             do (progn
+                  (insert (concat "\n<" (symbol-name block-name) ">"))
+                  (cl-prettyprint (comp-block-insns bb))))))
 
 
 ;;; spill-lap pass specific code.
@@ -184,7 +211,7 @@ LIMPLE basic block.")
   (let (byte-compile-lap-output)
     (setf (comp-func-byte-func func)
           (byte-compile (comp-func-symbol-name func)))
-    (when comp-debug
+    (comp-within-log-buff
       (cl-prettyprint byte-compile-lap-output))
     (let ((lambda-list (aref (comp-func-byte-func func) 0)))
       (if (fixnump lambda-list)
@@ -689,8 +716,7 @@ the annotation emission."
     (cl-loop for bb being the hash-value in (comp-func-blocks func)
              do (setf (comp-block-insns bb)
                       (reverse (comp-block-insns bb))))
-    (when comp-debug
-      (comp-pretty-print-func func))
+    (comp-log-func func)
     func))
 
 
-- 
2.39.5