From 770513c647e904aae82ca2928e09e072c455bee4 Mon Sep 17 00:00:00 2001 From: Douglas Katzman Date: Mon, 9 Oct 2017 17:26:30 -0400 Subject: [PATCH] Define find_symbol() which acts like CL:FIND-SYMBOL but slower Because sometimes you just gotta find a symbol from C. --- package-data-list.lisp-expr | 1 + src/runtime/search.c | 75 +++++++++++++++++++++++++++++++++++++++++++++ src/runtime/search.h | 2 ++ src/runtime/traceroot.c | 57 +++------------------------------- 4 files changed, 83 insertions(+), 52 deletions(-) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 25c5cc5a7..66124d579 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -619,6 +619,7 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*." #s(sb-cold:package-data :name "SB!IMPL" :doc "private: a grab bag of implementation details" + :import-from (("SB!KERNEL" "*PACKAGE-NAMES*")) :use ("CL" "SB!ALIEN" "SB!BIGNUM" "SB!DEBUG" "SB!EXT" "SB!FASL" "SB!GRAY" "SB!INT" "SB!KERNEL" "SB!SYS")) diff --git a/src/runtime/search.c b/src/runtime/search.c index 2712cb3cd..ad7cda927 100644 --- a/src/runtime/search.c +++ b/src/runtime/search.c @@ -18,6 +18,8 @@ #include "thread.h" #include "gc-internal.h" #include "genesis/primitive-objects.h" +#include "genesis/hash-table.h" +#include "genesis/package.h" boolean search_for_type(int type, lispobj **start, int *count) { @@ -80,3 +82,76 @@ lispobj* search_for_symbol(char *name, lispobj start, lispobj end) } return 0; } + +static boolean sym_stringeq(lispobj sym, const char *string, int len) +{ + struct vector* name = VECTOR(SYMBOL(sym)->name); + return widetag_of(name->header) == SIMPLE_BASE_STRING_WIDETAG + && name->length == make_fixnum(len) + && !memcmp(name->data, string, len); +} + +static lispobj* search_package_symbols(lispobj package, char* symbol_name, + unsigned int* hint) +{ + // Since we don't have Lisp's string hash algorithm in C, we can only + // scan linearly, using the 'hint' as a starting point. + struct package* pkg = (struct package*)(package - INSTANCE_POINTER_LOWTAG); + int table_selector = *hint & 1, iteration; + for (iteration = 1; iteration <= 2; ++iteration) { + struct instance* symbols = (struct instance*) + native_pointer(table_selector ? pkg->external_symbols : pkg->internal_symbols); + gc_assert(widetag_of(symbols->header) == INSTANCE_WIDETAG); + struct vector* cells = VECTOR(symbols->slots[INSTANCE_DATA_START]); + gc_assert(widetag_of(cells->header) == SIMPLE_VECTOR_WIDETAG); + lispobj namelen = strlen(symbol_name); + int cells_length = fixnum_value(cells->length); + int index = *hint >> 1; + if (index >= cells_length) + index = 0; // safeguard against vector shrinkage + int initial_index = index; + do { + lispobj thing = cells->data[index]; + if (lowtag_of(thing) == OTHER_POINTER_LOWTAG + && widetag_of(SYMBOL(thing)->header) == SYMBOL_WIDETAG + && sym_stringeq(thing, symbol_name, namelen)) { + *hint = (index << 1) | table_selector; + return (lispobj*)SYMBOL(thing); + } + index = (index + 1) % cells_length; + } while (index != initial_index); + table_selector = table_selector ^ 1; + } + return 0; +} + +lispobj* find_symbol(char* symbol_name, char* package_name, unsigned int* hint) +{ + // Use SB-KERNEL::SUB-GC to get a hold of the SB-KERNEL package, + // which contains the symbol *PACKAGE-NAMES*. + static unsigned int kernelpkg_hint; + lispobj kernel_package = SYMBOL(FDEFN(SUB_GC_FDEFN)->name)->package; + lispobj* package_names = search_package_symbols(kernel_package, "*PACKAGE-NAMES*", + &kernelpkg_hint); + lispobj namelen = strlen(package_name); + struct hash_table* names = (struct hash_table*) + native_pointer(((struct symbol*)package_names)->value); + struct vector* cells = (struct vector*)native_pointer(names->table); + int i; + // Search *PACKAGE-NAMES* for the package + for (i=2; ilength); i += 2) { + lispobj element = cells->data[i]; + if (is_lisp_pointer(element)) { + struct vector* string = (struct vector*)native_pointer(element); + if (widetag_of(string->header) == SIMPLE_BASE_STRING_WIDETAG + && string->length == make_fixnum(namelen) + && !memcmp(string->data, package_name, namelen)) { + element = cells->data[i+1]; + if (lowtag_of(element) == LIST_POINTER_LOWTAG) + element = CONS(element)->car; + return search_package_symbols(element, symbol_name, hint); + } + } + } + return 0; +} diff --git a/src/runtime/search.h b/src/runtime/search.h index 4724bc903..dac292620 100644 --- a/src/runtime/search.h +++ b/src/runtime/search.h @@ -12,6 +12,8 @@ #ifndef _SEARCH_H_ #define _SEARCH_H_ +extern lispobj* find_symbol(char*, char*, unsigned int*); // Find via package +// Find via heap scan extern boolean search_for_type(int type, lispobj **start, int *count); extern lispobj* search_for_symbol(char *name, lispobj start, lispobj end); diff --git a/src/runtime/traceroot.c b/src/runtime/traceroot.c index 54ffac92e..e25bfc046 100644 --- a/src/runtime/traceroot.c +++ b/src/runtime/traceroot.c @@ -8,10 +8,12 @@ #include "genesis/cons.h" #include "genesis/constants.h" #include "genesis/gc-tables.h" +#include "genesis/instance.h" #include "genesis/layout.h" #include "genesis/package.h" #include "genesis/vector.h" #include "pseudo-atomic.h" // for get_alloc_pointer() +#include "search.h" #include #include @@ -892,57 +894,6 @@ void prove_liveness(lispobj objects, int criterion) gc_prove_liveness(0, objects, gc_n_stack_pins, pinned_objects.keys, criterion); } -#include "genesis/package.h" -#include "genesis/instance.h" - -static boolean __attribute__((unused)) sym_stringeq(lispobj sym, const char *string, int len) -{ - struct vector* name = VECTOR(SYMBOL(sym)->name); - return widetag_of(name->header) == SIMPLE_BASE_STRING_WIDETAG - && name->length == make_fixnum(len) - && !strcmp((char*)name->data, string); -} - -/* Find the C string 'name' in 'table', a package-hashtable. - * This does not need to be particularly efficient. No hashing is involved. */ -static struct symbol* find_symbol_or_lose(char name[], lispobj table, int* hint) -{ - int namelen = strlen(name); - struct vector* cells = (struct vector*) - native_pointer(((struct instance*)native_pointer(table)) - ->slots[INSTANCE_DATA_START]); - int cells_length = fixnum_value(cells->length); - int index = *hint; - if (index >= cells_length) - index = 0; // safeguard against vector shrinkage - int initial_index = index; - do { - lispobj thing = cells->data[index]; - if (lowtag_of(thing) == OTHER_POINTER_LOWTAG - && widetag_of(SYMBOL(thing)->header) == SYMBOL_WIDETAG - && sym_stringeq(thing, name, namelen)) { - *hint = index; - return SYMBOL(thing); - } - index = (index + 1) % cells_length; - } while (index != initial_index); - lose("Can't find %s", name); -} - -static lispobj sb_thread_all_threads() -{ -#ifdef ENTER_FOREIGN_CALLBACK_FDEFN - // Starting with a known static fdefn in SB-THREAD::, get the SB-THREAD package - // and find *ALL-THREADS* (which isn't static). Fewer static symbols is better. - struct symbol* sym = SYMBOL(FDEFN(ENTER_FOREIGN_CALLBACK_FDEFN)->name); - struct package* pkg = (struct package*)native_pointer(sym->package); - static int hint = 0; - sym = find_symbol_or_lose("*ALL-THREADS*", pkg->internal_symbols, &hint); - return sym->value; -#endif - return NIL; -} - // These are slot offsets in (DEFSTRUCT THREAD), // not the C structure defined in genesis/thread.h #define LISP_THREAD_NAME_SLOT INSTANCE_DATA_START+0 @@ -950,7 +901,9 @@ static lispobj sb_thread_all_threads() struct vector* lisp_thread_name(os_thread_t os_thread) { - lispobj list = sb_thread_all_threads(); + static unsigned int hint; + lispobj* sym = find_symbol("*ALL-THREADS*", "SB-THREAD", &hint); + lispobj list = sym ? ((struct symbol*)sym)->value : NIL; while (list != NIL) { struct instance* lisp_thread = (struct instance*)native_pointer(CONS(list)->car); list = CONS(list)->cdr; -- 2.11.4.GIT