From: Christophe R. <cr...@us...> - 2004-09-23 11:37:13
|
Update of /cvsroot/sbcl/sbcl/src/runtime In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv10478/src/runtime Modified Files: Tag: character_branch gc-common.c print.c purify.c Log Message: 0.8.13.77.character.27: "Go out and get some exercise, or you'll get flabby" Begin widening CHARACTER. ... x86 only, again; everything else will be broken. ... is IMUL really the most efficient way of shifting? Bah. ... a bundle of byte/word frobs (more to come: see below) Lots of things are broken at this point: not least the ability to run in a non-UTF-8 locale. There are lurking errors in various ANSI stream types, such as FILL-POINTER-STREAM; four contribs fail to build because of RUN-PROGRAM errors; SB-MD5 seems broken by design. Use this version at your own peril. Index: gc-common.c =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/gc-common.c,v retrieving revision 1.16.2.2 retrieving revision 1.16.2.3 diff -u -d -r1.16.2.2 -r1.16.2.3 --- gc-common.c 25 Aug 2004 20:26:27 -0000 1.16.2.2 +++ gc-common.c 23 Sep 2004 11:37:05 -0000 1.16.2.3 @@ -777,6 +777,56 @@ } 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; @@ -1547,7 +1597,7 @@ #endif scavtab[SIMPLE_ARRAY_WIDETAG] = scav_boxed; scavtab[SIMPLE_BASE_STRING_WIDETAG] = scav_base_string; - scavtab[SIMPLE_CHARACTER_STRING_WIDETAG] = scav_base_string; + scavtab[SIMPLE_CHARACTER_STRING_WIDETAG] = scav_character_string; scavtab[SIMPLE_BIT_VECTOR_WIDETAG] = scav_vector_bit; scavtab[SIMPLE_ARRAY_NIL_WIDETAG] = scav_vector_nil; scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] = @@ -1674,7 +1724,7 @@ #endif transother[SIMPLE_ARRAY_WIDETAG] = trans_boxed; /* but not GENCGC */ transother[SIMPLE_BASE_STRING_WIDETAG] = trans_base_string; - transother[SIMPLE_CHARACTER_STRING_WIDETAG] = trans_base_string; + transother[SIMPLE_CHARACTER_STRING_WIDETAG] = trans_character_string; transother[SIMPLE_BIT_VECTOR_WIDETAG] = trans_vector_bit; transother[SIMPLE_VECTOR_WIDETAG] = trans_vector; transother[SIMPLE_ARRAY_NIL_WIDETAG] = trans_vector_nil; @@ -1806,7 +1856,7 @@ #endif sizetab[SIMPLE_ARRAY_WIDETAG] = size_boxed; sizetab[SIMPLE_BASE_STRING_WIDETAG] = size_base_string; - sizetab[SIMPLE_CHARACTER_STRING_WIDETAG] = size_base_string; + sizetab[SIMPLE_CHARACTER_STRING_WIDETAG] = size_character_string; sizetab[SIMPLE_BIT_VECTOR_WIDETAG] = size_vector_bit; sizetab[SIMPLE_VECTOR_WIDETAG] = size_vector; sizetab[SIMPLE_ARRAY_NIL_WIDETAG] = size_vector_nil; Index: print.c =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/print.c,v retrieving revision 1.18.2.2 retrieving revision 1.18.2.3 diff -u -d -r1.18.2.2 -r1.18.2.3 --- print.c 25 Aug 2004 20:26:27 -0000 1.18.2.2 +++ print.c 23 Sep 2004 11:37:05 -0000 1.18.2.3 @@ -536,7 +536,7 @@ #endif case SIMPLE_BASE_STRING_WIDETAG: - case SIMPLE_CHARACTER_STRING_WIDETAG: + case SIMPLE_CHARACTER_STRING_WIDETAG: /* FIXME */ NEWLINE_OR_RETURN; cptr = (char *)(ptr+1); putchar('"'); Index: purify.c =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/purify.c,v retrieving revision 1.41.2.2 retrieving revision 1.41.2.3 diff -u -d -r1.41.2.2 -r1.41.2.3 --- purify.c 25 Aug 2004 20:26:27 -0000 1.41.2.2 +++ purify.c 23 Sep 2004 11:37:05 -0000 1.41.2.3 @@ -934,7 +934,7 @@ return ptrans_vector(thing, 8, 1, 0, constant); case SIMPLE_CHARACTER_STRING_WIDETAG: - return ptrans_vector(thing, 8, 1, 0, constant); + return ptrans_vector(thing, 32, 1, 0, constant); case SIMPLE_BIT_VECTOR_WIDETAG: return ptrans_vector(thing, 1, 0, 0, constant); @@ -1159,7 +1159,7 @@ case SIMPLE_CHARACTER_STRING_WIDETAG: vector = (struct vector *)addr; - count = CEILING(NWORDS(fixnum_value(vector->length)+1,8)+2,2); + count = CEILING(NWORDS(fixnum_value(vector->length)+1,32)+2,2); break; case SIMPLE_BIT_VECTOR_WIDETAG: |