Re: master: Delete tls-related junk from init-main-thread

Stas Boukarev <[email protected]> Fri, 13 Mar 2026 21:21:36 +0300
Newsgroups gmane.lisp.steel-bank.cvs,gmane.lisp.steel-bank.devel
Message-ID <CAF63=10gCeUkUxe8Y8r0CFLNbAPwA=c=iy4m2ovZYt3tRYYBAw@mail.gmail.com>
arm32 fails with:
Unhandled UNDEFINED-FUNCTION in thread #<HOST-SB-THREAD:THREAD
tid=4655 "main thread" RUNNING
{10024D06C3}>:
The function SB-FASL::GET-SYMBOL-TLS-INDEX is undefined.
Backtrace for: #<HOST-SB-THREAD:THREAD tid=4655 "main thread" RUNNING
{10024D06C3}>
0: ("undefined function" *PACKAGE*)
1: (SB-FASL::WRITE-INITIAL-CORE-FILE "output/cold-sbcl.core" NIL
#<SB-FASL::DESCRIPTOR for pointer: #X508E3C18, lowtag #b111, DYNAMIC>
T)
2:

On Fri, Mar 13, 2026 at 9:15 PM snuglas via Sbcl-commits
<[email protected]> wrote:
>
> The branch "master" has been updated in SBCL:
>        via  a4ec9fa6e558d3e4eb95f1fd0d725d56f476b5b4 (commit)
>       from  696dfb34488914ba11b5fa21e22d2c24fdc4c209 (commit)
>
> - Log -----------------------------------------------------------------
> commit a4ec9fa6e558d3e4eb95f1fd0d725d56f476b5b4
> Author: Douglas Katzman <[email protected]>
> Date:   Fri Mar 13 14:07:29 2026 -0400
>
>     Delete tls-related junk from init-main-thread
> ---
>  src/code/target-thread.lisp       |  7 -------
>  src/compiler/generic/genesis.lisp |  3 ++-
>  src/runtime/core.h                |  1 +
>  src/runtime/coreparse.c           | 10 ++++++----
>  src/runtime/mark-region.c         |  1 +
>  src/runtime/save.c                |  5 ++++-
>  tests/x86-64-codegen.impure.lisp  | 14 +++++---------
>  tools-for-build/editcore.lisp     |  9 +++++----
>  tools-for-build/elftool.lisp      |  1 +
>  9 files changed, 25 insertions(+), 26 deletions(-)
>
> diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
> index f20c69ff9..fc8c19367 100644
> --- a/src/code/target-thread.lisp
> +++ b/src/code/target-thread.lisp
> @@ -395,13 +395,6 @@ created and old ones may exit at any time."
>      (setf *initial-thread* thread)
>      (setf *joinable-threads* nil)
>      (setq *session* (new-session thread))
> -    #+(and sb-thread tls-load-indirect)
> -    (let ((sap (int-sap (ash sb-vm::*tls-symbol-map* sb-vm:n-fixnum-tag-bits))))
> -      ;; Elements of the tls-symbol-map are meaningless below the tls index of
> -      ;; *PACKAGE* because there are more symbols than there are cells to hold them.
> -      ;; Wiping out the nonsense cell range is better than keeping fictitious data.
> -      (dotimes (i (ash (symbol-tls-index '*package*) (- (1+ sb-vm:word-shift))))
> -        (setf (sap-ref-word sap (ash i sb-vm:word-shift)) sb-vm:no-tls-value-marker)))
>      (setq *all-threads*
>            (avl-insert nil
>                        (sb-thread::thread-primitive-thread sb-thread:*current-thread*)
> diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp
> index 9f572dcec..83cbd8791 100644
> --- a/src/compiler/generic/genesis.lisp
> +++ b/src/compiler/generic/genesis.lisp
> @@ -4255,9 +4255,10 @@ INDEX   LINK-ADDR       FNAME    FUNCTION  NAME
>        (let ((initial-fun (descriptor-bits (cold-symbol-function '!cold-init))))
>          (when verbose (format t "~&/INITIAL-FUN=#X~X~%" initial-fun))
>          ;; Write a 'struct initfunctions'
> -        (write-words core-file initial-fun-core-entry-type-code 5
> +        (write-words core-file initial-fun-core-entry-type-code 6
>                       (hash-table-count *cold-foreign-symbol-table*)
>                       (descriptor-bits foreign-symbols)
> +                     (get-symbol-tls-index '*package*)
>                       initial-fun))
>
>        ;; Write the End entry.
> diff --git a/src/runtime/core.h b/src/runtime/core.h
> index fdbc543d9..5463cdb5b 100644
> --- a/src/runtime/core.h
> +++ b/src/runtime/core.h
> @@ -47,6 +47,7 @@ struct memsize_options {
>  struct initfunctions {
>      lispobj c_linkage_count;
>      lispobj c_linkage_vector;
> +    lispobj tls_map_starting_offset;
>      lispobj lispfun;
>  };
>  extern struct initfunctions load_core_file(char *file, os_vm_offset_t file_offset,
> diff --git a/src/runtime/coreparse.c b/src/runtime/coreparse.c
> index 2afbec366..de718798b 100644
> --- a/src/runtime/coreparse.c
> +++ b/src/runtime/coreparse.c
> @@ -1386,7 +1386,8 @@ init_coreparse_spaces(int n, struct coreparse_space* input)
>  }
>
>  lispobj* tlsindex_to_symbol_map;
> -static void construct_tls_map()
> +int tls_map_starting_offset;
> +static void construct_tls_map(int starting_tlsoffset)
>  {
>      int map_nbytes = N_WORD_BYTES * (dynamic_values_bytes / bytes_per_tls_symbol);
>      tlsindex_to_symbol_map = checked_malloc(map_nbytes);
> @@ -1401,7 +1402,7 @@ static void construct_tls_map()
>  #endif
>      int offset;
>  #define EXAMINE_OBJECT() if (widetag_of(where) == SYMBOL_WIDETAG && \
> -    (offset = tls_index_of((struct symbol*)where)) != 0) \
> +    (offset = tls_index_of((struct symbol*)where)) >= starting_tlsoffset) \
>          tlsindex_to_symbol_map[offset>>shift] = make_lispobj(where, OTHER_POINTER_LOWTAG)
>  #ifdef LISP_FEATURE_MARK_REGION_GC
>  # define SYMBOL_PAGE_TYPE PAGE_TYPE_MIXED
> @@ -1423,6 +1424,7 @@ static void construct_tls_map()
>  #endif
>      for ( ; where < end ; where += object_size(where) ) EXAMINE_OBJECT();
>  #undef EXAMINE_OBJECT
> +    tls_map_starting_offset = starting_tlsoffset; // for later save_to_filehandle()
>  }
>
>  /* 'merge_core_pages': Tri-state flag to determine whether we attempt to mark
> @@ -1439,7 +1441,7 @@ load_core_file(char *file, os_vm_offset_t file_offset, int merge_core_pages)
>      os_vm_size_t len, remaining_len, stringlen;
>      int fd = open_binary(file, O_RDONLY);
>      ssize_t count;
> -    struct initfunctions initfun = {0,0,0};
> +    struct initfunctions initfun = {0,0,0,0};
>      struct heap_adjust adj;
>      memset(&adj, 0, sizeof adj);
>      sword_t linkage_table_data_page = -1;
> @@ -1588,7 +1590,7 @@ load_core_file(char *file, os_vm_offset_t file_offset, int merge_core_pages)
>                  dynamic_values_bytes = (int)SymbolValue(FREE_TLS_INDEX,0) * 2;
>                  // fprintf(stderr, "NOTE: TLS size increased to %x\n", dynamic_values_bytes);
>              }
> -            construct_tls_map();
> +            construct_tls_map(initfun.tls_map_starting_offset);
>  #else
>              SYMBOL(FREE_TLS_INDEX)->value = sizeof (struct thread);
>  #endif
> diff --git a/src/runtime/mark-region.c b/src/runtime/mark-region.c
> index 200917f94..dfb63aea4 100644
> --- a/src/runtime/mark-region.c
> +++ b/src/runtime/mark-region.c
> @@ -784,6 +784,7 @@ static void local_smash_weak_pointers()
>          }
>      }
>      weak_vectors = 0;
> +    // TODO: tlsindex_to_symbol_map
>  }
>
>  static void reset_statistics() {
> diff --git a/src/runtime/save.c b/src/runtime/save.c
> index 52468ae57..8c7a0a338 100644
> --- a/src/runtime/save.c
> +++ b/src/runtime/save.c
> @@ -433,10 +433,13 @@ void save_to_filehandle(FILE *file, char *filename, lispobj init_function,
>      write_static_space_constants(file);
>  #endif
>
> +    extern int tls_map_starting_offset;
>      write_lispobj(INITIAL_FUN_CORE_ENTRY_TYPE_CODE, file);
> -    write_lispobj(5, file);
> +    write_lispobj(6, file); // length in lispobjs (including this field)
> +    // a 'struct initfunctions' from core.h. (Consider a struct-writing function perhaps)
>      write_lispobj(alien_linkage_table_n_prelinked, file);
>      write_lispobj(required_foreign_symbols(), file);
> +    write_lispobj(tls_map_starting_offset, file);
>      write_lispobj(init_function, file);
>
>  #ifdef LISP_FEATURE_GENERATIONAL
> diff --git a/tests/x86-64-codegen.impure.lisp b/tests/x86-64-codegen.impure.lisp
> index a02a2bc46..069d5acb4 100644
> --- a/tests/x86-64-codegen.impure.lisp
> +++ b/tests/x86-64-codegen.impure.lisp
> @@ -1435,16 +1435,12 @@
>  #+sb-thread
>  (with-test (:name :tls-symbol-map)
>    (let ((sap (sb-sys:int-sap (ash sb-vm::*tls-symbol-map* sb-vm:n-fixnum-tag-bits)))
> -        (limit (ash (ash sb-vm::*free-tls-index* sb-vm:n-fixnum-tag-bits)
> -                    (- sb-vm:word-shift)))
>          (divisor (or #+tls-load-indirect 16 8)))
> -    (loop for i from (or #+tls-load-indirect (ash (sb-kernel:symbol-tls-index '*package*)
> -                                                  (- (1+ sb-vm:word-shift)))
> -                         1)
> -          below limit
> -          unless (= (sb-sys:sap-ref-word sap (ash i sb-vm:word-shift)) sb-vm:no-tls-value-marker)
> -          do (let ((sym (sb-sys:sap-ref-lispobj sap (ash i sb-vm:word-shift))))
> -               (assert (= (floor (sb-kernel:symbol-tls-index sym) divisor) i))))))
> +    (dotimes (i (ash (ash sb-vm::*free-tls-index* sb-vm:n-fixnum-tag-bits)
> +                     (- sb-vm:word-shift)))
> +      (unless (= (sb-sys:sap-ref-word sap (ash i sb-vm:word-shift)) sb-vm:no-tls-value-marker)
> +        (let ((sym (sb-sys:sap-ref-lispobj sap (ash i sb-vm:word-shift))))
> +          (assert (= (floor (sb-kernel:symbol-tls-index sym) divisor) i)))))))
>
>  #+sb-thread
>  (with-test (:name :tls-index-validity :skipped-on (:not :tls-load-indirect))
> diff --git a/tools-for-build/editcore.lisp b/tools-for-build/editcore.lisp
> index 1064e50ad..81704205a 100644
> --- a/tools-for-build/editcore.lisp
> +++ b/tools-for-build/editcore.lisp
> @@ -999,10 +999,11 @@
>           (setq constants (loop for i from (- ptr 2) repeat (+ len 2)
>                                 collect (%vector-raw-bits core-header i))))
>          (#.initial-fun-core-entry-type-code
> -         (aver (= len 3)) ; NOT including the entry type code + length itself
> +         (aver (= len 4)) ; NOT including the entry type code + length itself
>           (setq initfun (vector (%vector-raw-bits core-header ptr)
>                                 (%vector-raw-bits core-header (+ ptr 1))
> -                               (%vector-raw-bits core-header (+ ptr 2)))))))
> +                               (%vector-raw-bits core-header (+ ptr 2))
> +                               (%vector-raw-bits core-header (+ ptr 3)))))))
>      (let ((static (find static-core-space-id space-list :key 'space-id)))
>        (assert static)
>        (assert (= *nil-taggedptr* (+ (space-addr static) sb-vm::nil-value-offset))))
> @@ -1058,8 +1059,8 @@
>                             n-ptes (+ (* n-ptes *bitmap-bytes-per-page*) pte-bytes)
>                             page-count))
>          (setf (%vector-raw-bits core-header (incf offset)) word)))
> -    (dolist (word (list initial-fun-core-entry-type-code 5
> -                        (elt initfun 0) (elt initfun 1) (elt initfun 2)
> +    (dolist (word (list initial-fun-core-entry-type-code 6
> +                        (elt initfun 0) (elt initfun 1) (elt initfun 2) (elt initfun 3)
>                          end-core-entry-type-code 2))
>        (setf (%vector-raw-bits core-header (incf offset)) word))
>      (write-sequence core-header output)
> diff --git a/tools-for-build/elftool.lisp b/tools-for-build/elftool.lisp
> index 35b8d49e4..2110ce4f8 100644
> --- a/tools-for-build/elftool.lisp
> +++ b/tools-for-build/elftool.lisp
> @@ -1196,6 +1196,7 @@ lisp_fun_linkage_space: .zero ~:*~D
>        ;;                            :element-type '(unsigned-byte 8) :if-exists :supersede)
>        (let ((split-core nil))
>          (setq core-offset (read-core-header input core-header verbose))
> +        ;; TODO: just use PARSE-CORE-HEADER. Any day now. (This logic got here first)
>          (do-core-header-entry ((id len ptr) core-header)
>            (case id
>              (#.build-id-core-entry-type-code
>
> -----------------------------------------------------------------------
>
>
> hooks/post-receive
> --
> SBCL
>
>
> _______________________________________________
> Sbcl-commits mailing list
> [email protected]
> https://lists.sourceforge.net/lists/listinfo/sbcl-commits


_______________________________________________
Sbcl-commits mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/sbcl-commits