From 0eaabe63828350c0a70184852500e8f481d7e911 Mon Sep 17 00:00:00 2001
From: Douglas Katzman <dougk@google.com>
Date: Thu, 1 Oct 2015 23:16:14 -0400
Subject: [PATCH] Fix bug in LOAD-TIME-EVAL when compiling into memory.

---
 NEWS                     |  5 +++++
 src/compiler/ltv.lisp    | 18 +++++++++++++-----
 tests/compiler.pure.lisp | 20 ++++++++++++++++++++
 3 files changed, 38 insertions(+), 5 deletions(-)

diff --git a/NEWS b/NEWS
index 1a40714ae..430ccd9cf 100644
--- a/NEWS
+++ b/NEWS
@@ -1,4 +1,9 @@
 ;;;; -*- coding: utf-8; fill-column: 78 -*-
+changes relative to sbcl-1.2.16:
+  * bug fix: calling COMPILE when SB-EXT:*EVALUATOR-MODE* was :INTERPRET
+    would fail to perform "normal semantic processing such as macro expansion"
+    as stipulated by X3J13 issue LOAD-TIME-EVAL.
+
 changes in sbcl-1.2.16 relative to sbcl-1.2.15:
   * enhancement: by default, timers with a repeat interval do not "catch up"
     by repeatedly calling their function after a clock discontinuity such as a
diff --git a/src/compiler/ltv.lisp b/src/compiler/ltv.lisp
index b5ecb1e4a..1511456d8 100644
--- a/src/compiler/ltv.lisp
+++ b/src/compiler/ltv.lisp
@@ -71,11 +71,19 @@ guaranteed to never be modified, so it can be put in read-only storage."
                       `(value-cell-ref (%load-time-value ',handle)))))
             (the-in-policy type value-form **zero-typecheck-policy**
                            start next result)))
-        (let* ((value
-                 (handler-case (eval form)
-                   (error (condition)
-                     (compiler-error "(during EVAL of LOAD-TIME-VALUE)~%~A"
-                                     condition)))))
+        (let ((value
+               (flet ((eval-it (operator thing)
+                        (handler-case (funcall operator thing)
+                          (error (condition)
+                            (compiler-error "(during EVAL of LOAD-TIME-VALUE)~%~A"
+                                            condition)))))
+                 (if (eq sb!ext:*evaluator-mode* :compile)
+                     ;; This call to EVAL actually means compile+eval.
+                     (eval-it 'eval form)
+                     (let ((f (compile nil `(lambda () ,form))))
+                       (if f
+                           (eval-it 'funcall f)
+                           (compiler-error "Failed to compile LOAD-TIME-VALUE form")))))))
           (if read-only-p
               (ir1-convert start next result `',value)
               (the-in-policy (ctype-of value) `(value-cell-ref ,(make-value-cell value))
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 5df31b095..71ee899b6 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -5596,3 +5596,23 @@
     (test '(flet x))
     (test '(labels (foo () 'bar)))
     (test '(labels x))))
+
+(with-test (:name :compile-load-time-value-interpreted-mode)
+  ;; This test exercises the same pattern as HANDLER-BIND (to a degree).
+  ;; In particular a HANDLER-BIND that was compiled when the *EVALUATOR-MODE*
+  ;; was :INTERPRET would not compile its class predicates, because
+  ;; LOAD-TIME-VALUE just called EVAL, and you would get back a list
+  ;; with an interpreted function it it.
+  ;; In the code below, this function when called would generate a new symbol
+  ;; each time. But if the compiler processes the guts as it should,
+  ;; you get back a compiled lambda which returns a constant symbol.
+  (let ((f (let ((sb-ext:*evaluator-mode* :interpret))
+             (compile nil
+                      '(lambda ()
+                        (load-time-value
+                         (list (lambda ()
+                                 (macrolet ((foo ()
+                                              (sb-int:keywordicate (gensym))))
+                                   (foo))))))))))
+    (eq (funcall (car (funcall f)))
+        (funcall (car (funcall f))))))
-- 
2.11.4.GIT