mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-22 04:21:16 -08:00
Code Issues Projects Releases Packages Wiki Activity

Merge branch 'fix-disassemble' into 'develop'

Browse source 
Fix #106

Closes #106

See merge request embeddable-common-lisp/ecl!127
This commit is contained in:
Daniel Kochmański 2018-11-25 08:10:11 +00:00
commit 6bb08c2d81
2 changed files with 23 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

12
src/cmp/cmpmain.lsp
View file

@ -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)

19
src/doc/new-doc/developer-guide/compiler.txi
View file

@ -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