Commit 6bb08c2d authored by Daniel Kochmański's avatar Daniel Kochmański

Merge branch 'fix-disassemble' into 'develop'

Fix #106

Closes #106

See merge request embeddable-common-lisp/ecl!127
parents e7fe0004 9f4a5d4d
......@@ -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)
......
......@@ -210,16 +210,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
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment