X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1tran-lambda.lisp;h=c2ae9ae26719631ac65dafbd0d76aa8c1dbbdc71;hb=a4882e3023fdd5e777169a4cbede33605281173c;hp=decdfce41db71552dfd755693c3cecf301fbcc3f;hpb=3a2e34d8ed1293f2cecb5c2c6ea359b622e3f4f8;p=sbcl.git

diff --git a/src/compiler/ir1tran-lambda.lisp b/src/compiler/ir1tran-lambda.lisp
index decdfce..c2ae9ae 100644
--- a/src/compiler/ir1tran-lambda.lisp
+++ b/src/compiler/ir1tran-lambda.lisp
@@ -463,22 +463,27 @@
     ;; problems: hidden references should not be established to
     ;; lambdas of kind NIL should not have (otherwise the compiler
     ;; might let-convert or delete them) and to variables.
-    (let ((name (or debug-name source-name))
-          (defaults (if supplied-p (list default nil) (list default))))
+    (let ((name (or debug-name source-name)))
       (if (or force
               supplied-p-p ; this entry will be of kind NIL
               (and (lambda-p ep) (eq (lambda-kind ep) nil)))
           (convert-optional-entry ep
                                   default-vars default-vals
-                                  defaults
+                                  (if supplied-p (list default nil) (list default))
                                   name)
-          (delay
-           (register-entry-point
-            (convert-optional-entry (force ep)
-                                    default-vars default-vals
-                                    defaults
-                                    name)
-            res))))))
+          (let* ((default `',(constant-form-value default))
+                 (defaults (if supplied-p (list default nil) (list default))))
+            ;; DEFAULT can contain a reference to a
+            ;; to-be-optimized-away function/block/tag, so better to
+            ;; reduce code now (but we possibly lose syntax checking
+            ;; in an unreachable code).
+            (delay
+             (register-entry-point
+              (convert-optional-entry (force ep)
+                                      default-vars default-vals
+                                      defaults
+                                      name)
+              res)))))))
 
 ;;; Create the MORE-ENTRY function for the OPTIONAL-DISPATCH RES.
 ;;; ENTRY-VARS and ENTRY-VALS describe the fixed arguments. REST is
@@ -887,7 +892,9 @@
                                  (policy *lexenv* (>= insert-debug-catch 2)))
                             `((catch (locally
                                          (declare (optimize (insert-step-conditions 0)))
-                                    (make-symbol "SB-DEBUG-CATCH-TAG"))
+                                       ;; Using MAKE-SYMBOL would lead
+                                       ;; to recursive disaster.
+                                       (%make-symbol "SB-DEBUG-CATCH-TAG"))
                                 ,@forms))
                             forms))
                  (forms (if (eq result-type *wild-type*)