From 457d80803848ccd73b28508177f1888ff66bc72f Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Mon, 1 Nov 2004 13:19:03 +0000 Subject: [PATCH] 0.8.16.23: Merge in character_branch runtime changes, protected by #ifdefs This patch brought to you by character_branch --- src/runtime/backtrace.c | 1 + src/runtime/gc-common.c | 68 +++++++++++++++++++++++++++++++++++++++++++++++ src/runtime/gencgc.c | 15 +++++++++++ src/runtime/print.c | 6 +++++ src/runtime/purify.c | 21 +++++++++++++++ src/runtime/search.c | 2 ++ version.lisp-expr | 2 +- 7 files changed, 114 insertions(+), 1 deletion(-) diff --git a/src/runtime/backtrace.c b/src/runtime/backtrace.c index e10af61..83a457f 100644 --- a/src/runtime/backtrace.c +++ b/src/runtime/backtrace.c @@ -244,6 +244,7 @@ backtrace(int nframes) string = (struct vector *) object; printf("%s, ", (char *) string->data); } else + /* FIXME: broken from (VECTOR NIL) */ printf("(Not simple string??\?), "); } else printf("(Not other pointer??\?), "); diff --git a/src/runtime/gc-common.c b/src/runtime/gc-common.c index 3caac3b..a7d2034 100644 --- a/src/runtime/gc-common.c +++ b/src/runtime/gc-common.c @@ -779,6 +779,56 @@ trans_base_string(lispobj object) } static int +size_character_string(lispobj *where) +{ + struct vector *vector; + int length, nwords; + + /* NOTE: A string contains one more byte of data (a terminating + * '\0' to help when interfacing with C functions) than indicated + * by the length slot. */ + + vector = (struct vector *) where; + length = fixnum_value(vector->length) + 1; + nwords = CEILING(NWORDS(length, 32) + 2, 2); + + return nwords; +} + +scav_character_string(lispobj *where, lispobj object) +{ + struct vector *vector; + int length, nwords; + + /* NOTE: Strings contain one more byte of data than the length */ + /* slot indicates. */ + + vector = (struct vector *) where; + length = fixnum_value(vector->length) + 1; + nwords = CEILING(NWORDS(length, 32) + 2, 2); + + return nwords; +} +static lispobj +trans_character_string(lispobj object) +{ + struct vector *vector; + int length, nwords; + + gc_assert(is_lisp_pointer(object)); + + /* NOTE: A string contains one more byte of data (a terminating + * '\0' to help when interfacing with C functions) than indicated + * by the length slot. */ + + vector = (struct vector *) native_pointer(object); + length = fixnum_value(vector->length) + 1; + nwords = CEILING(NWORDS(length, 32) + 2, 2); + + return copy_large_unboxed_object(object, nwords); +} + +static int size_base_string(lispobj *where) { struct vector *vector; @@ -1550,6 +1600,9 @@ gc_init_tables(void) #endif scavtab[SIMPLE_ARRAY_WIDETAG] = scav_boxed; scavtab[SIMPLE_BASE_STRING_WIDETAG] = scav_base_string; +#ifdef SIMPLE_CHARACTER_STRING_WIDETAG + scavtab[SIMPLE_CHARACTER_STRING_WIDETAG] = scav_character_string; +#endif scavtab[SIMPLE_BIT_VECTOR_WIDETAG] = scav_vector_bit; scavtab[SIMPLE_ARRAY_NIL_WIDETAG] = scav_vector_nil; scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] = @@ -1625,6 +1678,9 @@ gc_init_tables(void) scav_vector_complex_long_float; #endif scavtab[COMPLEX_BASE_STRING_WIDETAG] = scav_boxed; +#ifdef COMPLEX_CHARACTER_STRING_WIDETAG + scavtab[COMPLEX_CHARACTER_STRING_WIDETAG] = scav_boxed; +#endif scavtab[COMPLEX_VECTOR_NIL_WIDETAG] = scav_boxed; scavtab[COMPLEX_BIT_VECTOR_WIDETAG] = scav_boxed; scavtab[COMPLEX_VECTOR_WIDETAG] = scav_boxed; @@ -1675,6 +1731,9 @@ gc_init_tables(void) #endif transother[SIMPLE_ARRAY_WIDETAG] = trans_boxed; /* but not GENCGC */ transother[SIMPLE_BASE_STRING_WIDETAG] = trans_base_string; +#ifdef SIMPLE_CHARACTER_STRING_WIDETAG + transother[SIMPLE_CHARACTER_STRING_WIDETAG] = trans_character_string; +#endif transother[SIMPLE_BIT_VECTOR_WIDETAG] = trans_vector_bit; transother[SIMPLE_VECTOR_WIDETAG] = trans_vector; transother[SIMPLE_ARRAY_NIL_WIDETAG] = trans_vector_nil; @@ -1755,6 +1814,9 @@ gc_init_tables(void) trans_vector_complex_long_float; #endif transother[COMPLEX_BASE_STRING_WIDETAG] = trans_boxed; +#ifdef COMPLEX_CHARACTER_STRING_WIDETAG + transother[COMPLEX_CHARACTER_STRING_WIDETAG] = trans_boxed; +#endif transother[COMPLEX_BIT_VECTOR_WIDETAG] = trans_boxed; transother[COMPLEX_VECTOR_NIL_WIDETAG] = trans_boxed; transother[COMPLEX_VECTOR_WIDETAG] = trans_boxed; @@ -1805,6 +1867,9 @@ gc_init_tables(void) #endif sizetab[SIMPLE_ARRAY_WIDETAG] = size_boxed; sizetab[SIMPLE_BASE_STRING_WIDETAG] = size_base_string; +#ifdef SIMPLE_CHARACTER_STRING_WIDETAG + sizetab[SIMPLE_CHARACTER_STRING_WIDETAG] = size_character_string; +#endif sizetab[SIMPLE_BIT_VECTOR_WIDETAG] = size_vector_bit; sizetab[SIMPLE_VECTOR_WIDETAG] = size_vector; sizetab[SIMPLE_ARRAY_NIL_WIDETAG] = size_vector_nil; @@ -1881,6 +1946,9 @@ gc_init_tables(void) size_vector_complex_long_float; #endif sizetab[COMPLEX_BASE_STRING_WIDETAG] = size_boxed; +#ifdef COMPLEX_CHARACTER_STRING_WIDETAG + sizetab[COMPLEX_CHARACTER_STRING_WIDETAG] = size_boxed; +#endif sizetab[COMPLEX_VECTOR_NIL_WIDETAG] = size_boxed; sizetab[COMPLEX_BIT_VECTOR_WIDETAG] = size_boxed; sizetab[COMPLEX_VECTOR_WIDETAG] = size_boxed; diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c index 8fbff43..c6009cc 100644 --- a/src/runtime/gencgc.c +++ b/src/runtime/gencgc.c @@ -2145,6 +2145,9 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer) #endif case SIMPLE_ARRAY_WIDETAG: case COMPLEX_BASE_STRING_WIDETAG: +#ifdef COMPLEX_CHARACTER_STRING_WIDETAG + case COMPLEX_CHARACTER_STRING_WIDETAG: +#endif case COMPLEX_VECTOR_NIL_WIDETAG: case COMPLEX_BIT_VECTOR_WIDETAG: case COMPLEX_VECTOR_WIDETAG: @@ -2160,6 +2163,9 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer) case LONG_FLOAT_WIDETAG: #endif case SIMPLE_BASE_STRING_WIDETAG: +#ifdef SIMPLE_CHARACTER_STRING_WIDETAG + case SIMPLE_CHARACTER_STRING_WIDETAG: +#endif case SIMPLE_BIT_VECTOR_WIDETAG: case SIMPLE_ARRAY_NIL_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG: @@ -2248,6 +2254,9 @@ maybe_adjust_large_object(lispobj *where) break; case BIGNUM_WIDETAG: case SIMPLE_BASE_STRING_WIDETAG: +#ifdef SIMPLE_CHARACTER_STRING_WIDETAG + case SIMPLE_CHARACTER_STRING_WIDETAG: +#endif case SIMPLE_BIT_VECTOR_WIDETAG: case SIMPLE_ARRAY_NIL_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG: @@ -3111,6 +3120,9 @@ verify_space(lispobj *start, size_t words) case COMPLEX_WIDETAG: case SIMPLE_ARRAY_WIDETAG: case COMPLEX_BASE_STRING_WIDETAG: +#ifdef COMPLEX_CHARACTER_STRING_WIDETAG + case COMPLEX_CHARACTER_STRING_WIDETAG: +#endif case COMPLEX_VECTOR_NIL_WIDETAG: case COMPLEX_BIT_VECTOR_WIDETAG: case COMPLEX_VECTOR_WIDETAG: @@ -3197,6 +3209,9 @@ verify_space(lispobj *start, size_t words) case COMPLEX_LONG_FLOAT_WIDETAG: #endif case SIMPLE_BASE_STRING_WIDETAG: +#ifdef SIMPLE_CHARACTER_STRING_WIDETAG + case SIMPLE_CHARACTER_STRING_WIDETAG: +#endif case SIMPLE_BIT_VECTOR_WIDETAG: case SIMPLE_ARRAY_NIL_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG: diff --git a/src/runtime/print.c b/src/runtime/print.c index 7909868..30e2669 100644 --- a/src/runtime/print.c +++ b/src/runtime/print.c @@ -536,6 +536,9 @@ static void print_otherptr(lispobj obj) #endif case SIMPLE_BASE_STRING_WIDETAG: +#ifdef SIMPLE_CHARACTER_STRING_WIDETAG + case SIMPLE_CHARACTER_STRING_WIDETAG: /* FIXME */ +#endif NEWLINE_OR_RETURN; cptr = (char *)(ptr+1); putchar('"'); @@ -599,6 +602,9 @@ static void print_otherptr(lispobj obj) case SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG: #endif case COMPLEX_BASE_STRING_WIDETAG: +#ifdef COMPLEX_CHARACTER_STRING_WIDETAG + case COMPLEX_CHARACTER_STRING_WIDETAG: +#endif case COMPLEX_VECTOR_NIL_WIDETAG: case COMPLEX_BIT_VECTOR_WIDETAG: case COMPLEX_VECTOR_WIDETAG: diff --git a/src/runtime/purify.c b/src/runtime/purify.c index ac0bfd8..3750895 100644 --- a/src/runtime/purify.c +++ b/src/runtime/purify.c @@ -285,6 +285,9 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) #endif case SIMPLE_ARRAY_WIDETAG: case COMPLEX_BASE_STRING_WIDETAG: +#ifdef COMPLEX_CHARACTER_STRING_WIDETAG + case COMPLEX_CHARACTER_STRING_WIDETAG: +#endif case COMPLEX_VECTOR_NIL_WIDETAG: case COMPLEX_BIT_VECTOR_WIDETAG: case COMPLEX_VECTOR_WIDETAG: @@ -301,6 +304,9 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) #endif case SIMPLE_ARRAY_NIL_WIDETAG: case SIMPLE_BASE_STRING_WIDETAG: +#ifdef SIMPLE_CHARACTER_STRING_WIDETAG + case SIMPLE_CHARACTER_STRING_WIDETAG: +#endif case SIMPLE_BIT_VECTOR_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG: @@ -912,6 +918,9 @@ ptrans_otherptr(lispobj thing, lispobj header, boolean constant) case COMPLEX_WIDETAG: case SIMPLE_ARRAY_WIDETAG: case COMPLEX_BASE_STRING_WIDETAG: +#ifdef COMPLEX_CHARACTER_STRING_WIDETAG + case COMPLEX_CHARACTER_STRING_WIDETAG: +#endif case COMPLEX_BIT_VECTOR_WIDETAG: case COMPLEX_VECTOR_NIL_WIDETAG: case COMPLEX_VECTOR_WIDETAG: @@ -931,6 +940,11 @@ ptrans_otherptr(lispobj thing, lispobj header, boolean constant) case SIMPLE_BASE_STRING_WIDETAG: return ptrans_vector(thing, 8, 1, 0, constant); +#ifdef SIMPLE_CHARACTER_STRING_WIDETAG + case SIMPLE_CHARACTER_STRING_WIDETAG: + return ptrans_vector(thing, 32, 1, 0, constant); +#endif + case SIMPLE_BIT_VECTOR_WIDETAG: return ptrans_vector(thing, 1, 0, 0, constant); @@ -1152,6 +1166,13 @@ pscav(lispobj *addr, int nwords, boolean constant) count = CEILING(NWORDS(fixnum_value(vector->length)+1,8)+2,2); break; +#ifdef SIMPLE_CHARACTER_STRING_WIDETAG + case SIMPLE_CHARACTER_STRING_WIDETAG: + vector = (struct vector *)addr; + count = CEILING(NWORDS(fixnum_value(vector->length)+1,32)+2,2); + break; +#endif + case SIMPLE_BIT_VECTOR_WIDETAG: vector = (struct vector *)addr; count = CEILING(NWORDS(fixnum_value(vector->length),1)+2,2); diff --git a/src/runtime/search.c b/src/runtime/search.c index 3f96bc3..1fb66b9 100644 --- a/src/runtime/search.c +++ b/src/runtime/search.c @@ -47,6 +47,8 @@ boolean search_for_symbol(char *name, lispobj **start, int *count) if (lowtag_of(symbol->name) == OTHER_POINTER_LOWTAG) { symbol_name = (struct vector *)native_pointer(symbol->name); if (is_valid_lisp_addr((os_vm_address_t)symbol_name) && + /* FIXME: Broken with more than one type of string + (i.e. even broken given (VECTOR NIL) */ widetag_of(symbol_name->header) == SIMPLE_BASE_STRING_WIDETAG && strcmp((char *)symbol_name->data, name) == 0) return 1; diff --git a/version.lisp-expr b/version.lisp-expr index 3a3df16..cfd340d 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.16.22" +"0.8.16.23" -- 1.7.10.4