Fix write barrier and roots problem with strings

db4
Slava Pestov 2008-04-13 09:20:19 -05:00
parent e6546e62e1
commit 0a5701d868
3 changed files with 41 additions and 8 deletions

View File

@ -1,5 +1,6 @@
USING: continuations kernel math namespaces strings sbufs USING: continuations kernel math namespaces strings
tools.test sequences vectors arrays ; strings.private sbufs tools.test sequences vectors arrays memory
prettyprint io.streams.null ;
IN: strings.tests IN: strings.tests
[ CHAR: b ] [ 1 >bignum "abc" nth ] unit-test [ CHAR: b ] [ 1 >bignum "abc" nth ] unit-test
@ -90,3 +91,28 @@ unit-test
"\udeadbe" clone "\udeadbe" clone
CHAR: \u123456 over clone set-first CHAR: \u123456 over clone set-first
] unit-test ] unit-test
! Regressions
[ ] [
[
4 [
100 [ drop "obdurak" ] map
gc
dup [
1234 0 rot set-string-nth
] each
1000 [
1000 f <array> drop
] times
.
] times
] with-null-stream
] unit-test
[ t ] [
10000 [
drop
300 100 CHAR: \u123456
[ <string> clone resize-string first ] keep =
] all?
] unit-test

View File

@ -1,6 +1,4 @@
#ifndef DEBUG CFLAGS = -fomit-frame-pointer
CFLAGS += -fomit-frame-pointer
#endif
EXE_SUFFIX = EXE_SUFFIX =
DLL_PREFIX = lib DLL_PREFIX = lib

View File

@ -50,6 +50,7 @@ F_WORD *allot_word(CELL vocab, CELL name)
word->counter = tag_fixnum(0); word->counter = tag_fixnum(0);
word->compiledp = F; word->compiledp = F;
word->profiling = NULL; word->profiling = NULL;
word->code = NULL;
REGISTER_UNTAGGED(word); REGISTER_UNTAGGED(word);
default_word_code(word,true); default_word_code(word,true);
@ -108,8 +109,11 @@ F_ARRAY *allot_array(CELL type, CELL capacity, CELL fill)
memset((void*)AREF(array,0),'\0',capacity * CELLS); memset((void*)AREF(array,0),'\0',capacity * CELLS);
else else
{ {
/* No need for write barrier here. Either the object is in
the nursery, or it was allocated directly in tenured space
and the write barrier is already hit for us in that case. */
for(i = 0; i < capacity; i++) for(i = 0; i < capacity; i++)
set_array_nth(array,i,fill); put(AREF(array,i),fill);
} }
return array; return array;
} }
@ -181,7 +185,7 @@ F_ARRAY *reallot_array(F_ARRAY* array, CELL capacity, CELL fill)
memcpy(new_array + 1,array + 1,to_copy * CELLS); memcpy(new_array + 1,array + 1,to_copy * CELLS);
for(i = to_copy; i < capacity; i++) for(i = to_copy; i < capacity; i++)
set_array_nth(new_array,i,fill); put(AREF(new_array,i),fill);
return new_array; return new_array;
} }
@ -222,6 +226,8 @@ F_ARRAY *growable_append(F_ARRAY *result, F_ARRAY *elts, CELL *result_count)
UNREGISTER_UNTAGGED(elts); UNREGISTER_UNTAGGED(elts);
write_barrier((CELL)result);
memcpy((void*)AREF(result,*result_count),(void*)AREF(elts,0),elts_size * CELLS); memcpy((void*)AREF(result,*result_count),(void*)AREF(elts,0),elts_size * CELLS);
*result_count += elts_size; *result_count += elts_size;
@ -467,6 +473,8 @@ void set_string_nth(F_STRING* string, CELL index, CELL value)
untag_fixnum_fast(string->length) untag_fixnum_fast(string->length)
* sizeof(u16)); * sizeof(u16));
UNREGISTER_UNTAGGED(string); UNREGISTER_UNTAGGED(string);
write_barrier((CELL)string);
string->aux = tag_object(aux); string->aux = tag_object(aux);
} }
} }
@ -549,10 +557,11 @@ F_STRING* reallot_string(F_STRING* string, CELL capacity, CELL fill)
REGISTER_UNTAGGED(string); REGISTER_UNTAGGED(string);
REGISTER_UNTAGGED(new_string); REGISTER_UNTAGGED(new_string);
F_BYTE_ARRAY *new_aux = allot_byte_array(capacity * sizeof(u16)); F_BYTE_ARRAY *new_aux = allot_byte_array(capacity * sizeof(u16));
new_string->aux = tag_object(new_aux);
UNREGISTER_UNTAGGED(new_string); UNREGISTER_UNTAGGED(new_string);
UNREGISTER_UNTAGGED(string); UNREGISTER_UNTAGGED(string);
new_string->aux = tag_object(new_aux);
F_BYTE_ARRAY *aux = untag_object(string->aux); F_BYTE_ARRAY *aux = untag_object(string->aux);
memcpy(new_aux + 1,aux + 1,to_copy * sizeof(u16)); memcpy(new_aux + 1,aux + 1,to_copy * sizeof(u16));
} }