mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2025-12-06 02:40:26 -08:00
Code Issues Projects Releases Packages Wiki Activity

bytecmp: fix compilation of closures

Browse source 
Extract function name for bclosures in guess_environment and
    signal an error when attempting to compile a cclosure
This commit is contained in:
Marius Gerbershagen 2018-06-15 21:47:18 +02:00
parent 4e02997d79
commit c7a0b753c9
2 changed files with 13 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

16
contrib/bytecmp/bytecmp.lsp
View file

@ -45,9 +45,11 @@
(cond ((functionp definition)
(multiple-value-bind (form lexenv) (function-lambda-expression definition)
(when form
(if lexenv
(setf definition (si:eval-with-env form lexenv))
(setf definition (si:eval-with-env form nil nil nil t)))))
(cond ((eq lexenv t)
(warn "COMPILE can not compile C closures")
(return-from bc-compile (values definition t nil)))
(lexenv (setf definition (si:eval-with-env form lexenv)))
(t (setf definition (si:eval-with-env form nil nil nil t))))))
(when name (setf (fdefinition name) definition))
(return-from bc-compile (values (or name definition) nil nil)))
((not (null definition))
@ -66,9 +68,11 @@
(multiple-value-bind (form lexenv)
(function-lambda-expression (fdefinition name))
(when form
(if lexenv
(setf definition (si:eval-with-env form lexenv))
(setf definition (si:eval-with-env form nil nil nil t)))))
(cond ((eq lexenv t)
(warn "The bytecodes compiler can not compile C closures")
(return-from bc-compile (values definition t nil)))
(lexenv (setf definition (si:eval-with-env form lexenv)))
(t (setf definition (si:eval-with-env form nil nil nil t))))))
(when (null definition)
(warn "We have lost the original function definition for ~s." name)
(return-from bc-compile (values name t nil)))

4
src/c/compiler.d
View file

@ -501,7 +501,9 @@ guess_environment(cl_env_ptr env, cl_object interpreter_env)
{
cl_object record = ECL_CONS_CAR(interpreter_env);
if (!LISTP(record)) {
c_register_function(env, record);
if (ecl_t_of(record) == t_bclosure)
record = record->bclosure.code;
c_register_function(env, record->bytecodes.name);
} else {
cl_object record0 = ECL_CONS_CAR(record);
cl_object record1 = ECL_CONS_CDR(record);