Commit 246f0a6d authored by Daniel Kochmański's avatar Daniel Kochmański
Browse files

Merge branch 'fix-594' into 'develop'

Fix #594

Closes #594

See merge request embeddable-common-lisp/ecl!227
parents ec8d6369 0f751776
......@@ -49,14 +49,14 @@
(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))))))
(t (setf definition (si:eval-with-env form nil nil nil :execute))))))
(when name (setf (fdefinition name) definition))
(return-from bc-compile (values (or name definition) nil nil)))
((not (null definition))
(unless (member (car definition) '(LAMBDA EXT:LAMBDA-BLOCK))
(format t "~&;;; Error: Not a valid lambda expression: ~s." definition)
(return-from bc-compile (values nil t t)))
(setq definition (si:eval-with-env definition nil nil nil t))
(setq definition (si:eval-with-env definition nil nil nil :execute))
(when name (setf (fdefinition name) definition))
(return-from bc-compile (values (or name definition) nil nil)))
((not (fboundp name))
......@@ -72,7 +72,7 @@
(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))))))
(t (setf definition (si:eval-with-env form nil nil nil :execute))))))
(when (null definition)
(warn "We have lost the original function definition for ~s." name)
(return-from bc-compile (values name t nil)))
......@@ -122,7 +122,7 @@
until (eq form :EOF)
do (when ext::*source-location*
(rplacd ext:*source-location* position))
collect (si:eval-with-env form nil nil nil nil))))
collect (si:eval-with-env form nil nil nil :load-toplevel))))
(sys:with-ecl-io-syntax
(write binary :stream sout :circle t :escape t :readably t :pretty nil))
(terpri sout)))))
......
......@@ -1630,7 +1630,7 @@ c_load_time_value(cl_env_ptr env, cl_object args, int flags)
unlikely_if (Null(args) || cl_cddr(args) != ECL_NIL)
FEprogram_error("LOAD-TIME-VALUE: Wrong number of arguments.", 0);
value = ECL_CONS_CAR(args);
if (c_env->mode != FLAG_LOAD) {
if (c_env->mode == FLAG_EXECUTE) {
value = si_eval_with_env(1, value);
} else if (ECL_SYMBOLP(value) || ECL_LISTP(value)) {
/* Using the form as constant, we force the system to coalesce multiple
......@@ -3200,14 +3200,24 @@ si_make_lambda(cl_object name, cl_object rest)
}
@(defun si::eval-with-env (form &optional (env ECL_NIL) (stepping ECL_NIL)
(compiler_env_p ECL_NIL) (execute ECL_T))
(compiler_env_p ECL_NIL) (mode @':execute'))
volatile cl_compiler_env_ptr old_c_env;
struct cl_compiler_env new_c_env;
cl_object interpreter_env, compiler_env;
@
/*
* Compile to bytecodes.
* Parameter mode is interpreted as follows:
* - execute: Execute the compiled form
* - load-toplevel: Compile the form without executing. Calls
* make-load-form for literal objects encountered during
* compilation.
* - compile-toplevel: Compile the form without executing, do not
* call make-load-form. Useful for code walking.
*/
if (!(mode == @':execute' || mode == @':load-toplevel' || mode == @':compile-toplevel')) {
FEerror("Invalid mode in SI:EVAL-WITH-ENV", 0);
}
if (compiler_env_p == ECL_NIL) {
interpreter_env = env;
compiler_env = ECL_NIL;
......@@ -3225,15 +3235,15 @@ si_make_lambda(cl_object name, cl_object rest)
}
new_c_env.stepping = stepping != ECL_NIL;
ECL_UNWIND_PROTECT_BEGIN(the_env) {
if (Null(execute)) {
if (mode == @':execute') {
eval_form(the_env, form);
} else {
cl_index handle = asm_begin(the_env);
new_c_env.mode = FLAG_LOAD;
new_c_env.mode = (mode == @':load-toplevel') ? FLAG_LOAD : FLAG_COMPILE;
compile_with_load_time_forms(the_env, form, FLAG_VALUES);
asm_op(the_env, OP_EXIT);
the_env->values[0] = asm_end(the_env, handle, form);
the_env->nvalues = 1;
} else {
eval_form(the_env, form);
}
} ECL_UNWIND_PROTECT_EXIT {
/* Clear up */
......
......@@ -252,9 +252,9 @@
(let ((si::*code-walker* #'code-walker))
;; Instead of (coerce method-lambda 'function) we use
;; explicitely the bytecodes compiler with an environment, no
;; stepping, compiler-env-p = t and execute = nil, so that the
;; form does not get executed.
(si::eval-with-env method-lambda env nil t nil)))
;; stepping, compiler-env-p = t and mode = :compile-toplevel,
;; so that the form does not get executed.
(si::eval-with-env method-lambda env nil t :compile-toplevel)))
(values call-next-method-p
next-method-p-p
in-closure-p)))
......
......@@ -357,7 +357,7 @@
(when throw-flag ,error-form))))
(defun cmp-eval (form &optional (env *cmp-env*))
(handler-case (si::eval-with-env form env nil t t)
(handler-case (si::eval-with-env form env nil t :execute)
(serious-condition (c)
(when *compiler-break-enable*
(invoke-debugger c))
......
......@@ -1921,3 +1921,20 @@
(multiple-value-setq (*a* *b*) (foo))
(and (eq *a* :right-a)
(eq *b* :right-b))))))))
;;; Date 2020-08-14
;;; URL: https://gitlab.com/embeddable-common-lisp/ecl/-/issues/594
;;; Description
;;;
;;; The code walker used in DEFMETHOD would call MAKE-LOAD-VALUE
;;; for literal objects encountered during code walking, even while
;;; loading a file or using eval.
(ext:with-clean-symbols (test-class test-method)
(eval '(defclass test-class () ()))
(eval '(defmethod make-load-form ((obj test-class) &optional env)
(error "We shouldn't have called MAKE-LOAD-FORM here.")))
(test cmp.0082.defmethod-make-load-form
(let* ((test-obj (make-instance 'test-class))
(code `(defmethod test-method ()
,test-obj)))
(finishes (eval code)))))
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