Make per-thread sprof_enable a fairly normal per-thread special

contrib/sb-sprof/record.lisp

@@ -125,42 +125,41 @@ EXPERIMENTAL: Interface subject to change."
     (finish-output)))
 
 (define-alien-routine "sb_toggle_sigprof" int (context system-area-pointer) (state int))
-(eval-when (:compile-toplevel)
-  ;; current-thread-offset-sap has no slot setter, let alone for other threads,
-  ;; nor for sub-fields of a word, so ...
-  (defmacro sprof-enable-byte () ; see 'thread.h'
-    (+ (ash sb-vm:thread-state-word-slot sb-vm:word-shift) 1)))
 
 ;;; If a thread wants sampling but had previously blocked SIGPROF,
 ;;; it will have to unblock the signal. We can use %INTERRUPT-THREAD
 ;;; to tell it to do that.
+(macrolet ((enabled ()
+             ;; %SYMBOL-VALUE-IN-THREAD can return NIL causing stop/stop to have no effect,
+             ;; as seems perfectly reasonable for statistical sampling of a non-running thread.
+             #+sb-thread '(sb-thread::%symbol-value-in-thread 'sb-thread::*sprof-enable* thread)
+             #-sb-thread 'sb-thread::*sprof-enable*))
 (defun start-sampling (&optional (thread sb-thread:*current-thread*))
   "Unblock SIGPROF in the specified thread"
-  (cond ((neq thread sb-thread:*current-thread*)
-         (sb-thread::%interrupt-thread thread #'start-sampling))
-        ((zerop (sap-ref-8 (sb-thread:current-thread-sap) (sprof-enable-byte)))
-         (setf (sap-ref-8 (sb-thread:current-thread-sap) (sprof-enable-byte)) 1)
-         (sb-toggle-sigprof (if (boundp 'sb-kernel:*current-internal-error-context*)
-                                sb-kernel:*current-internal-error-context*
-                                (sb-sys:int-sap 0))
-                            0)))
+  (when (eql (enabled) 0)
+    (cond ((neq thread sb-thread:*current-thread*)
+           (sb-thread::%interrupt-thread thread #'start-sampling))
+          (t
+           (setf sb-thread::*sprof-enable* 1)
+           (sb-toggle-sigprof (if (boundp 'sb-kernel:*current-internal-error-context*)
+                                  sb-kernel:*current-internal-error-context*
+                                  (sb-sys:int-sap 0))
+                              0))))
   nil)
 
 (defun stop-sampling (&optional (thread sb-thread:*current-thread*))
   "Block SIGPROF in the specified thread"
-  (sb-thread:with-deathlok (thread c-thread)
-    (when (and (/= c-thread 0)
-               (not (zerop (sap-ref-8 (int-sap c-thread) (sprof-enable-byte)))))
-      (setf (sap-ref-8 (int-sap c-thread) (sprof-enable-byte)) 0)
-      ;; Blocking the signal is done lazily in threads other than the current one.
-      (when (eq thread sb-thread:*current-thread*)
-        (sb-toggle-sigprof (sb-sys:int-sap 0) 1)))) ; 1 = mask it
-  nil)
+  (when (eql (enabled) 1)
+    #+sb-thread (sb-thread::%set-symbol-value-in-thread 'sb-thread::*sprof-enable* thread 0)
+    #-sb-thread (setq sb-thread::*sprof-enable* 0)
+    ;; Blocking the signal is done lazily in threads other than the current one.
+    (when (eq thread sb-thread:*current-thread*)
+      (sb-toggle-sigprof (sb-sys:int-sap 0) 1))) ; 1 = mask it
+  nil))
 
 (defun call-with-sampling (enable thunk)
   (declare (dynamic-extent thunk))
-  (if (= (sap-ref-8 (sb-thread:current-thread-sap) (sprof-enable-byte))
-         (if enable 1 0))
+  (if (eql (if enable 1 0) sb-thread::*sprof-enable*)
       ;; Already in the correct state
       (funcall thunk)
       ;; Invert state, call thunk, invert again

src/compiler/generic/genesis.lisp

@@ -3418,7 +3418,7 @@ struct thread_state_word {
   // - sprof_enable is referenced with SAPs.
   //   (grep 'sb-vm:thread-state-word-slot')
   char control_stack_guard_page_protected;
-  char sprof_enable; // statistical CPU profiler switch
+  char unused;
   char state;
   char user_thread_p; // opposite of lisp's ephemeral-p
   char alien_stack_guard_page_protected;

src/compiler/generic/objdef.lisp

@@ -555,6 +555,7 @@ during backtrace.
               :length #.(/ 64 sb-vm:n-word-bits))
   ;; Statistical CPU profiler data recording buffer
   (sprof-data)
+  (sprof-enable :special sb-thread::*sprof-enable*) ; = 0 to block SIGPROF
   ;;
   (arena)
   ;; Miscellaneous arch-specific thread-local state for breakpoints.

src/runtime/alloc.c

@@ -715,9 +715,9 @@ alloc_thread_struct(void* spaces) {
     os_sem_init(&extra_data->sprof_sem, 0);
 #endif
     th->sprof_data = 0;
+    th->sprof_enable = 0;
 
     th->state_word.state = STATE_RUNNING;
-    th->state_word.sprof_enable = 0;
     th->state_word.user_thread_p = 1;
 
     lispobj* alien_stack_end = (lispobj*)((char*)th->alien_stack_start + ALIEN_STACK_SIZE);

src/runtime/gencgc.c

@@ -4181,8 +4181,7 @@ lisp_alloc(int flags, struct alloc_region *region, sword_t nbytes,
 #if !(defined LISP_FEATURE_PPC || defined LISP_FEATURE_PPC64 \
       || defined LISP_FEATURE_SPARC || defined LISP_FEATURE_WIN32)
     extern void allocator_record_backtrace(void*, struct thread*);
-    if (page_type != PAGE_TYPE_CODE && gencgc_alloc_profiler
-        && thread->state_word.sprof_enable)
+    if (page_type != PAGE_TYPE_CODE && gencgc_alloc_profiler && thread->sprof_enable)
         allocator_record_backtrace(__builtin_frame_address(0), thread);
 #endif
 

src/runtime/pmrgc.c

@@ -1369,8 +1369,7 @@ lisp_alloc(__attribute__((unused)) int flags,
 #if !(defined LISP_FEATURE_PPC || defined LISP_FEATURE_PPC64 \
       || defined LISP_FEATURE_SPARC || defined LISP_FEATURE_WIN32)
     extern void allocator_record_backtrace(void*, struct thread*);
-    if (page_type != PAGE_TYPE_CODE && gencgc_alloc_profiler
-        && thread->state_word.sprof_enable)
+    if (page_type != PAGE_TYPE_CODE && gencgc_alloc_profiler && thread->sprof_enable)
         allocator_record_backtrace(__builtin_frame_address(0), thread);
 #endif
 

src/runtime/sprof.c

@@ -572,7 +572,7 @@ static void diagnose_failure(struct thread* thread) {
     struct sprof_data* data = (void*)thread->sprof_data;
     if (data && data->capacity == CAPACITY_MAX) {
         // disable the profiler in this thread
-        thread->state_word.sprof_enable = 0;
+        thread->sprof_enable = 0;
 #ifdef LISP_FEATURE_SB_THREAD
         char msg[100];
         int msglen = sprintf(msg,
@@ -614,7 +614,7 @@ void sigprof_handler(int sig, __attribute__((unused)) siginfo_t* info,
     struct thread* thread = get_sb_vm_thread();
     // We can only profile Lisp threads.
     if (thread) {
-        if (thread->state_word.sprof_enable)
+        if (thread->sprof_enable)
             record_backtrace_from_context(context, thread);
         else
             // Block further signals it on return from the handler.

src/runtime/thread.c

@@ -383,7 +383,7 @@ void create_main_lisp_thread(lispobj function) {
     struct thread *th = alloc_thread_struct(0);
     if (!th || arch_os_thread_init(th)==0 || !init_shared_attr_object())
         lose("can't create initial thread");
-    th->state_word.sprof_enable = 1;
+    th->sprof_enable = make_fixnum(1);
 #if defined LISP_FEATURE_SB_THREAD && !defined LISP_FEATURE_GCC_TLS && !defined LISP_FEATURE_WIN32
     pthread_key_create(&current_thread, 0);
 #endif