[Sbcl-commits] CVS: sbcl/src/runtime gc-common.c,1.16.2.2,1.16.2.3 print.c,1.18.2.2,1.18.2.3 purify.c,1.41.2.2,1.41.2.3

[Christophe R. <cr...@us...>]

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: