This patch (not quite for application) builds on yesterday's free list
de-sucking patch. It sets the "Hey, I'm free!" flag on all objects on the
free list, then adds assertions to the PMC_IS_NULL() and saneify_string()
macros to make sure that neither use free PMCs.
Parrot's test suite passes with this patch, but it breaks Tcl further. The
good news is that it might get us a step closer to figuring out *what* is
broken in Tcl.
(Perl 6 and PGE both work just fine with the patch.)
Many of Tcl's tests fail due to what looks still to be the interaction of HLL
information in constant strings and copy on write:
t/cmd_unset....................src/string.c:131: failed
assertion '!PObj_on_free_list_TEST(s)'
Backtrace - Obtained 25 stack frames (max trace depth is 32).
(unknown)
Parrot_confess
Parrot_make_COW_reference
Parrot_String_get_string
Parrot_get_HLL_id
Parrot_register_HLL
yyparse
Yippee. I note that Tcl is probably the only language actually *using*
the .HLL directive right now too, which paints a huge target on its back.
-- c
=== include/parrot/interpreter.h
==================================================================
--- include/parrot/interpreter.h (revision 5100)
+++ include/parrot/interpreter.h (local)
@@ -452,7 +452,9 @@
#if PARROT_CATCH_NULL
PARROT_API extern PMC * PMCNULL; /* Holds single Null PMC */
-# define PMC_IS_NULL(p) ((p) == PMCNULL || (p) == NULL)
+# define PMC_IS_NULL(p) \
+ (assert( (p) ? !PObj_on_free_list_TEST((p)) : 1), \
+ ((p) == PMCNULL || (p) == NULL))
#else
# define PMCNULL ((PMC *)NULL)
# define PMC_IS_NULL(p) ((p) == PMCNULL)
=== src/gc/smallobject.c
==================================================================
--- src/gc/smallobject.c (revision 5100)
+++ src/gc/smallobject.c (local)
@@ -154,6 +154,7 @@
{
PMC_struct_val(to_add) = pool->free_list;
pool->free_list = to_add;
+ PObj_on_free_list_SET(to_add);
}
/*
@@ -180,6 +181,7 @@
ptr = free_list;
pool->free_list = PMC_struct_val(ptr);
+ PObj_on_free_list_CLEAR(ptr);
PObj_flags_SETTO(ptr, 0);
=== src/string.c
==================================================================
--- src/string.c (revision 5100)
+++ src/string.c (local)
@@ -74,6 +74,7 @@
Parrot_unmake_COW(PARROT_INTERP, NOTNULL(STRING *s))
{
PARROT_ASSERT(s);
+ saneify_string(s);
/* COW_FLAG | constant_FLAG | external_FLAG) */
if (PObj_is_cowed_TESTALL(s)) {
@@ -127,6 +128,7 @@
STRING *d;
PARROT_ASSERT(s);
+ saneify_string(s);
if (PObj_constant_TEST(s)) {
d = new_string_header(interp, PObj_get_FLAGS(s) & ~PObj_constant_FLAG);
@@ -176,6 +178,8 @@
Parrot_reuse_COW_reference(SHIM_INTERP, NOTNULL(STRING *s), NOTNULL(STRING *d))
{
PARROT_ASSERT(s);
+ saneify_string(s);
+ saneify_string(d);
if (PObj_constant_TEST(s)) {
PObj_COW_SET(s);
@@ -204,6 +208,9 @@
STRING *
string_set(PARROT_INTERP, NULLOK(STRING *dest), NOTNULL(STRING *src))
{
+ saneify_string(src);
+ if (dest) { saneify_string(dest); }
+
if (dest == src)
return dest;
if (dest) { /* && dest != src */
@@ -303,6 +310,7 @@
string_capacity(SHIM_INTERP, NOTNULL(const STRING *s))
{
PARROT_ASSERT(s);
+ saneify_string(s);
return ((ptrcast_t)PObj_bufstart(s) + PObj_buflen(s) -
(ptrcast_t)s->strstart);
@@ -359,6 +367,9 @@
string_rep_compatible(SHIM_INTERP,
NOTNULL(const STRING *a), NOTNULL(const STRING *b), ARGOUT(const ENCODING **e))
{
+ saneify_string(a);
+ saneify_string(b);
+
if (a->encoding == b->encoding && a->charset == b->charset) {
*e = a->encoding;
return a->charset;
@@ -428,6 +439,11 @@
/* If B isn't real, we just bail */
const UINTVAL b_len = b ? string_length(interp, b) : 0;
+
+ if (a) { saneify_string(a); }
+
+ if (b) { saneify_string(b); }
+
if (!b_len)
return a;
@@ -435,9 +451,6 @@
if (a == NULL || PObj_bufstart(a) == NULL)
return string_copy(interp, b);
- saneify_string(a);
- saneify_string(b);
-
/* If the destination's constant, or external then just fall back to
string_concat */
if (PObj_is_cowed_TESTALL(a))
@@ -658,6 +671,7 @@
STRING *
string_grow(PARROT_INTERP, NOTNULL(STRING *s), INTVAL addlen)
{
+ saneify_string(s);
Parrot_unmake_COW(interp,s);
/* Don't check buflen, if we are here, we already checked. */
@@ -830,6 +844,7 @@
STRING *
string_copy(PARROT_INTERP, NOTNULL(STRING *s))
{
+ saneify_string(s);
return Parrot_make_COW_reference(interp, s);
}
@@ -851,6 +866,7 @@
string_compute_strlen(PARROT_INTERP, NOTNULL(STRING *s))
{
PARROT_ASSERT(s);
+ saneify_string(s);
s->strlen = CHARSET_CODEPOINTS(interp, s);
return s->strlen;
@@ -891,6 +907,9 @@
STRING *
string_concat(PARROT_INTERP, NULLOK(STRING *a), NULLOK(STRING *b), UINTVAL Uflags)
{
+ if (a) { saneify_string(a); }
+ if (b) { saneify_string(b); }
+
if (a != NULL && a->strlen != 0) {
if (b != NULL && b->strlen != 0) {
const CHARSET *cs;
@@ -945,6 +964,8 @@
s->bufused * num,
s->encoding, s->charset, 0);
+ saneify_string(s);
+
if (num == 0)
return dest;
@@ -1064,6 +1085,8 @@
const ENCODING *enc;
String_iter iter;
+ saneify_string(src);
+ saneify_string(rep);
/* special case */
if (d == NULL &&
src->encoding == Parrot_fixed_8_encoding_ptr &&
@@ -1197,6 +1220,7 @@
string_chopn(PARROT_INTERP, NOTNULL(STRING *s), INTVAL n)
{
STRING * const chopped = string_copy(interp, s);
+ saneify_string(s);
string_chopn_inplace(interp, chopped, n);
return chopped;
}
@@ -1218,6 +1242,7 @@
UINTVAL new_length, uchar_size;
String_iter iter;
+ saneify_string(s);
Parrot_unmake_COW(interp, s);
if (n < 0) {
