cvsuser 03/11/21 02:49:31
Modified: classes perlhash.pmc
include/parrot hash.h
src hash.c pmc_freeze.c
Log:
fix hash DOD corruption
Revision Changes Path
1.59 +3 -3 parrot/classes/perlhash.pmc
Index: perlhash.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlhash.pmc,v
retrieving revision 1.58
retrieving revision 1.59
diff -u -w -r1.58 -r1.59
--- perlhash.pmc 7 Nov 2003 16:17:30 -0000 1.58
+++ perlhash.pmc 21 Nov 2003 10:49:23 -0000 1.59
@@ -1,7 +1,7 @@
/* perlhash.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: perlhash.pmc,v 1.58 2003/11/07 16:17:30 boemmels Exp $
+ * $Id: perlhash.pmc,v 1.59 2003/11/21 10:49:23 leo Exp $
* Overview:
* These are the vtable functions for the PerlHash base class
* Data Structure and Algorithms:
@@ -43,7 +43,7 @@
VTABLE_init(INTERP, undef);
}
PObj_custom_mark_SET(SELF);
- PMC_ptr1v(SELF) = new_hash(INTERP);
+ new_hash(INTERP, (Hash**)&PMC_ptr1v(SELF));
}
void mark () {
@@ -70,7 +70,7 @@
void clone (PMC *ret) {
PObj_custom_mark_SET(ret);
- PMC_ptr1v(ret) = hash_clone(INTERP, (Hash *)PMC_ptr1v(SELF));
+ hash_clone(INTERP, (Hash *)PMC_ptr1v(SELF), (Hash**)&PMC_ptr1v(ret));
}
INTVAL get_integer () {
1.21 +6 -6 parrot/include/parrot/hash.h
Index: hash.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/hash.h,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -w -r1.20 -r1.21
--- hash.h 14 Nov 2003 08:03:14 -0000 1.20
+++ hash.h 21 Nov 2003 10:49:27 -0000 1.21
@@ -1,7 +1,7 @@
/* hash.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: hash.h,v 1.20 2003/11/14 08:03:14 leo Exp $
+ * $Id: hash.h,v 1.21 2003/11/21 10:49:27 leo Exp $
* Overview:
* Hashtable implementation
* Data Structure and Algorithms:
@@ -75,11 +75,11 @@
hash_mark_key_fn mark_key; /* mark a key being alive */
};
-Hash * new_hash(Interp * interpreter);
-Hash * new_hash_x(Interp *, PARROT_DATA_TYPES, size_t val_size, Hash_key_type,
- hash_comp_fn, hash_hash_key_fn, hash_mark_key_fn);
-Hash * new_cstring_hash(Interp *interpreter);
-Hash * hash_clone(Interp * interpreter, Hash * src);
+void new_hash(Interp * interpreter, Hash **hptr);
+void new_hash_x(Interp *, Hash**, PARROT_DATA_TYPES, size_t val_size,
+ Hash_key_type, hash_comp_fn, hash_hash_key_fn, hash_mark_key_fn);
+void new_cstring_hash(Interp *interpreter, Hash **);
+void hash_clone(Interp * interpreter, Hash * src, Hash **dest);
INTVAL hash_size(Interp * interpreter, Hash *hash);
void hash_set_size(Interp * interpreter, Hash *hash, UINTVAL size);
void hash_destroy(Interp * interpreter, Hash *hash);
1.61 +26 -16 parrot/src/hash.c
Index: hash.c
===================================================================
RCS file: /cvs/public/parrot/src/hash.c,v
retrieving revision 1.60
retrieving revision 1.61
diff -u -w -r1.60 -r1.61
--- hash.c 19 Nov 2003 17:07:57 -0000 1.60
+++ hash.c 21 Nov 2003 10:49:31 -0000 1.61
@@ -1,7 +1,7 @@
/* hash.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: hash.c,v 1.60 2003/11/19 17:07:57 leo Exp $
+ * $Id: hash.c,v 1.61 2003/11/21 10:49:31 leo Exp $
* Overview:
* Data Structure and Algorithms:
* A hashtable contains an array of bucket indexes. Buckets
@@ -431,10 +431,10 @@
return NULL;
}
-Hash *
-new_hash(Interp *interpreter)
+void
+new_hash(Interp *interpreter, Hash **hptr)
{
- return new_hash_x(interpreter,
+ return new_hash_x(interpreter, hptr,
enum_type_PMC,
0,
Hash_key_type_ascii,
@@ -443,10 +443,10 @@
pobject_lives); /* mark */
}
-Hash *
-new_cstring_hash(Interp *interpreter)
+void
+new_cstring_hash(Interp *interpreter, Hash **hptr)
{
- return new_hash_x(interpreter,
+ return new_hash_x(interpreter, hptr,
enum_type_PMC,
0,
Hash_key_type_cstring,
@@ -455,13 +455,26 @@
(hash_mark_key_fn)0);/* no mark */
}
-Hash *
-new_hash_x(Interp *interpreter, PARROT_DATA_TYPES val_type, size_t val_size,
+/* FIXME: This function can go back to just returning the hash struct
+ * pointer once Buffers can define their own custom mark routines.
+ *
+ * The problem is: During DODs stack walking the item on the stack
+ * must be a PMC. When an auto Hash* is seen, it doesn't get properly
+ * marked (only the Hash* buffer is marked, not its contents). By
+ * passing the **hptr up to PerlHash's init function, the newly
+ * constructed PMC is on the stack *including* this newly constructed
+ * Hash, so that it gets marked properly.
+ *
+ */
+void
+new_hash_x(Interp *interpreter, Hash **hptr,
+ PARROT_DATA_TYPES val_type, size_t val_size,
Hash_key_type hkey_type,
hash_comp_fn compare, hash_hash_key_fn keyhash,
hash_mark_key_fn mark)
{
Hash *hash = (Hash *)new_bufferlike_header(interpreter, sizeof(*hash));
+ *hptr = hash;
hash->compare = compare;
hash->hash_val = keyhash;
hash->mark_key = mark;
@@ -487,7 +500,6 @@
/* PObj_report_SET(hash->bucket_pool); */
hash->free_list = NULLBucketIndex;
expand_hash(interpreter, hash);
- return hash;
}
/*=for api hash hash_size
@@ -646,13 +658,12 @@
Parrot_unblock_GC(interpreter);
}
-Hash *
-hash_clone(struct Parrot_Interp *interp, Hash *hash)
+void
+hash_clone(struct Parrot_Interp *interp, Hash *hash, Hash **dest)
{
HashIndex i;
- Hash *dest;
- dest = new_hash_x(interp, hash->entry_type, hash->value_size,
+ new_hash_x(interp, dest, hash->entry_type, hash->value_size,
hash->key_type, hash->compare, hash->hash_val, hash->mark_key);
for (i = 0; i <= hash->max_chain; i++) {
BucketIndex bi = lookupBucketIndex(hash, i);
@@ -682,7 +693,7 @@
internal_exception(-1, "hash corruption: type = %d\n",
hash->entry_type);
};
- hash_put(interp, dest, key, valtmp);
+ hash_put(interp, *dest, key, valtmp);
/*
* hash_put may extend the hash, which can trigger GC
* we could also check the GC count and refetch b only when needed
@@ -691,7 +702,6 @@
bi = b->next;
}
}
- return dest;
}
/*
1.6 +2 -2 parrot/src/pmc_freeze.c
Index: pmc_freeze.c
===================================================================
RCS file: /cvs/public/parrot/src/pmc_freeze.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- pmc_freeze.c 20 Nov 2003 15:34:08 -0000 1.5
+++ pmc_freeze.c 21 Nov 2003 10:49:31 -0000 1.6
@@ -1,7 +1,7 @@
/* pmc_freeze.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: pmc_freeze.c,v 1.5 2003/11/20 15:34:08 leo Exp $
+ * $Id: pmc_freeze.c,v 1.6 2003/11/21 10:49:31 leo Exp $
* Overview:
* Freeze and thaw functionality
* Data Structure and Algorithms:
@@ -298,7 +298,7 @@
/* we must use PMCs here, so that they get marked properly */
info->todo = pmc_new(interpreter, enum_class_Array);
info->seen = pmc_new_noinit(interpreter, enum_class_PerlHash);
- hash = new_hash_x(interpreter, enum_type_ptr, 0, Hash_key_type_int,
+ new_hash_x(interpreter, &hash, enum_type_ptr, 0, Hash_key_type_int,
int_compare, key_hash_int, (hash_mark_key_fn) NULL);
PObj_custom_mark_SET(info->seen);
PMC_ptr1v(info->seen) = hash;
