Fix sb-vm::with-pseudo-atomic-foreign-calls

The intent is to say that here is logic which it not machine-specific and so
we're not going to put it inside of pseudo-atomic inside of a vop, but it needs
to act as if it was pseudo-atomic.
For sb-safepoint, even though as the comment said it "could" be controlled
by an optimize decl, it was not getting done. For nonstop-foreign-call not only
should we skip emitting instructions to save the stack pointer and possibly
take a stop-for-gc trap, we must insert the pseudo-atomic barrier instructions,
otherwise the foreign code would receive a stop-for-gc signal as if in lisp.

And the implementation really should get finished for the architecturs other
than x86-64, though it does not seem to be as critical and I'm not sure why.
The uses guarded by #+immobile-space are clearly unimportant unless immobile
space exists, but uses involving dlopen and dladdr seem important.

src/compiler/generic/utils.lisp

@@ -648,11 +648,6 @@
 
 (defun call-out-pseudo-atomic-p (vop)
   (declare (ignorable vop))
-  ;; If #+sb-safepoint, the decision to poll for a safepoint
-  ;; occurs at the end. In that case, we can not prevent stop-for-GC
-  ;; from occurring in the C code, because foreign code is allowed
-  ;; to run during GC; it just can't go back into Lisp until GC is over.
-  #-(or sb-safepoint nonstop-foreign-call)
   (loop for e = (sb-c::node-lexenv (sb-c::vop-node vop))
         then (sb-c::lexenv-parent e)
         while e

src/compiler/generic/vm-macs.lisp

@@ -42,9 +42,7 @@
   ;; In any case, we desire a way to say that certain foreign calls are
   ;; uninterruptible, but this technique has less overhead than WITHOUT-GCING
   ;; which is to be eschewed as no such thing exists in most collectors.
-  ;; If using safepoints, then this reduces to PROGN.
-  `(symbol-macrolet (#-(or sb-safepoint nonstop-foreign-call)
-                     (sb-vm::.pseudo-atomic-call-out. t))
+  `(symbol-macrolet ((sb-vm::.pseudo-atomic-call-out. t))
      ,@body))
 
 ;;;; other miscellaneous stuff

src/compiler/x86-64/c-call.lisp

@@ -724,7 +724,8 @@ Floats are passed in integer registers."
 
 ;;; Remember when changing this to check that these work:
 ;;; - disassembly, undefined alien, and conversion to ELF core
-(defun emit-c-call (vop rax fun args varargsp #+sb-safepoint pc-save #+win32 rbx)
+(defun emit-c-call (vop rax fun args varargsp #+sb-safepoint pc-save #+win32 rbx
+                    &aux (pseudo-atomic (call-out-pseudo-atomic-p vop)))
   (declare (ignorable varargsp))
   ;; Current PC - don't rely on function to keep it in a form that
   ;; GC understands
@@ -754,9 +755,10 @@ Floats are passed in integer registers."
   ;; Store SP in thread struct, unless the enclosing block says not to
 
   #+(or sb-safepoint nonstop-foreign-call)
-  (when (and #+sb-safepoint
-             (policy (sb-c::vop-node vop) (/= sb-c:insert-safepoints 0)))
-    (inst mov (thread-slot-ea thread-saved-csp-offset) rsp-tn))
+  (unless pseudo-atomic
+    (when (and #+sb-safepoint
+               (policy (sb-c::vop-node vop) (/= sb-c:insert-safepoints 0)))
+      (inst mov (thread-slot-ea thread-saved-csp-offset) rsp-tn)))
 
   #+win32 (inst sub rsp-tn #x20)       ;MS_ABI: shadow zone
 
@@ -766,7 +768,7 @@ Floats are passed in integer registers."
   ;; the UNDEFINED-ALIEN-TRAMP lisp asm routine to recognize the various shapes
   ;; this instruction sequence can take.
   #-win32
-  (pseudo-atomic (:elide-if (not (call-out-pseudo-atomic-p vop)))
+  (pseudo-atomic (:elide-if (not pseudo-atomic))
     (inst call
           #-immobile-space ; always call via RBX
           (cond ((stringp fun) (inst lea rbx-tn (ea (make-fixup fun :foreign) null-tn)) rbx-tn)
@@ -802,11 +804,12 @@ Floats are passed in integer registers."
   #+win32 (inst add rsp-tn #x20)       ;MS_ABI: remove shadow space
 
   ;; Zero the saved CSP, unless this code shouldn't ever stop for GC
-  #+sb-safepoint
-  (when (policy (sb-c::vop-node vop) (/= sb-c:insert-safepoints 0))
-    (inst xor (thread-slot-ea thread-saved-csp-offset) rsp-tn))
-  #+nonstop-foreign-call
-  (inst mov :qword (thread-slot-ea thread-saved-csp-offset) 0))
+  (unless pseudo-atomic
+    #+sb-safepoint
+    (when (policy (sb-c::vop-node vop) (/= sb-c:insert-safepoints 0))
+      (inst xor (thread-slot-ea thread-saved-csp-offset) rsp-tn))
+    #+nonstop-foreign-call
+    (inst mov :qword (thread-slot-ea thread-saved-csp-offset) 0)))
 
 (define-vop (alloc-number-stack-space)
   (:info amount)