[PATCH] some easter eggs for netbsd and sparc

From 5f8e1e7e8ba9d2cfe0fba030dd2c88fbf47122ec Mon Sep 17 00:00:00 2001
From: Andreas Franke <[email protected]>
Date: Mon, 30 Mar 2026 16:52:55 +0000
Subject: [PATCH 1/8] netbsd: unblock delivered signal in signal handlers

OS_SA_NODEFER is 0 on NetBSD because its SA_NODEFER has broken
semantics.  The delivered signal stays blocked during the handler,
which causes two failures:

- Signal nesting on SPARC: the pseudo-atomic trap handler (SIGILL)
  calls into Lisp via maybe_gc; GC closes TLABs, and the first
  post-GC allocation (*gc-epoch* cons) triggers a nested SIGILL
  that must not be blocked.  (Caused warm load crash.)

- NLX from interrupt_handle_now_handler bypasses sigreturn, leaving
  the signal permanently blocked (lost SIGFPE after handler-case)

Add UNBLOCK_SELF() in both low_level_handle_now_handler and
interrupt_handle_now_handler, paralleling the existing UNBLOCK_SIGSEGV
pattern.  No-op on non-NetBSD.
---
 src/runtime/interrupt.c | 29 +++++++++++++++++++++++++++++
 1 file changed, 29 insertions(+)

diff --git a/src/runtime/interrupt.c b/src/runtime/interrupt.c
index 766355045..7ab63a313 100644
--- a/src/runtime/interrupt.c
+++ b/src/runtime/interrupt.c
@@ -248,6 +248,28 @@ resignal_to_lisp_thread(int signal, os_context_t *context)
 #  define UNBLOCK_SIGSEGV() {}
 #endif
 
+/* On NetBSD, OS_SA_NODEFER is 0 because NetBSD's SA_NODEFER has broken
+ * semantics (it unblocks sa_mask signals instead of just not adding the
+ * delivered signal).  As a result, synchronous signals are blocked during
+ * their own handlers.  This causes two problems:
+ *
+ * 1. Signal nesting: on SPARC, the pseudo-atomic trap handler (SIGILL)
+ *    calls into Lisp via maybe_gc/deferred handlers; if that Lisp code
+ *    allocates, the nested allocation-trap SIGILL must not be blocked.
+ *
+ * 2. NLX from handlers: handler-case bypasses sigreturn, leaving the
+ *    delivered signal permanently blocked.  (Affects SIGFPE, etc.)
+ *
+ * Unblock the delivered signal early so nested delivery and NLX work. */
+#ifdef LISP_FEATURE_NETBSD
+#  define UNBLOCK_SELF(sig) \
+  { sigset_t mask; sigemptyset(&mask); \
+    sigaddset(&mask, sig); \
+    thread_sigmask(SIG_UNBLOCK, &mask, 0); }
+#else
+#  define UNBLOCK_SELF(sig) {}
+#endif
+
 /* These are to be used in signal handlers. Currently all handlers are
  * called from one of:
  *
@@ -1298,6 +1320,12 @@ void
 interrupt_handle_now_handler(int signal, siginfo_t *info, void *void_context)
 {
     SAVE_ERRNO(signal,context,void_context);
+    /* On NetBSD, OS_SA_NODEFER is 0, so the delivered signal is blocked
+     * during handler execution.  If the Lisp handler does NLX (e.g.
+     * handler-case), sigreturn is bypassed and the signal stays blocked
+     * permanently.  Unblock it here so NLX doesn't break future delivery.
+     * This mirrors UNBLOCK_SELF in low_level_handle_now_handler. */
+    UNBLOCK_SELF(signal);
 #ifndef LISP_FEATURE_WIN32
     if ((signal == SIGILL) || (signal == SIGBUS)
 #if !(defined LISP_FEATURE_LINUX || defined LISP_FEATURE_ANDROID || defined LISP_FEATURE_HAIKU)
@@ -1746,6 +1774,7 @@ low_level_handle_now_handler(int signal, siginfo_t *info, void *void_context)
     int saved_errno = errno;
     RECORD_SIGNAL(signal,void_context);
     UNBLOCK_SIGSEGV();
+    UNBLOCK_SELF(signal);
     RESTORE_FP_CONTROL_WORD(context,void_context);
     if (lisp_thread_p(void_context)) {
         interrupt_low_level_handlers[signal](signal, info, context);
-- 
2.43.0

From 734e3e5fdd9718b3cfda41af17a7ede6a77c7509 Mon Sep 17 00:00:00 2001
From: Andreas Franke <[email protected]>
Date: Sat, 4 Apr 2026 18:23:26 +0000
Subject: [PATCH 2/8] tests: add signal-unblocking tests for NetBSD

Three tests for NetBSD where OS_SA_NODEFER is 0:

:auto-gc-sigill-nesting -- forces auto-GC via lowered threshold.
Each GC cycle goes through pseudo-atomic trap (SIGILL) ->
interrupt_handle_pending -> maybe_gc -> sub-gc.  GC closes TLABs,
so the *gc-epoch* cons triggers a nested SIGILL that requires
UNBLOCK_SELF in low_level_handle_now_handler.  Without the fix,
exits 132 (SIGILL).

:signal-not-blocked-after-handler-nlx -- 100 iterations of NLX from
a SIGFPE handler.  Without UNBLOCK_SELF in interrupt_handle_now_handler,
the signal stays permanently blocked after the first NLX and subsequent
iterations are killed (exit 136).

:allocation-under-signal-pressure -- stress-test combining both
mechanisms: NLX from SIGFPE interleaved with heavy allocation that
triggers GC and SIGILL nesting.
---
 tests/signals.impure.lisp | 56 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 56 insertions(+)

diff --git a/tests/signals.impure.lisp b/tests/signals.impure.lisp
index 8897c73fd..3814f91c5 100644
--- a/tests/signals.impure.lisp
+++ b/tests/signals.impure.lisp
@@ -123,3 +123,59 @@
           (assert (and (null nbytes)
                        (= errno sb-unix:epipe))))))
     (sb-unix:unix-close write-side)))
+
+;;; Test SIGILL nesting during auto-GC on SPARC.
+;;;
+;;; On SPARC, both allocation traps and pseudo-atomic traps use SIGILL.
+;;; Auto-GC fires from the pseudo-atomic trap handler: TNE -> SIGILL ->
+;;; interrupt_handle_pending -> maybe_gc -> funcall1(SUB_GC).  GC closes
+;;; all TLABs; the first post-GC allocation (*gc-epoch* cons in sub-gc)
+;;; triggers a nested SIGILL.  On NetBSD without UNBLOCK_SELF in
+;;; low_level_handle_now_handler, this nested SIGILL is blocked and the
+;;; process is killed (exit 132).
+;;;
+;;; This was the original SPARC build failure (warm load crash).
+;;; Lowering the GC threshold ensures several auto-GC cycles fire.
+(with-test (:name :auto-gc-sigill-nesting)
+  (let ((old-threshold (sb-ext:bytes-consed-between-gcs))
+        (junk nil))
+    (unwind-protect
+        (progn
+          (setf (sb-ext:bytes-consed-between-gcs) (* 4 1024 1024))
+          (dotimes (i 2000000)
+            (push (make-array 10) junk)
+            (when (zerop (mod i 200000))
+              (setf junk nil))))
+      (setf (sb-ext:bytes-consed-between-gcs) old-threshold)))
+  (assert t))
+
+;;; On NetBSD, OS_SA_NODEFER is 0 because SA_NODEFER has broken
+;;; semantics (it unblocks sa_mask signals instead of just not adding
+;;; the delivered signal).  Non-deferrable signals like SIGFPE are
+;;; therefore auto-blocked during their own handler.
+;;;
+;;; When the Lisp handler does NLX (handler-case), sigreturn is
+;;; bypassed, so the signal stays permanently blocked.  The next
+;;; occurrence of that signal is delivered with SIG_DFL (= kill).
+;;; UNBLOCK_SELF in interrupt_handle_now_handler fixes this.
+#-no-float-traps
+(with-test (:name :signal-not-blocked-after-handler-nlx)
+  (dotimes (i 100)
+    (handler-case (coerce (expt 10 1000) 'single-float)
+      (floating-point-overflow () nil)))
+  (assert t))
+
+;;; Stress-test combining heap pressure with NLX from signal handlers.
+;;; Exercises both UNBLOCK_SELF mechanisms together: NLX from SIGFPE
+;;; (interrupt_handle_now_handler) interleaved with heavy allocation
+;;; that triggers GC and SIGILL nesting (low_level_handle_now_handler).
+#-no-float-traps
+(with-test (:name :allocation-under-signal-pressure)
+  (let ((junk nil))
+    (dotimes (i 100000)
+      (push (make-array 50) junk))
+    (dotimes (i 50)
+      (handler-case (coerce (expt 10 1000) 'single-float)
+        (floating-point-overflow () nil))
+      (push (make-array 1000) junk)))
+  (assert t))
-- 
2.43.0

From 5dc9b1f21f95151ee5ea9b5dfebc5ad261556d7e Mon Sep 17 00:00:00 2001
From: Andreas Franke <[email protected]>
Date: Mon, 6 Apr 2026 13:52:55 +0000
Subject: [PATCH 3/8] sparc: update NPC when setting PC in signal context

On SPARC, the processor uses both PC (program counter) and NPC (next
program counter) due to delayed branch slots.  set_os_context_pc only
updated PC, leaving NPC stale.  This caused the restart-type-error
mechanism (used by #S reader circularity resolution) to crash: after
incf-context-pc adjusted PC past the trap instruction, NPC still
pointed at the error descriptor bytes following the UNIMP trap.  On
sigreturn, execution of one instruction at the corrected PC was
followed by a jump to stale NPC -- landing in the error descriptor,
not valid instructions.

Every other PC-modifying site in the SPARC runtime already updates NPC
(arch_skip_instruction, arch_handle_fun_end_breakpoint).  Fix
set_os_context_pc to do the same, gated by ARCH_HAS_NPC_REGISTER
(only defined for SPARC).  Remove the now-redundant explicit NPC
update in arrange_return_to_c_function.

Remove :fails-on :sparc from four reader tests that now pass.
---
 src/runtime/interrupt.c  |  3 ---
 src/runtime/os-common.c  |  3 +++
 tests/reader.impure.lisp | 12 ++++--------
 3 files changed, 7 insertions(+), 11 deletions(-)

diff --git a/src/runtime/interrupt.c b/src/runtime/interrupt.c
index 7ab63a313..022b29a5c 100644
--- a/src/runtime/interrupt.c
+++ b/src/runtime/interrupt.c
@@ -1534,9 +1534,6 @@ arrange_return_to_c_function(os_context_t *context,
     *os_context_register_addr(context,reg_CFP) =
         (os_context_register_t)(uintptr_t)access_control_frame_pointer(th);
 #endif
-#ifdef ARCH_HAS_NPC_REGISTER
-    *os_context_npc_addr(context) = 4 + os_context_pc(context);
-#endif
 #if defined(LISP_FEATURE_SPARC)
      *os_context_register_addr(context,reg_CODE) =
          (os_context_register_t)((char*)fun + FUN_POINTER_LOWTAG);
diff --git a/src/runtime/os-common.c b/src/runtime/os-common.c
index 0204189a9..d745ef981 100644
--- a/src/runtime/os-common.c
+++ b/src/runtime/os-common.c
@@ -392,6 +392,9 @@ uword_t os_context_pc(os_context_t* context) {
 }
 void set_os_context_pc(os_context_t* context, uword_t pc) {
     OS_CONTEXT_PC(context) = pc;
+#ifdef ARCH_HAS_NPC_REGISTER
+    *os_context_npc_addr(context) = pc + 4;
+#endif
 }
 os_context_register_t* os_context_pc_addr(os_context_t* context) {
     return (os_context_register_t*)&(OS_CONTEXT_PC(context));
diff --git a/tests/reader.impure.lisp b/tests/reader.impure.lisp
index 8ad3a57cb..e47271d41 100644
--- a/tests/reader.impure.lisp
+++ b/tests/reader.impure.lisp
@@ -379,8 +379,7 @@
   (assert-error (read-from-string "#S(NODE :NEXT #(#S(NODE :NEXT NIL)))"))
   (assert-error (read-from-string "#S(NODE :NEXT #S(NODE :NEXT 1))")))
 
-(with-test (:name (:sharp=-typed-slot :circular :no-error)
-            :fails-on :sparc)
+(with-test (:name (:sharp=-typed-slot :circular :no-error))
   (let ((circ (read-from-string "#1=#S(NODE :NEXT #1#)")))
     (assert (eql (node-next circ) circ))))
 (with-test (:name (:sharp=-typed-slot :circular error))
@@ -399,8 +398,7 @@
   (assert-error (read-from-string "#S(NODE :LISTNEXT #(#S(NODE :LISTNEXT NIL)))"))
   (assert-error (read-from-string "#S(NODE :LISTNEXT (#S(NODE :LISTNEXT 1)))")))
 
-(with-test (:name (:sharp=-cons-typed-slot :circular :no-error)
-            :fails-on :sparc)
+(with-test (:name (:sharp=-cons-typed-slot :circular :no-error))
   (let ((circ (read-from-string "#1=#S(NODE :LISTNEXT (#1#))")))
     (assert (eql (car (node-listnext circ)) circ))))
 (with-test (:name (:sharp=-cons-typed-slot :circular error))
@@ -414,8 +412,7 @@
   (assert-error (read-from-string "#S(NODE :CONSCONS 1)"))
   (assert-error (read-from-string "#S(NODE :CONSCONS (1))")))
 
-(with-test (:name (:sharp=-cons-typed-cons-slot :circular :no-error)
-            :fails-on :sparc)
+(with-test (:name (:sharp=-cons-typed-cons-slot :circular :no-error))
   (let* ((circ (car (read-from-string "#1=(#S(NODE :CONSCONS #1#) . #1#)")))
          (conscons (node-conscons circ)))
     (assert (eql (car conscons) circ))
@@ -449,8 +446,7 @@
     (dotimes (i 5)
       (assert (eql (aref displacement i) array)))))
 
-(with-test (:name (:sharp= :circular-mismatch)
-            :fails-on :sparc)
+(with-test (:name (:sharp= :circular-mismatch))
   (assert-error
       (read-from-string "#S(NODE :NEXT (#1=#S(NODE :NEXT #1#)))")
       type-error))
-- 
2.43.0

From f85982d303f836b851eaf64d03a8bcbea4d86d49 Mon Sep 17 00:00:00 2001
From: Andreas Franke <[email protected]>
Date: Mon, 6 Apr 2026 13:53:52 +0000
Subject: [PATCH 4/8] sparc: route arrange_return through call_into_lisp

On SPARC, arrange_return_to_lisp_function cannot jump directly to
Lisp code like other RISC ports because: (1) register windows need
flushing via ta ST_FLUSH_WINDOWS, (2) globals %g1-%g5 are C scratch
registers (not callee-saved like ARM64/PPC), and (3) the pseudo-atomic
transition must happen properly.

Route through call_into_lisp which handles all of this: save (new
register window), flush windows, restore NIL/THREAD, clear ffca,
load BSP/CSP/OCFP from C globals, pseudo-atomic transition.

Also save BSP from the signal context to the C global before
call_into_lisp loads it. Without this, call_into_lisp loads a stale
BSP from the last C transition, and unbind-to-here underflows past
binding_stack_start during NLX unwind.

Skip build_fake_control_stack_frames when faulting in C code (ffca=1)
because %g3-%g5 contain arbitrary C values that would corrupt the
C globals.

Fixes all four EXHAUST tests (BASIC, NON-LOCAL-CONTROL, RESTARTS,
BINDING-STACK) on SPARC.
---
 src/runtime/interrupt.c | 50 ++++++++++++++++++++++++++++++++++++-----
 1 file changed, 45 insertions(+), 5 deletions(-)

diff --git a/src/runtime/interrupt.c b/src/runtime/interrupt.c
index 022b29a5c..5b95a0af0 100644
--- a/src/runtime/interrupt.c
+++ b/src/runtime/interrupt.c
@@ -1495,8 +1495,25 @@ arrange_return_to_c_function(os_context_t *context,
     *os_context_register_addr(context,reg_RDX) = 0;        /* no. args */
 #else
     struct thread *th = get_sb_vm_thread();
+#if defined(LISP_FEATURE_SPARC)
+    /* On SPARC, %g3-%g5 (CSP, CFP, BSP) are C scratch registers.
+     * When faulting in C code (foreign_function_call_active), the
+     * signal context contains arbitrary C values that would corrupt
+     * the C globals. Skip -- globals are already correct from the
+     * Lisp-to-C transition that set ffca. */
+    if (!foreign_function_call_active_p(th)) {
+        build_fake_control_stack_frames(th,context);
+        /* call_into_lisp loads BSP from the C global. Save the actual
+         * BSP from the signal context so unbind-to-here targets are
+         * reachable during NLX unwind. Without this, BSP is stale from
+         * the last C transition and unbind-to-here underflows. */
+        set_binding_stack_pointer(th,
+            *os_context_register_addr(context, reg_BSP));
+    }
+#else
     build_fake_control_stack_frames(th,context);
 #endif
+#endif
 
 #ifdef LISP_FEATURE_X86
 
@@ -1519,6 +1536,31 @@ arrange_return_to_c_function(os_context_t *context,
     *os_context_register_addr(context,reg_RSP) = (os_context_register_t)(sp-18);
 #else
 
+#if defined(LISP_FEATURE_SPARC)
+    /* Route through call_into_lisp which properly transitions to Lisp:
+     * flushes register windows, restores NIL/THREAD, clears ffca,
+     * loads BSP/CSP/OCFP from C globals, handles pseudo-atomic.
+     *
+     * The direct-jump path used by other RISC ports doesn't work on
+     * SPARC because %g1-%g5 are C scratch registers (not callee-saved
+     * like ARM64/PPC) and register windows need flushing.
+     *
+     * Limitations (acceptable because all current callers signal
+     * non-continuable errors via (ERROR ...) and always NLX):
+     *  - save_interrupt_context / FREE_INTERRUPT_CONTEXT_INDEX not
+     *    called: backtraces can't find the interrupted context, and
+     *    continuable restarts (cerror-trap) won't work on this path.
+     *  - call_into_lisp epilogue never runs after NLX: leaks one
+     *    hardware register window frame (harmless, Lisp uses CSP/CFP).
+     *  - If the function somehow returned, ret would jump to garbage
+     *    (%o7 is not set to a valid return address). */
+    set_os_context_pc(context, (os_context_register_t)(uintptr_t)funptr);
+    *os_context_register_addr(context, reg_NL0) = function;
+    *os_context_register_addr(context, reg_NL1) =
+        (os_context_register_t)(uintptr_t)access_control_frame_pointer(th);
+    *os_context_register_addr(context, reg_NL2) = 0;
+#else
+
 #ifdef LISP_FEATURE_ARM64
     *os_context_lr_addr(context) = os_context_pc(context);
 #endif
@@ -1533,11 +1575,9 @@ arrange_return_to_c_function(os_context_t *context,
 #endif
     *os_context_register_addr(context,reg_CFP) =
         (os_context_register_t)(uintptr_t)access_control_frame_pointer(th);
-#endif
-#if defined(LISP_FEATURE_SPARC)
-     *os_context_register_addr(context,reg_CODE) =
-         (os_context_register_t)((char*)fun + FUN_POINTER_LOWTAG);
-#elif defined(LISP_FEATURE_RISCV) || defined(LISP_FEATURE_LOONGARCH64)
+#endif /* !LISP_FEATURE_SPARC */
+#endif /* non-x86 */
+#if defined(LISP_FEATURE_RISCV) || defined(LISP_FEATURE_LOONGARCH64)
     *os_context_register_addr(context,reg_L0) =
         (os_context_register_t)((char*)fun + FUN_POINTER_LOWTAG);
 #endif
-- 
2.43.0

From 9484acd1bbaddc48c0ce2b4a0c9323b0322534c4 Mon Sep 17 00:00:00 2001
From: Andreas Franke <[email protected]>
Date: Mon, 6 Apr 2026 08:36:10 +0000
Subject: [PATCH 5/8] sparc: use reg_CSP (not reg_NL1) for
 foreign_function_call_active

---
 src/runtime/sparc-assem.S | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/src/runtime/sparc-assem.S b/src/runtime/sparc-assem.S
index da8d8bae8..c40fe7bab 100644
--- a/src/runtime/sparc-assem.S
+++ b/src/runtime/sparc-assem.S
@@ -97,8 +97,11 @@ call_into_lisp:
         store(reg_CSP,current_control_stack_pointer)
         store(reg_CFP,current_control_frame_pointer)
 
-        /* No longer in Lisp. */
-        store(reg_NL1,foreign_function_call_active)
+        /* No longer in Lisp.  Must use a known-nonzero register;
+         * reg_NL1 (%o1) is uninitialized after Lisp return and can
+         * be zero, making ffca=0 while still in C -- a subsequent
+         * signal would corrupt BSP by reading stale %g5. */
+        store(reg_CSP,foreign_function_call_active)
 
         /* Were we interrupted? */
 	END_PSEUDO_ATOMIC(reg_NL1)
-- 
2.43.0

From 20c75ea62198e82f2b4017773779ad46585e268a Mon Sep 17 00:00:00 2001
From: Andreas Franke <[email protected]>
Date: Mon, 30 Mar 2026 16:55:11 +0000
Subject: [PATCH 6/8] sparc: implement os_context_float_register_addr for BSD
 and SunOS

The os.h header unconditionally declares os_context_float_register_addr
but it was only defined for Linux/SPARC, causing a "Missing required
foreign symbol" warning on NetBSD and Solaris at startup.

Implement the function for all three SPARC platforms:

- Linux: unchanged (unconditionally returns register pointer)
- NetBSD: check uc_flags for _UC_FPU before accessing __fpregs;
  return NULL when the kernel did not save FPU state.  The GENERIC
  kernel does not define FPU_CONTEXT so the FPU register area in the
  signal context is uninitialized.  The _UC_FPU check adapts at
  runtime to any kernel configuration.
- SunOS/Solaris: add stub returning NULL (was entirely missing)

On the Lisp side, remove the #+linux reader conditional from
context-float-register and %set-context-float-register in
sparc-vm.lisp.  Instead, check for a NULL return from the C function
at runtime, returning zero for reads and signaling an error for writes
when FPU state is unavailable.  This handles all platforms uniformly
without compile-time platform guards.
---
 src/code/sparc-vm.lisp       | 42 +++++++++++++++++-------------------
 src/runtime/sparc-bsd-os.c   | 17 +++++++++++++++
 src/runtime/sparc-sunos-os.c |  8 +++++++
 3 files changed, 45 insertions(+), 22 deletions(-)

diff --git a/src/code/sparc-vm.lisp b/src/code/sparc-vm.lisp
index 101c60169..4d1320346 100644
--- a/src/code/sparc-vm.lisp
+++ b/src/code/sparc-vm.lisp
@@ -32,30 +32,30 @@
   (index int))
 
 (defun context-float-register (context index format &optional integer)
-  (declare (ignore integer)
-           (ignorable context index))
-  #+linux
+  (declare (ignore integer))
   (let ((sap (alien-sap (context-float-register-addr context index))))
-    (ecase format
-      (single-float
-       (coerce (sap-ref-double sap 0) 'single-float))
-      (double-float
-       (sap-ref-double sap 0))
-      (complex-single-float
-       (complex (coerce (sap-ref-double sap 0) 'single-float)
-                (coerce (sap-ref-double sap 8) 'single-float)))
-      (complex-double-float
-       (complex (sap-ref-double sap 0)
-                (sap-ref-double sap 8)))))
-  #-linux
-  (progn
-    (warn "stub CONTEXT-FLOAT-REGISTER")
-    (coerce 0 format)))
+    ;; The C function returns NULL when the signal context does not
+    ;; contain valid FPU state (e.g. NetBSD GENERIC kernel without
+    ;; FPU_CONTEXT).  Return zero rather than reading garbage.
+    (if (zerop (sb-sys:sap-int sap))
+        (coerce 0 format)
+        (ecase format
+          (single-float
+           (coerce (sap-ref-double sap 0) 'single-float))
+          (double-float
+           (sap-ref-double sap 0))
+          (complex-single-float
+           (complex (coerce (sap-ref-double sap 0) 'single-float)
+                    (coerce (sap-ref-double sap 8) 'single-float)))
+          (complex-double-float
+           (complex (sap-ref-double sap 0)
+                    (sap-ref-double sap 8)))))))
 
 (defun %set-context-float-register (context index format value)
   (declare (type (alien (* os-context-t)) context))
-  #+linux
   (let ((sap (alien-sap (context-float-register-addr context index))))
+    (when (zerop (sb-sys:sap-int sap))
+      (error "FPU state not available in signal context"))
     (ecase format
       (single-float
        (setf (sap-ref-single sap 0) value))
@@ -70,9 +70,7 @@
        (locally
            (declare (type (complex double-float) value))
          (setf (sap-ref-double sap 0) (realpart value)
-               (sap-ref-double sap 8) (imagpart value))))))
-  #-linux
-  (error "%set-context-float-register not working yet? ~S" (list context index format value)))
+               (sap-ref-double sap 8) (imagpart value)))))))
 
 ;;; Given a signal context, return the floating point modes word in
 ;;; the same format as returned by FLOATING-POINT-MODES.
diff --git a/src/runtime/sparc-bsd-os.c b/src/runtime/sparc-bsd-os.c
index 84216c3d1..539d60a07 100644
--- a/src/runtime/sparc-bsd-os.c
+++ b/src/runtime/sparc-bsd-os.c
@@ -77,9 +77,26 @@ os_context_sigmask_addr(os_context_t *context)
 }
 #endif
 
+os_context_register_t *
+os_context_float_register_addr(os_context_t *context, int offset)
+{
+   /* The NetBSD/sparc kernel only saves FPU registers into the signal
+    * context when the kernel is built with FPU_CONTEXT (which sets
+    * _UC_FPU in uc_flags via cpu_getmcontext).  The GENERIC kernel
+    * does not define FPU_CONTEXT, so the __fpregs area is
+    * uninitialized.  Return NULL when FPU state is not available,
+    * matching the arm64-OpenBSD convention. */
+   if (!(context->uc_flags & _UC_FPU))
+       return NULL;
+   return (os_context_register_t *)
+       &context->uc_mcontext.__fpregs.__fpu_fr.__fpu_regs[offset];
+}
+
 unsigned long
 os_context_fp_control(os_context_t *context)
 {
+   if (!(context->uc_flags & _UC_FPU))
+       return 0;
    return (context->uc_mcontext.__fpregs.__fpu_fsr);
 }
 
diff --git a/src/runtime/sparc-sunos-os.c b/src/runtime/sparc-sunos-os.c
index 0d9fb2efc..23d6d46b5 100644
--- a/src/runtime/sparc-sunos-os.c
+++ b/src/runtime/sparc-sunos-os.c
@@ -75,6 +75,14 @@ os_context_sigmask_addr(os_context_t *context)
     return &(context->uc_sigmask);
 }
 
+os_context_register_t *
+os_context_float_register_addr(os_context_t *context, int offset)
+{
+    /* TODO: Solaris saves FPU state in uc_mcontext.fpregs; implement
+     * when a Solaris/SPARC test environment is available. */
+    return NULL;
+}
+
 unsigned long
 os_context_fp_control(os_context_t *context)
 {
-- 
2.43.0

From a45cb8deb3deb28bf2bd4c1dd8381ceba1e85cda Mon Sep 17 00:00:00 2001
From: Andreas Franke <[email protected]>
Date: Mon, 30 Mar 2026 16:54:06 +0000
Subject: [PATCH 7/8] sparc: fix NaN float comparison and add <=/>= VOPs

The nope (NOT-P) branch conditions for the < and > float comparison
VOPs used :ge (FBGE) and :le (FBLE), which do not branch on
unordered (NaN) operands.  Change them to :uge (FBUGE) and :ule
(FBULE) which do.

This matters in practice because <= and >= are expanded by
source-transform into (OR (< X Y) (= X Y)), which compiles the
< test in NOT-P context for the OR short-circuit: "if not less-than,
try equal."  With the old FBGE, NaN falls through as "less-than"
and the OR returns T -- so (<= NaN 1.0) incorrectly returned T.

Add dedicated <= and >= VOPs using :le/:ug and :ge/:ul conditions,
which avoids the OR expansion entirely and generates a single FCMPS
instead of two.

Add a typed NaN comparison test exercising the float VOPs directly
(the existing :nan :comparison test uses untyped lambdas that go
through generic dispatch).  Also remove stale :fails-on :sparc
markers from those untyped tests -- they are passing now via generic
dispatch despite being marked failing since 2007.
---
 src/compiler/sparc/float.lisp | 11 ++++++++---
 tests/float.pure.lisp         | 25 +++++++++++++++++++++----
 2 files changed, 29 insertions(+), 7 deletions(-)

diff --git a/src/compiler/sparc/float.lisp b/src/compiler/sparc/float.lisp
index eca828d38..9681e69ad 100644
--- a/src/compiler/sparc/float.lisp
+++ b/src/compiler/sparc/float.lisp
@@ -796,9 +796,14 @@
                 (define-vop (,lname long-float-compare)
                   (:translate ,translate)
                   (:variant :long ,yep ,nope)))))
-  (frob < :l :ge </single-float </double-float #+long-float </long-float)
-  (frob > :g :le >/single-float >/double-float #+long-float >/long-float)
-  (frob = :eq :ne =/single-float =/double-float #+long-float =/long-float))
+  ;; Use unordered-true nope conditions so that NOT-P paths branch
+  ;; correctly for NaN (unordered) operands.  Dedicated <=/>= VOPs
+  ;; avoid the IR1 (OR (< X Y) (= X Y)) expansion for floats.
+  (frob < :l :uge </single-float </double-float #+long-float </long-float)
+  (frob > :g :ule >/single-float >/double-float #+long-float >/long-float)
+  (frob = :eq :ne =/single-float =/double-float #+long-float =/long-float)
+  (frob <= :le :ug <=/single-float <=/double-float #+long-float <=/long-float)
+  (frob >= :ge :ul >=/single-float >=/double-float #+long-float >=/long-float))
 
 #+long-float
 (deftransform eql ((x y) (long-float long-float))
diff --git a/tests/float.pure.lisp b/tests/float.pure.lisp
index c90b40bed..496dbc91d 100644
--- a/tests/float.pure.lisp
+++ b/tests/float.pure.lisp
@@ -188,8 +188,7 @@
                              (+ x0 x3 x4 x7) (+ x1 x2 x5 x6)
                              (+ x0 x1 x6 x7) (+ x2 x3 x4 x5)))))))
 
-(with-test (:name (:nan :comparison)
-            :fails-on :sparc)
+(with-test (:name (:nan :comparison))
   (sb-int:with-float-traps-masked (:invalid)
     (macrolet ((test (form)
                  (let ((nform (subst '(/ 0.0 0.0) 'nan form)))
@@ -235,8 +234,26 @@
       (test (not (> -1.0 nan)))
       (test (not (> nan 1.0))))))
 
-(with-test (:name (:nan :comparison :non-float)
-            :fails-on :sparc)
+(with-test (:name (:nan :comparison :typed))
+  ;; Exercise float comparison VOPs with declared types.
+  ;; The untyped (:nan :comparison) test above goes through generic
+  ;; dispatch; this test forces the compiler to select float VOPs
+  ;; where <= and >= correctness depends on dedicated VOPs or correct
+  ;; NOT-P branch conditions.
+  (sb-int:with-float-traps-masked (:invalid)
+    (dolist (type '(single-float double-float))
+      (let ((one (coerce 1 type))
+            (nan (locally (declare (muffle-conditions style-warning))
+                   (coerce (/ 0.0 0.0) type))))
+        (dolist (op '(< > <= >=))
+          (let ((fun (checked-compile
+                      `(lambda (x y) (declare (,type x y)) (,op x y)))))
+            (assert (not (funcall fun nan one))
+                    () "(~A NaN ~A) should be NIL for ~A" op one type)
+            (assert (not (funcall fun one nan))
+                    () "(~A ~A NaN) should be NIL for ~A" op one type)))))))
+
+(with-test (:name (:nan :comparison :non-float))
   (sb-int:with-float-traps-masked (:invalid)
     (let ((nan (/ 0.0 0.0))
           (reals (list 0 1 -1 1/2 -1/2 (expt 2 300) (- (expt 2 300))))
-- 
2.43.0

From 0f7146403e249723d4a1600ef4fe10b7f187c2b3 Mon Sep 17 00:00:00 2001
From: Andreas Franke <[email protected]>
Date: Sun, 5 Apr 2026 23:50:33 +0000
Subject: [PATCH 8/8] update test annotations for SPARC and NetBSD

---
 contrib/sb-introspect/test-driver.lisp | 2 +-
 tests/chill.impure.lisp                | 4 ++--
 tests/constraint.pure.lisp             | 2 +-
 tests/gc.impure.lisp                   | 2 +-
 tests/run-program.impure.lisp          | 2 +-
 5 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/contrib/sb-introspect/test-driver.lisp b/contrib/sb-introspect/test-driver.lisp
index 5f099cbab..200b8cd4c 100644
--- a/contrib/sb-introspect/test-driver.lisp
+++ b/contrib/sb-introspect/test-driver.lisp
@@ -374,7 +374,7 @@
 (test-util:with-test (:name :allocation-information.4
            ;; Ignored as per the comment above, even though it seems
            ;; unlikely that this is the right condition.
-           :fails-on (or :ppc64 (and :sparc :gencgc)))
+           :fails-on :ppc64)
     (tai (make-list 1) :heap
          `(:space :dynamic :boxed t :large nil)
          :ignore (list :page :pinned :generation :write-protected)))
diff --git a/tests/chill.impure.lisp b/tests/chill.impure.lisp
index 55f043cd4..2d1667e2f 100644
--- a/tests/chill.impure.lisp
+++ b/tests/chill.impure.lisp
@@ -29,7 +29,7 @@
            (return)))))))
 
 (with-test (:name (:chill :read-xc-files)
-            :fails-on sparc)
+            :fails-on :sparc)
   (flet ((try-replacing (stem this that)
            (let ((position (search this stem)))
              (when position
@@ -47,7 +47,7 @@
             (read-file name)))))))
 
 (with-test (:name (:chill :read-target-2-files)
-            :fails-on sparc)
+            :fails-on :sparc)
   (let ((target-2-stems-lists (cdr *build-order-data*)))
     (dolist (stems-list target-2-stems-lists)
       (dolist (stem stems-list)
diff --git a/tests/constraint.pure.lisp b/tests/constraint.pure.lisp
index 846f4db39..4b1da492d 100644
--- a/tests/constraint.pure.lisp
+++ b/tests/constraint.pure.lisp
@@ -827,7 +827,7 @@
 
 
 (with-test (:name :bounds-check-min-length
-            :fails-on (or :ppc :ppc64 :riscv :loongarch64 :sparc :mips))
+            :fails-on (or :ppc :ppc64 :riscv :loongarch64 :mips))
   (assert (= (count 'sb-kernel:%check-bound
                     (ctu:ir1-named-calls
                      `(lambda (x v)
diff --git a/tests/gc.impure.lisp b/tests/gc.impure.lisp
index 1290ff132..59d19ec84 100644
--- a/tests/gc.impure.lisp
+++ b/tests/gc.impure.lisp
@@ -529,7 +529,7 @@
            (assert (= (sb-sys:sap-ref-word sap (ash i sb-vm:word-shift)))))))))
 
 (with-test (:name :rospace-strings
-                  :fails-on (or :darwin-jit :sparc))
+                  :fails-on :darwin-jit)
   (let ((err (handler-case (setf (char (opaque-identity (symbol-name '*readtable*)) 0) #\*)
                (sb-sys:memory-fault-error (c)
                  (write-to-string c :escape nil)))))
diff --git a/tests/run-program.impure.lisp b/tests/run-program.impure.lisp
index aa58dd051..245fbc527 100644
--- a/tests/run-program.impure.lisp
+++ b/tests/run-program.impure.lisp
@@ -488,7 +488,7 @@
     (mapc #'sb-thread:join-thread threads)))
 
 (with-test (:name (run-program :child-fd-leak)
-            :skipped-on (or :openbsd :win32))
+            :skipped-on (or :netbsd :openbsd :win32))
   (when (probe-file "/dev/fd")
     (with-open-file (stream "/dev/null")
       (let* ((fd (sb-sys:fd-stream-fd stream))
-- 
2.43.0