clos: don't call make-load-form in the code walker for defmethod

Fixes #594.

contrib/bytecmp/bytecmp.lsp

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

src/c/compiler.d

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

src/clos/method.lsp

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

src/cmp/cmputil.lsp

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