0.8.14.13: Step SBCL, step!

[sbcl.git] / src / compiler / ir1tran-lambda.lisp

diff --git a/src/compiler/ir1tran-lambda.lisp b/src/compiler/ir1tran-lambda.lisp
index c107a93..632d189 100644 (file)
--- a/src/compiler/ir1tran-lambda.lisp
+++ b/src/compiler/ir1tran-lambda.lisp
@@ -255,25 +255,6 @@
                                      (rest svars))))))
   (values))
 
-;;; FIXME: this is the interface of the CMUCL WITH-DYNAMIC-EXTENT
-;;; macro.  It is slightly confusing, in that START and BODY-START are
-;;; already-existing CTRANs (and FIXME: probably deserve a ONCE-ONLY),
-;;; whereas NEXT is a variable naming a CTRAN in the body.  -- CSR,
-;;; 2004-03-30.
-(defmacro with-dynamic-extent ((start body-start next kind) &body body)
-  (declare (ignore kind))
-  (with-unique-names (cleanup next-ctran)
-    `(progn
-      (ctran-starts-block ,body-start)
-      (let ((,cleanup (make-cleanup :kind :dynamic-extent))
-           (,next-ctran (make-ctran))
-           (,next (make-ctran)))
-       (ir1-convert ,start ,next-ctran nil '(%dynamic-extent-start))
-       (setf (cleanup-mess-up ,cleanup) (ctran-use ,next-ctran))
-       (let ((*lexenv* (make-lexenv :cleanup ,cleanup)))
-         (ir1-convert ,next-ctran ,next nil '(%cleanup-point))
-         (locally ,@body))))))
-
 ;;; Create a lambda node out of some code, returning the result. The
 ;;; bindings are specified by the list of VAR structures VARS. We deal
 ;;; with adding the names to the LEXENV-VARS for the conversion. The
@@ -310,8 +291,7 @@
                   :%source-name source-name
                   :%debug-name debug-name))
         (result-ctran (make-ctran))
-         (result-lvar (make-lvar))
-        (dx-rest nil))
+         (result-lvar (make-lvar)))
 
     (awhen (lexenv-lambda *lexenv*)
       (push lambda (lambda-children it))
@@ -341,12 +321,7 @@
                (t
                  (when note-lexical-bindings
                    (note-lexical-binding (leaf-source-name var)))
-                (new-venv (cons (leaf-source-name var) var)))))
-       (let ((info (lambda-var-arg-info var)))
-         (when (and info
-                    (eq (arg-info-kind info) :rest)
-                    (leaf-dynamic-extent var))
-           (setq dx-rest t))))
+                (new-venv (cons (leaf-source-name var) var))))))
 
       (let ((*lexenv* (make-lexenv :vars (new-venv)
                                   :lambda lambda
@@ -371,14 +346,9 @@
             (ctran-starts-block prebind-ctran)
             (link-node-to-previous-ctran bind prebind-ctran)
             (use-ctran bind postbind-ctran)
-           (if dx-rest
-               (with-dynamic-extent (postbind-ctran result-ctran dx :rest)
-                 (ir1-convert-special-bindings dx result-ctran result-lvar
-                                               body aux-vars aux-vals
-                                               (svars)))
-               (ir1-convert-special-bindings postbind-ctran result-ctran
-                                             result-lvar body
-                                             aux-vars aux-vals (svars)))))))
+           (ir1-convert-special-bindings postbind-ctran result-ctran
+                                          result-lvar body
+                                          aux-vars aux-vals (svars))))))
 
     (link-blocks (component-head *current-component*) (node-block bind))
     (push lambda (component-new-functionals *current-component*))
@@ -545,7 +515,7 @@
 
       (when rest
        (arg-vals `(%listify-rest-args
-                   ,n-context ,n-count ,(leaf-dynamic-extent rest))))
+                   ,n-context ,n-count)))
       (when morep
        (arg-vals n-context)
        (arg-vals n-count))
@@ -895,7 +865,8 @@
                     (process-decls decls (append aux-vars vars) nil))
                    (forms (if (and *allow-debug-catch-tag*
                                    (policy *lexenv* (>= insert-debug-catch 2)))
-                              `((catch (make-symbol "SB-DEBUG-CATCH-TAG")
+                              `((catch (locally (declare (optimize (insert-step-conditions 0)))
+                                         (make-symbol "SB-DEBUG-CATCH-TAG"))
                                   ,@forms))
                               forms))
                    (forms (if (eq result-type *wild-type*)