0.8.16.23:

	Merge in character_branch runtime changes, protected by #ifdefs

	This patch brought to you by character_branch

diff --git a/src/runtime/backtrace.c b/src/runtime/backtrace.c
index e10af61..83a457f 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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"