From 9f4a5d4dd4f59d33c979007b0121ca7863847947 Mon Sep 17 00:00:00 2001
From: Marius Gerbershagen <marius.gerbershagen@gmail.com>
Date: Sat, 24 Nov 2018 19:20:06 +0100
Subject: [PATCH] disassemble: display generated C source code instead of
 bytecodes

    This behaviour makes more sense, since the ANSI standard mandates
    that disassemble should compile an interpreted function before
    displaying the output (our own documentation even says so).

    Also fixes disassemble for closures.
---
 src/cmp/cmpmain.lsp                          | 12 ++++++++++--
 src/doc/new-doc/developer-guide/compiler.txi | 19 +++++++++++++------
 2 files changed, 23 insertions(+), 8 deletions(-)

diff --git a/src/cmp/cmpmain.lsp b/src/cmp/cmpmain.lsp
index 07bbcab7b..0ca8a9af2 100755
--- a/src/cmp/cmpmain.lsp
+++ b/src/cmp/cmpmain.lsp
@@ -837,7 +837,7 @@ after compilation."
       (compiler-output-values output compiler-conditions))))
 
 (defun disassemble (thing &key (h-file nil) (data-file nil)
-                    &aux def disassembled-form
+                    &aux lexenv disassembled-form
                     (*compiler-in-use* *compiler-in-use*)
                     (*print-pretty* nil))
 "Compiles the form specified by THING and prints the intermediate C language
@@ -850,6 +850,12 @@ form.  H-FILE and DATA-FILE specify intermediate files to build a fasl file
 from the C language code.  NIL means \"do not create the file\"."
   (when (si::valid-function-name-p thing)
     (setq thing (fdefinition thing)))
+  (when (and (functionp thing) (function-lambda-expression thing))
+    (multiple-value-setq (thing lexenv)
+      (function-lambda-expression thing))
+    (when (eq lexenv t)
+      (warn "DISASSEMBLE can not disassemble C closures")
+      (return-from disassemble nil)))
   (cond ((null thing))
         ((functionp thing)
          (unless (si::bc-disassemble thing)
@@ -878,8 +884,10 @@ from the C language code.  NIL means \"do not create the file\"."
                                  (open h-file :direction :output :external-format :default)
                                  null-stream))
          (t3local-fun (symbol-function 'T3LOCAL-FUN))
-         (compiler-conditions nil))
+         (compiler-conditions nil)
+         (*cmp-env-root* *cmp-env-root*))
     (with-compiler-env (compiler-conditions)
+      (setf disassembled-form (set-closure-env disassembled-form lexenv *cmp-env-root*))
       (unwind-protect
            (progn
              (setf (symbol-function 'T3LOCAL-FUN)
diff --git a/src/doc/new-doc/developer-guide/compiler.txi b/src/doc/new-doc/developer-guide/compiler.txi
index 5ed31fa50..0a9942584 100644
--- a/src/doc/new-doc/developer-guide/compiler.txi
+++ b/src/doc/new-doc/developer-guide/compiler.txi
@@ -178,16 +178,23 @@ This is, however, @emph{useless} in our case, because we are not concerned with
 
 @verbatim
 > (defun add1 (x) (1+ x))
+
 ADD1
 > (disassemble *)
-;;; Compiling (DEFUN ADD1 ...).
-;;; Emitting code for ADD1.
 
 /*      function definition for ADD1                                  */
-static L1(int narg, object V1)
-{ VT3 VLEX3 CLSR3
+/*      optimize speed 3, debug 0, space 0, safety 2                  */
+static cl_object L1add1(cl_object v1x)
+{
+ cl_object env0 = ECL_NIL;
+ const cl_env_ptr cl_env_copy = ecl_process_env();
+ cl_object value0;
+ ecl_cs_check(cl_env_copy,value0);
+ {
 TTL:
-VALUES(0) = one_plus((V1));
-RETURN(1);
+  value0 = ecl_one_plus(v1x);
+  cl_env_copy->nvalues = 1;
+  return value0;
+ }
 }
 @end verbatim