Index: core.ops =================================================================== RCS file: /home/perlcvs/parrot/core.ops,v retrieving revision 1.134 diff -u -r1.134 core.ops --- core.ops 5 May 2002 04:46:47 -0000 1.134 +++ core.ops 6 May 2002 08:33:08 -0000 @@ -172,9 +172,9 @@ } $1 = string_make(interpreter, NULL, 65535, NULL, 0, NULL); - memset(($1)->bufstart, 0, 65535); - fgets(($1)->bufstart, 65534, file); - ($1)->strlen = ($1)->bufused = strlen(($1)->bufstart); + memset(($1)->strstart, 0, 65535); + fgets(($1)->strstart, 65534, file); + ($1)->strlen = ($1)->bufused = strlen(($1)->strstart); goto NEXT(); } @@ -361,7 +361,7 @@ string_destroy($1); s = string_make(interpreter, NULL, len, NULL, 0, NULL); - read($2, s->bufstart, len); + read($2, s->strstart, len); s->bufused = len; $1 = s; goto NEXT(); @@ -425,7 +425,7 @@ op write(in INT, in STR) { STRING * s = $2; UINTVAL count = string_length(s); - write($1, s->bufstart, count); + write($1, s->strstart, count); goto NEXT(); } @@ -1712,7 +1712,7 @@ =cut inline op concat(inout STR, in STR) { - $1 = string_concat(interpreter, $1, $2, 1); + $1 = string_append(interpreter, $1, $2); goto NEXT(); } @@ -2884,6 +2884,8 @@ case STRINGINFO_BUFUSED: $1 = $2->bufused; break; case STRINGINFO_STRLEN: $1 = $2->strlen; + break; + case STRINGINFO_STRSTART: $1 = (UINTVAL)$2->strstart; break; } goto NEXT(); Index: io.ops =================================================================== RCS file: /home/perlcvs/parrot/io.ops,v retrieving revision 1.8 diff -u -r1.8 io.ops --- io.ops 5 May 2002 04:02:59 -0000 1.8 +++ io.ops 6 May 2002 08:33:14 -0000 @@ -77,7 +77,7 @@ ParrotIO * io; io = (ParrotIO*)($1->data); if ($2 && io) { - PIO_write(interpreter, io, ($2)->bufstart, string_length($2)); + PIO_write(interpreter, io, ($2)->strstart, string_length($2)); } goto NEXT(); } @@ -92,7 +92,7 @@ op printerr(in STR) { if ($1) { - PIO_write(interpreter, PIO_STDERR(interpreter), ($1)->bufstart, + PIO_write(interpreter, PIO_STDERR(interpreter), ($1)->strstart, string_length($1)); } goto NEXT(); @@ -115,7 +115,7 @@ op puts(in STR) { if (($1) && string_length($1)) { - PIO_write(interpreter, PIO_STDOUT(interpreter), ($1)->bufstart, + PIO_write(interpreter, PIO_STDOUT(interpreter), ($1)->strstart, string_length($1)); } goto NEXT(); @@ -124,7 +124,7 @@ op puts(in INT) { STRING * s = string_from_int(interpreter, $1); if (string_length(s)) { - PIO_write(interpreter, PIO_STDOUT(interpreter), s->bufstart, + PIO_write(interpreter, PIO_STDOUT(interpreter), s->strstart, string_length(s)); } goto NEXT(); @@ -133,7 +133,7 @@ op puts(in NUM) { STRING * s = Parrot_sprintf_c(interpreter, "%Vf", $1); if (string_length(s)) { - PIO_write(interpreter, PIO_STDOUT(interpreter), s->bufstart, + PIO_write(interpreter, PIO_STDOUT(interpreter), s->strstart, string_length(s)); } goto NEXT(); @@ -165,8 +165,8 @@ else n = $2; $1 = string_make(interpreter, NULL, n, NULL, 0, NULL); - memset(($1)->bufstart, 0, n); - nr = PIO_read(interpreter, PIO_STDIN(interpreter), ($1)->bufstart, (size_t)n); + memset(($1)->strstart, 0, n); + nr = PIO_read(interpreter, PIO_STDIN(interpreter), ($1)->strstart, (size_t)n); if(nr > 0) ($1)->strlen = ($1)->bufused = nr; else @@ -182,8 +182,8 @@ else n = $3; $1 = string_make(interpreter, NULL, n, NULL, 0, NULL); - memset(($1)->bufstart, 0, n); - nr = PIO_read(interpreter, (ParrotIO*)($2->data), ($1)->bufstart, (size_t)n); + memset(($1)->strstart, 0, n); + nr = PIO_read(interpreter, (ParrotIO*)($2->data), ($1)->strstart, (size_t)n); if(nr > 0) ($1)->strlen = ($1)->bufused = nr; else Index: key.c =================================================================== RCS file: /home/perlcvs/parrot/key.c,v retrieving revision 1.24 diff -u -r1.24 key.c --- key.c 2 Apr 2002 20:35:52 -0000 1.24 +++ key.c 6 May 2002 08:33:23 -0000 @@ -99,7 +99,7 @@ static INTVAL key_hash(struct Parrot_Interp *interpreter, STRING *value) { - char *buffptr = value->bufstart; + char *buffptr = value->strstart; INTVAL len = value->bufused; INTVAL hash = 5893; Index: misc.c =================================================================== RCS file: /home/perlcvs/parrot/misc.c,v retrieving revision 1.20 diff -u -r1.20 misc.c --- misc.c 30 Mar 2002 03:04:37 -0000 1.20 +++ misc.c 6 May 2002 08:33:34 -0000 @@ -495,7 +495,7 @@ STRING *ret = Parrot_vsprintf_c(interpreter, pat, args); /* string_transcode(interpreter, ret, NULL, NULL, &ret);*/ - memcpy(targ, ret->bufstart, ret->bufused); + memcpy(targ, ret->strstart, ret->bufused); targ[ret->bufused + 1] = 00; } @@ -510,7 +510,7 @@ len = ret->bufused; } - memcpy(targ, ret->bufstart, len); + memcpy(targ, ret->strstart, len); targ[len + 1] = 0; } Index: resources.c =================================================================== RCS file: /home/perlcvs/parrot/resources.c,v retrieving revision 1.53 diff -u -r1.53 resources.c --- resources.c 6 May 2002 04:18:00 -0000 1.53 +++ resources.c 6 May 2002 08:33:58 -0000 @@ -298,8 +298,9 @@ cur_arena = cur_arena->prev) { Buffer *b = cur_arena->start_Buffer; for (i = 0; i < cur_arena->used; i++) { - /* Tentatively unused, unless it's a constant */ - if (!(b->flags & BUFFER_constant_FLAG)) { + /* Tentatively unused, unless it's a (non-COW) constant */ + if (!(b->flags & BUFFER_constant_FLAG) + || b->flags & BUFFER_COW_FLAG) { b->flags &= ~BUFFER_live_FLAG; } b = (Buffer *)((char *)b + pool->unit_size); @@ -814,11 +815,32 @@ && !(s->flags & BUFFER_immobile_FLAG) && !(s->flags & BUFFER_constant_FLAG) && s->bufstart) { - memcpy(cur_spot, s->bufstart, s->buflen); - s->bufstart = cur_spot; - cur_size = s->buflen; - cur_size = (cur_size + pool->align_1) & ~pool->align_1; - cur_spot += cur_size; + struct String_Tail *tail = + (struct String_Tail *)((char *)s->bufstart + s->buflen); + UINTVAL offset = (char *)s->strstart - (char *)s->bufstart; + if (s->flags & BUFFER_COW_FLAG + && tail->flags & STRING_moved_FLAG) { + /* buffer has already been moved; just change the header */ + STRING* hdr = *(STRING **)(s->bufstart); + hdr->flags |= BUFFER_COW_FLAG; + s->bufstart = hdr->bufstart; + s->strstart = (char *)(s->bufstart) + offset; + } + else { + memcpy(cur_spot, s->bufstart, + s->buflen + sizeof(struct String_Tail)); + if (s->flags & BUFFER_COW_FLAG) { + /* store new address and set 'moved' flag */ + *(STRING **)(s->bufstart) = s; + s->flags &= ~BUFFER_COW_FLAG; + tail->flags |= STRING_moved_FLAG; + } + s->bufstart = cur_spot; + s->strstart = (char *)(s->bufstart) + offset; + cur_size = s->buflen + sizeof(struct String_Tail); + cur_size = (cur_size + pool->align_1) & ~pool->align_1; + cur_spot += cur_size; + } } s++; } @@ -975,33 +997,45 @@ } /* Takes an interpreter, a STRING pointer, and a new size. - * The destination may be bigger, since we round up to the allocation quantum */ + * The destination may be bigger, since we round up to the allocation quantum + * Non-constant strings get an extra tail used for COW GC */ void * Parrot_reallocate_string(struct Parrot_Interp *interpreter, STRING *str, - size_t tosize) + size_t tosize, UINTVAL new_flags) { size_t copysize; - size_t alloc_size = tosize; + size_t req_size = tosize; void *mem; struct Memory_Pool *pool; copysize = (str->buflen > tosize ? tosize : str->buflen); - pool = (str->flags & BUFFER_constant_FLAG) - ? interpreter->arena_base->constant_string_pool - : interpreter->arena_base->string_pool; - - mem = mem_allocate(interpreter, &alloc_size, pool); - if (!mem) { - return NULL; + if (new_flags & BUFFER_constant_FLAG) { + mem = mem_allocate(interpreter, &req_size, + interpreter->arena_base->constant_string_pool); + if (!mem) { + return NULL; + } + str->buflen = req_size; } - /* We shouldn't ever have a 0 from size, but we do. If we can - * track down those bugs, this can be removed which would make - * things cheaper */ + else { + if (req_size < sizeof(void *)) { + req_size = sizeof(void *); + } + req_size += sizeof(struct String_Tail); + mem = mem_allocate(interpreter, &req_size, + interpreter->arena_base->string_pool); + if (!mem) { + return NULL; + } + str->buflen = req_size - sizeof(struct String_Tail); + ((struct String_Tail *)((char *)mem + str->buflen))->flags = 0; + } + if (copysize) { memcpy(mem, str->bufstart, copysize); } str->bufstart = mem; - str->buflen = alloc_size; + str->flags = new_flags; return mem; } @@ -1019,27 +1053,46 @@ } /* Allocate at least as much memory as they asked for. We round the - * amount up to the allocation quantum */ + * amount up to the allocation quantum + * Non-constant strings get an extra tail used for COW GC */ void * Parrot_allocate_string(struct Parrot_Interp *interpreter, STRING *str, size_t size) { size_t req_size = size; - struct Memory_Pool *pool; str->buflen = 0; str->bufstart = NULL; if (!interpreter) { str->bufstart = mem_allocate(NULL, &req_size, NULL); + str->buflen = req_size; + } + else if (str->flags & BUFFER_constant_FLAG) { + str->bufstart = mem_allocate(interpreter, &req_size, + interpreter->arena_base->constant_string_pool); + if (!str->bufstart) { + return NULL; + } + str->buflen = req_size; } else { - pool = (str->flags & BUFFER_constant_FLAG) - ? interpreter->arena_base->constant_string_pool - : interpreter->arena_base->string_pool; - str->bufstart = mem_allocate(interpreter, &req_size, pool); + /* COW GC requires a minimum size of a pointer... */ + if (req_size < sizeof(void *)) { + req_size = sizeof(void *); + } + /* ... and an extra tail... */ + req_size += sizeof(struct String_Tail); + str->bufstart = mem_allocate(interpreter, &req_size, + interpreter->arena_base->string_pool); + if (!str->bufstart) { + return NULL; + } + /* ... not included in the available buffer length */ + str->buflen = req_size - sizeof(struct String_Tail); + ((struct String_Tail *)((char *)str->bufstart + str->buflen))->flags = + 0; } - str->buflen = req_size; return str; } Index: include/parrot/resources.h =================================================================== RCS file: /home/perlcvs/parrot/include/parrot/resources.h,v retrieving revision 1.29 diff -u -r1.29 resources.h --- include/parrot/resources.h 4 May 2002 22:27:45 -0000 1.29 +++ include/parrot/resources.h 6 May 2002 08:34:46 -0000 @@ -39,12 +39,6 @@ Buffer *new_buffer_header(struct Parrot_Interp *); void free_buffer(Buffer *); -void *new_bigint_header(struct Parrot_Interp *); -void free_bigint(void); - -void *new_bignum_header(struct Parrot_Interp *); -void free_bignum(void); - void *Parrot_allocate(struct Parrot_Interp *, void *, size_t size); void *Parrot_allocate_string(struct Parrot_Interp *, STRING *, size_t size); @@ -52,9 +46,11 @@ void Parrot_go_collect(struct Parrot_Interp *); void *Parrot_reallocate(struct Parrot_Interp *interpreter, void *from, size_t tosize); -void *Parrot_reallocate_string(struct Parrot_Interp *interpreter, STRING *, size_t tosize); +void *Parrot_reallocate_string(struct Parrot_Interp *interpreter, + STRING *, size_t tosize, UINTVAL new_flags); void buffer_lives(Buffer *); +PMC * mark_used(PMC *used_pmc, PMC *current_end_of_list); void Parrot_initialize_resource_pools(struct Parrot_Interp *); void Parrot_initialize_memory_pools(struct Parrot_Interp *); Index: string.c =================================================================== RCS file: /home/perlcvs/parrot/string.c,v retrieving revision 1.75 diff -u -r1.75 string.c --- string.c 5 May 2002 04:02:59 -0000 1.75 +++ string.c 6 May 2002 08:34:17 -0000 @@ -50,9 +50,10 @@ Parrot_allocate_string(interpreter, s, buflen); s->encoding = encoding; s->type = type; + s->strstart = s->bufstart; if (buffer) { - mem_sys_memcopy(s->bufstart, buffer, buflen); + mem_sys_memcopy(s->strstart, buffer, buflen); s->bufused = buflen; (void)string_compute_strlen(s); } @@ -68,11 +69,28 @@ */ STRING * string_grow(struct Parrot_Interp * interpreter, STRING * s, INTVAL addlen) { - /* Don't check buflen, if we are here, we already checked. */ - Parrot_reallocate_string(interpreter, s, s->buflen + addlen); + UINTVAL offset = (char *)s->strstart - (char *)s->bufstart; + UINTVAL new_flags = s->flags; + if (s->flags & BUFFER_constant_FLAG && s->flags & BUFFER_COW_FLAG) { + new_flags &= ~BUFFER_constant_FLAG; + } + Parrot_reallocate_string(interpreter, s, s->buflen + addlen, new_flags); + s->strstart = (char *)s->bufstart + offset; + s->flags &= ~BUFFER_COW_FLAG; return s; } +static void +copy_on_write(struct Parrot_Interp *interpreter, STRING *s) +{ + UINTVAL offset = (char *)s->strstart - (char *)s->bufstart; + UINTVAL new_flags = s->flags & ~(UINTVAL)BUFFER_constant_FLAG; + Parrot_reallocate_string(interpreter, s, s->buflen, new_flags); + s->strstart = (char *)s->bufstart + offset; + s->flags &= ~BUFFER_COW_FLAG; +} + + /*=for api string string_destroy * free the string's memory */ @@ -102,7 +120,7 @@ INTVAL string_index(const STRING *s, UINTVAL idx) { - return s->encoding->decode(s->encoding->skip_forward(s->bufstart, idx)); + return s->encoding->decode(s->encoding->skip_forward(s->strstart, idx)); } /*=for api string string_ord @@ -146,24 +164,46 @@ return -1; } +/* clone a string header without allocating a new buffer + * i.e. create a 'copy-on-write' string + */ +static STRING * +clone_header(struct Parrot_Interp *interpreter, const STRING *s) +{ + STRING *d; + if (s->flags & BUFFER_constant_FLAG) { + d = new_string_header(interpreter, + s->flags & ~(UINTVAL)BUFFER_constant_FLAG); + memcpy(d, s, sizeof (STRING)); + d->flags |= BUFFER_COW_FLAG; + } + else { + d = new_string_header(interpreter, s->flags); + s->flags |= BUFFER_COW_FLAG; + memcpy(d, s, sizeof (STRING)); + } + return d; +} + /*=for api string string_copy * create a copy of the argument passed in */ STRING * string_copy(struct Parrot_Interp *interpreter, const STRING *s) { - STRING *d; - d = new_string_header(interpreter, s->flags & ~BUFFER_constant_FLAG); - Parrot_allocate_string(interpreter, d, s->buflen); - d->bufused = s->bufused; - d->strlen = s->strlen; - d->encoding = s->encoding; - d->type = s->type; - d->language = s->language; - - memcpy(d->bufstart, s->bufstart, s->buflen); + return clone_header(interpreter, s); +} - return d; +INLINE static UINTVAL +free_space(const STRING *s) +{ + if (s->flags & BUFFER_constant_FLAG || s->flags & BUFFER_COW_FLAG) { + return 0; + } + else { + return (((char *)s->bufstart + s->buflen) + - ((char *)s->strstart + s->bufused)); + } } /*=for api string string_transcode @@ -214,9 +254,9 @@ } } - srcstart = (void *)src->bufstart; + srcstart = (void *)src->strstart; srcend = srcstart + src->bufused; - deststart = dest->bufstart; + deststart = dest->strstart; destend = deststart; while (srcstart < srcend) { @@ -250,7 +290,7 @@ INTVAL string_compute_strlen(STRING *s) { - s->strlen = s->encoding->characters(s->bufstart, s->bufused); + s->strlen = s->encoding->characters(s->strstart, s->bufused); return s->strlen; } @@ -275,9 +315,9 @@ } result = string_make(interpreter, NULL, a->bufused + b->bufused, a->encoding, 0, a->type); - mem_sys_memcopy(result->bufstart, a->bufstart, a->bufused); - mem_sys_memcopy((void *)((ptrcast_t)result->bufstart + a->bufused), - b->bufstart, b->bufused); + mem_sys_memcopy(result->strstart, a->strstart, a->bufused); + mem_sys_memcopy((void *)((ptrcast_t)result->strstart + a->bufused), + b->strstart, b->bufused); result->strlen = a->strlen + b->strlen; result->bufused = a->bufused + b->bufused; } @@ -302,6 +342,38 @@ return result; } +/*=for api string string_append + * append string2 onto the end of string1 + */ +STRING * +string_append(struct Parrot_Interp *interpreter, STRING *a, const STRING *b) +{ + if (b == NULL || b->bufused == 0) { + return a; + } + + if (a == NULL) { + return string_copy(interpreter, b); + } + + /* transcode b first so we know the actual length required */ + if (a->type != b->type || a->encoding != b->encoding) { + b = string_transcode(interpreter, b, a->encoding, a->type, + NULL); + } + + /* grow the buffer if it is too small */ + if (free_space(a) < b->bufused) { + string_grow(interpreter, a, (INTVAL)(b->bufused - free_space(a))); + } + + mem_sys_memcopy((char *)a->strstart + a->bufused, b->strstart, b->bufused); + a->strlen += b->strlen; + a->bufused += b->bufused; + return a; +} + + /*=for api string string_repeat * repeat the string I I times, storing result in I. * Allocates I if needed, also returns d. @@ -321,8 +393,8 @@ /* copy s into dest num times */ for (i = 0; i < num; i++) { - mem_sys_memcopy((void *)((ptrcast_t)dest->bufstart + s->bufused * i), - s->bufstart, s->bufused); + mem_sys_memcopy((void *)((ptrcast_t)dest->strstart + s->bufused * i), + s->strstart, s->bufused); } dest->bufused = s->bufused * num; @@ -357,7 +429,6 @@ return string_make(interpreter, NULL, 0, src->encoding, 0, src->type); } - true_length = (UINTVAL)length; if (offset < 0) { true_offset = (UINTVAL)(src->strlen + offset); } @@ -366,30 +437,41 @@ internal_exception(SUBSTR_OUT_OF_STRING, "Cannot take substr outside string"); } + + true_length = (UINTVAL)length; if (true_length > (src->strlen - true_offset)) { true_length = (UINTVAL)(src->strlen - true_offset); } - substart_off = (const char *)src->encoding->skip_forward(src->bufstart, + substart_off = (const char *)src->encoding->skip_forward(src->strstart, true_offset) - - (char *)src->bufstart; + (char *)src->strstart; subend_off = - (const char *)src->encoding->skip_forward((char *)src->bufstart + + (const char *)src->encoding->skip_forward((char *)src->strstart + substart_off, true_length) - - (char *)src->bufstart; - - dest = - string_make(interpreter, NULL, true_length * src->encoding->max_bytes, - src->encoding, 0, src->type); + (char *)src->strstart; if (subend_off < substart_off) { internal_exception(SUBSTR_OUT_OF_STRING, "subend somehow is less than substart"); } - mem_sys_memcopy(dest->bufstart, (char *)src->bufstart + substart_off, - (unsigned)(subend_off - substart_off)); + /* do in-place if possible */ +/* + if (!(src->flags & BUFFER_constant_FLAG)) { +*/ + dest = clone_header(interpreter, src); + dest->strstart = (char *)dest->strstart + substart_off; +/* + } + else { + dest = string_make(interpreter, NULL, subend_off - substart_off, + src->encoding, 0, src->type); + mem_sys_memcopy(dest->strstart, (char *)src->strstart + substart_off, + (unsigned)(subend_off - substart_off)); + } +*/ dest->bufused = subend_off - substart_off; dest->strlen = true_length; @@ -421,6 +503,10 @@ UINTVAL true_offset; UINTVAL true_length; INTVAL diff; + + if (src->flags & BUFFER_COW_FLAG) { + copy_on_write(interpreter, src); + } true_offset = (UINTVAL)offset; true_length = (UINTVAL)length; @@ -446,14 +532,14 @@ } /* Save the substring that is replaced for the return value */ - substart_off = (char *)src->encoding->skip_forward(src->bufstart, + substart_off = (const char *)src->encoding->skip_forward(src->strstart, true_offset) - - (char *)src->bufstart; + (char *)src->strstart; subend_off = - (char *)src->encoding->skip_forward((char *)src->bufstart + + (const char *)src->encoding->skip_forward((char *)src->strstart + substart_off, true_length) - - (char *)src->bufstart; + (char *)src->strstart; if (subend_off < substart_off) { internal_exception(SUBSTR_OUT_OF_STRING, @@ -464,7 +550,7 @@ string_make(interpreter, NULL, true_length * src->encoding->max_bytes, src->encoding, 0, src->type); - mem_sys_memcopy(dest->bufstart, (char *)src->bufstart + substart_off, + mem_sys_memcopy(dest->strstart, (char *)src->strstart + substart_off, (unsigned)(subend_off - substart_off)); dest->bufused = subend_off - substart_off; dest->strlen = true_length; @@ -485,14 +571,14 @@ || ((INTVAL)src->bufused - (INTVAL)src->buflen) <= diff) { if(diff != 0) { - mem_sys_memmove((char*)src->bufstart + substart_off + rep->bufused, - (char*)src->bufstart + subend_off, + mem_sys_memmove((char*)src->strstart + substart_off + rep->bufused, + (char*)src->strstart + subend_off, src->buflen - (subend_off - diff)); src->bufused -= diff; } - mem_sys_memcopy((char*)src->bufstart + substart_off, - rep->bufstart, rep->bufused); + mem_sys_memcopy((char*)src->strstart + substart_off, + rep->strstart, rep->bufused); if(diff != 0) (void)string_compute_strlen(src); } @@ -505,11 +591,11 @@ string_grow(interpreter, src, diff); /* Move the end of old string that isn't replaced to new offset first */ - mem_sys_memmove((char*)src->bufstart + subend_off + diff, - (char*)src->bufstart + subend_off, + mem_sys_memmove((char*)src->strstart + subend_off + diff, + (char*)src->strstart + subend_off, src->buflen - subend_off); /* Copy the replacement in */ - mem_sys_memcopy((char *)src->bufstart + substart_off, rep->bufstart, + mem_sys_memcopy((char *)src->strstart + substart_off, rep->strstart, rep->bufused); src->bufused += diff; (void)string_compute_strlen(src); @@ -525,7 +611,7 @@ STRING * string_chopn(STRING *s, INTVAL n) { - const char *bufstart = s->bufstart; + const char *bufstart = s->strstart; const char *bufend = bufstart + s->bufused; UINTVAL true_n; @@ -575,9 +661,9 @@ NULL); } - s1start = s1->bufstart; + s1start = s1->strstart; s1end = s1start + s1->bufused; - s2start = s2->bufstart; + s2start = s2->strstart; s2end = s2start + s2->bufused; while (cmp == 0 && s1start < s1end && s2start < s2end) { @@ -614,7 +700,7 @@ } if (len == 1) { - UINTVAL c = s->encoding->decode(s->bufstart); + UINTVAL c = s->encoding->decode(s->strstart); if (s->type->is_digit(c) && s->type->get_digit(c) == 0) { return 0; } @@ -642,7 +728,7 @@ INTVAL i = 0; if (s) { - const char *start = s->bufstart; + const char *start = s->strstart; const char *end = start + s->bufused; int sign = 1; BOOLVAL in_number = 0; @@ -682,7 +768,7 @@ FLOATVAL f = 0.0; if (s) { - const char *start = s->bufstart; + const char *start = s->strstart; const char *end = start + s->bufused; int sign = 1; BOOLVAL seen_dot = 0; @@ -792,10 +878,11 @@ { char *cstring; - if (s->buflen == s->bufused) + if (s->buflen == s->bufused || s->flags & BUFFER_COW_FLAG) { string_grow(interpreter, s, 1); + } - cstring = s->bufstart; + cstring = s->strstart; cstring[s->bufused] = 0; Index: include/parrot/string_funcs.h =================================================================== RCS file: /home/perlcvs/parrot/include/parrot/string_funcs.h,v retrieving revision 1.7 diff -u -r1.7 string_funcs.h --- include/parrot/string_funcs.h 14 Apr 2002 18:54:29 -0000 1.7 +++ include/parrot/string_funcs.h 6 May 2002 08:34:58 -0000 @@ -19,6 +19,7 @@ INTVAL Parrot_string_compute_strlen(STRING *); STRING *Parrot_string_concat(Parrot, const STRING *, const STRING *, UINTVAL); +STRING *Parrot_string_append(Parrot, STRING *, const STRING *); STRING *Parrot_string_repeat(Parrot, const STRING *, UINTVAL, STRING **); STRING *Parrot_string_chopn(STRING *, INTVAL); STRING *Parrot_string_substr(Parrot, const STRING *, INTVAL, @@ -52,6 +53,7 @@ #define string_compute_strlen Parrot_string_compute_strlen #define string_concat Parrot_string_concat +#define string_append Parrot_string_append #define string_repeat Parrot_string_repeat #define string_chopn Parrot_string_chopn #define string_substr Parrot_string_substr Index: include/parrot/string.h =================================================================== RCS file: /home/perlcvs/parrot/include/parrot/string.h,v retrieving revision 1.37 diff -u -r1.37 string.h --- include/parrot/string.h 5 May 2002 04:03:08 -0000 1.37 +++ include/parrot/string.h 6 May 2002 08:34:52 -0000 @@ -18,14 +18,15 @@ #include "parrot/chartype.h" struct parrot_string_t { - void *bufstart; - UINTVAL buflen; + void *bufstart; /* start of buffer */ + UINTVAL buflen; /* buffer length excluding tail */ UINTVAL flags; - UINTVAL bufused; - UINTVAL strlen; + UINTVAL bufused; /* bytes used by this specific (sub)string */ + UINTVAL strlen; /* codepoints in this (sub)string */ const ENCODING *encoding; const CHARTYPE *type; INTVAL language; + void *strstart; /* start of actual (sub)string data */ }; #define Parrot_String struct parrot_string_t * @@ -41,6 +42,12 @@ UINTVAL flags; } Buffer; +/* Tail added to end of string buffers; used for COW GC */ +struct String_Tail { + unsigned char flags; +}; +#define STRING_moved_FLAG 1 << 0 + typedef struct parrot_string_t String; /* Buffer flags */ @@ -80,14 +87,7 @@ #define STRINGINFO_FLAGS 4 #define STRINGINFO_BUFUSED 5 #define STRINGINFO_STRLEN 6 - -/* stringinfo parameters */ -#define STRINGINFO_HEADER 1 -#define STRINGINFO_BUFSTART 2 -#define STRINGINFO_BUFLEN 3 -#define STRINGINFO_FLAGS 4 -#define STRINGINFO_BUFUSED 5 -#define STRINGINFO_STRLEN 6 +#define STRINGINFO_STRSTART 7 #define STRING struct parrot_string_t Index: t/op/string.t =================================================================== RCS file: /home/perlcvs/parrot/t/op/string.t,v retrieving revision 1.22 diff -u -r1.22 string.t --- t/op/string.t 23 Apr 2002 20:24:23 -0000 1.22 +++ t/op/string.t 6 May 2002 08:35:08 -0000 @@ -1,6 +1,6 @@ #! perl -w -use Parrot::Test tests => 77; +use Parrot::Test tests => 79; output_is( <<'CODE', <" + set S2, "" + concat S2, S2, S0 + concat S2, S2, S1 + print S2 + print "\n" + substr S0, S2, 1, 4 + print S0 + print "\n" + end +CODE + +JAPH +OUTPUT + +output_is( <<'CODE', <code->const_table-> - constants[*(pc + i)]->string->bufstart); + constants[*(pc + i)]->string->strstart); break; case PARROT_ARG_I: fprintf(stderr, "I%ld=%ld", (long)*(pc + i), @@ -67,7 +67,7 @@ if (interpreter->string_reg.registers[*(pc + i)]) { fprintf(stderr, "S%ld=\"%s\"", (long)*(pc + i), (char *)interpreter->string_reg. - registers[*(pc + i)]->bufstart); + registers[*(pc + i)]->strstart); } else { fprintf(stderr, "S%ld=(null)", (long)*(pc + i)); Index: warnings.c =================================================================== RCS file: /home/perlcvs/parrot/warnings.c,v retrieving revision 1.6 diff -u -r1.6 warnings.c --- warnings.c 28 Mar 2002 08:02:02 -0000 1.6 +++ warnings.c 6 May 2002 08:34:39 -0000 @@ -31,7 +31,7 @@ } if (PIO_write - (interpreter, PIO_STDERR(interpreter), targ->bufstart, + (interpreter, PIO_STDERR(interpreter), targ->strstart, targ->bufused) < 0) { return -2; } @@ -69,7 +69,7 @@ } if (PIO_write - (interpreter, PIO_STDERR(interpreter), targ->bufstart, + (interpreter, PIO_STDERR(interpreter), targ->strstart, targ->bufused) < 0) { return -2; }