Support building without PSEUDO-ATOMIC on POSIX safepoints

[sbcl.git] / contrib / sb-cltl2 / compiler-let.lisp

diff --git a/contrib/sb-cltl2/compiler-let.lisp b/contrib/sb-cltl2/compiler-let.lisp
index 60600b5..e7458dd 100644 (file)
--- a/contrib/sb-cltl2/compiler-let.lisp
+++ b/contrib/sb-cltl2/compiler-let.lisp
@@ -1,6 +1,6 @@
 (in-package :sb-cltl2)
 
 (in-package :sb-cltl2)
 

-(def-ir1-translator compiler-let ((bindings &rest forms) start cont)
+(def-ir1-translator compiler-let ((bindings &rest forms) start next result)

   (loop for binding in bindings
      if (atom binding)
         collect binding into vars
   (loop for binding in bindings
      if (atom binding)
         collect binding into vars

@@ -9,7 +9,7 @@
         and collect (first binding) into vars
         and collect (eval (second binding)) into values
      finally (return (progv vars values
         and collect (first binding) into vars
         and collect (eval (second binding)) into values
      finally (return (progv vars values

-                       (sb-c::ir1-convert-progn-body start cont forms)))))
+                       (sb-c::ir1-convert-progn-body start next result forms)))))

 
 (defun walk-compiler-let (form context env)
   (declare (ignore context))
 
 (defun walk-compiler-let (form context env)
   (declare (ignore context))

@@ -29,3 +29,21 @@
                                          'compiler-let bindings walked-body)))))))
 
 (sb-walker::define-walker-template compiler-let walk-compiler-let)
                                          'compiler-let bindings walked-body)))))))
 
 (sb-walker::define-walker-template compiler-let walk-compiler-let)

+
+#+sb-eval
+(setf (getf sb-eval::*eval-dispatch-functions* 'compiler-let)
+      (lambda (form env)
+        (destructuring-bind (bindings &body body) (cdr form)
+          (loop for binding in bindings
+                if (atom binding)
+                collect binding into vars
+                and collect nil into values
+                else do (assert (proper-list-of-length-p binding 1 2))
+                and collect (first binding) into vars
+                and collect (eval (second binding)) into values
+                finally (return
+                          (let ((new-env (sb-eval::make-env
+                                          :parent env
+                                          :vars (sb-eval::special-bindings vars env))))
+                            (progv vars values
+                              (sb-eval::eval-progn body new-env))))))))