X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir2tran.lisp;h=af5c7e4f66bd37d1d75f92543f2e9387d013f529;hb=c712f88b26cd7547ee984b90e18c134401335bc3;hp=0ae854b60948725601dd418252e168e3972dcad5;hpb=372d68ae1432a96a527c662de3af3bb334808856;p=sbcl.git

diff --git a/src/compiler/ir2tran.lisp b/src/compiler/ir2tran.lisp
index 0ae854b..af5c7e4 100644
--- a/src/compiler/ir2tran.lisp
+++ b/src/compiler/ir2tran.lisp
@@ -1272,7 +1272,10 @@
 
     (let ((lab (gen-label)))
       (setf (ir2-physenv-environment-start env) lab)
-      (vop note-environment-start node block lab)))
+      (vop note-environment-start node block lab)
+      #!+sb-safepoint
+      (unless (policy fun (>= inhibit-safepoints 2))
+        (vop sb!vm::insert-safepoint node block))))
 
   (values))
 
@@ -1805,6 +1808,22 @@
                        2block
                        #!+sb-dyncount *dynamic-counts-tn* #!-sb-dyncount nil
                        num))))
+              #!+sb-safepoint
+              (let ((first-node (block-start-node block)))
+                (unless (or (and (bind-p first-node)
+                                 (xep-p (bind-lambda first-node)))
+                            (and (valued-node-p first-node)
+                                 (node-lvar first-node)
+                                 (eq (lvar-fun-name
+                                      (node-lvar first-node))
+                                     '%nlx-entry)))
+                  (when (and (rest (block-pred block))
+                             (block-loop block)
+                             (member (loop-kind (block-loop block))
+                                     '(:natural :strange))
+                             (eq block (loop-head (block-loop block)))
+                             (policy first-node (< inhibit-safepoints 2)))
+                    (vop sb!vm::insert-safepoint first-node 2block))))
             (ir2-convert-block block)
             (incf num))))))
   (values))