~ chicken-core (chicken-5) de09e0a2c286a260dd3a15baaa2a1f86512a4b1e
commit de09e0a2c286a260dd3a15baaa2a1f86512a4b1e
Author: Peter Bex <peter@more-magic.net>
AuthorDate: Sat Sep 3 18:45:54 2016 +0200
Commit: Evan Hanson <evhan@foldling.org>
CommitDate: Fri Sep 30 15:28:43 2016 +1300
Remove C_BUCKET_TYPE
The original GC code detected C_BUCKET_TYPE as a special case, for which
it would insert the bucket's symbol into the weak symbol hash table.
Now that we treat hsah table buckets *almost* normally, there's only one
special case left, which also works if we use "weak pair" as a type.
There is one caveat, namely that anything which checks for "pair" by
directly matching the header tag against C_PAIR_TAG will not accept a
weak pair. This is not as bad as it sounds, since the buckets are in an
internal hash table that's not directly accessible to the user anyway.
The only place we need a special case for it is in dump_heap_state_2().
Signed-off-by: Evan Hanson <evhan@foldling.org>
diff --git a/chicken.h b/chicken.h
index 5a64f543..fdad9167 100644
--- a/chicken.h
+++ b/chicken.h
@@ -473,7 +473,7 @@ static inline int isinf_ld (long double x)
/* unused (0x0c00000000000000L ...) */
# define C_LAMBDA_INFO_TYPE (0x0d00000000000000L | C_BYTEBLOCK_BIT)
/* unused (0x0e00000000000000L ...) */
-# define C_BUCKET_TYPE (0x0f00000000000000L)
+/* unused (0x0f00000000000000L ...) */
#else
# define C_INT_SIGN_BIT 0x80000000
# define C_INT_TOP_BIT 0x40000000
@@ -503,7 +503,7 @@ static inline int isinf_ld (long double x)
/* unused (0x0c000000 ...) */
# define C_LAMBDA_INFO_TYPE (0x0d000000 | C_BYTEBLOCK_BIT)
/* unused (0x0e000000 ...) */
-# define C_BUCKET_TYPE (0x0f000000)
+/* unused (0x0f000000 ...) */
#endif
#define C_VECTOR_TYPE 0x00000000
#define C_BYTEVECTOR_TYPE (C_VECTOR_TYPE | C_BYTEBLOCK_BIT | C_8ALIGN_BIT)
@@ -512,7 +512,7 @@ static inline int isinf_ld (long double x)
#define C_SIZEOF_PAIR 3
#define C_SIZEOF_STRING(n) (C_bytestowords(n) + 2)
#define C_SIZEOF_SYMBOL 4
-#define C_SIZEOF_INTERNED_SYMBOL(n) (C_SIZEOF_SYMBOL + C_SIZEOF_BUCKET + C_SIZEOF_STRING(n))
+#define C_SIZEOF_INTERNED_SYMBOL(n) (C_SIZEOF_SYMBOL + C_SIZEOF_PAIR + C_SIZEOF_STRING(n))
#ifdef C_DOUBLE_IS_32_BITS
# define C_SIZEOF_FLONUM 2
#else
@@ -521,7 +521,6 @@ static inline int isinf_ld (long double x)
#define C_SIZEOF_POINTER 2
#define C_SIZEOF_TAGGED_POINTER 3
#define C_SIZEOF_VECTOR(n) ((n) + 1)
-#define C_SIZEOF_BUCKET 3
#define C_SIZEOF_LOCATIVE 5
#define C_SIZEOF_PORT 16
#define C_SIZEOF_STRUCTURE(n) ((n)+1)
@@ -536,9 +535,8 @@ static inline int isinf_ld (long double x)
/* Fixed size types have pre-computed header tags */
#define C_PAIR_TAG (C_PAIR_TYPE | (C_SIZEOF_PAIR - 1))
+#define C_WEAK_PAIR_TAG (C_PAIR_TAG | C_SPECIALBLOCK_BIT)
#define C_POINTER_TAG (C_POINTER_TYPE | (C_SIZEOF_POINTER - 1))
-#define C_BUCKET_TAG (C_BUCKET_TYPE | (C_SIZEOF_BUCKET - 1))
-#define C_WEAK_BUCKET_TAG (C_BUCKET_TAG | C_SPECIALBLOCK_BIT)
#define C_LOCATIVE_TAG (C_LOCATIVE_TYPE | (C_SIZEOF_LOCATIVE - 1))
#define C_TAGGED_POINTER_TAG (C_TAGGED_POINTER_TYPE | (C_SIZEOF_TAGGED_POINTER - 1))
#define C_SYMBOL_TAG (C_SYMBOL_TYPE | (C_SIZEOF_SYMBOL - 1))
@@ -3415,11 +3413,11 @@ C_inline C_word C_fcall C_a_pair(C_word **ptr, C_word car, C_word cdr)
return (C_word)p0;
}
-C_inline C_word C_fcall C_a_bucket(C_word **ptr, C_word head, C_word tail)
+C_inline C_word C_fcall C_a_weak_pair(C_word **ptr, C_word head, C_word tail)
{
C_word *p = *ptr, *p0 = p;
- *(p++) = C_WEAK_BUCKET_TAG; /* Changes to strong if sym is persisted */
+ *(p++) = C_WEAK_PAIR_TAG; /* Changes to strong if sym is persisted */
*(p++) = head;
*(p++) = tail;
*ptr = p;
diff --git a/runtime.c b/runtime.c
index 27f1964d..ea06b47b 100644
--- a/runtime.c
+++ b/runtime.c
@@ -2491,7 +2491,7 @@ C_word add_symbol(C_word **ptr, C_word key, C_word string, C_SYMBOL_TABLE *stabl
C_set_block_item(sym, 2, C_SCHEME_END_OF_LIST);
*ptr = p;
b2 = stable->table[ key ]; /* previous bucket */
- bucket = C_a_bucket(ptr, sym, b2); /* create new bucket */
+ bucket = C_a_weak_pair(ptr, sym, b2); /* create new bucket */
if(ptr != C_heaptop) C_mutate_slot(&stable->table[ key ], bucket);
else {
@@ -3416,7 +3416,7 @@ C_regparm void C_fcall C_reclaim(void *trampoline, C_word c)
if(n > 0 && (h & C_BYTEBLOCK_BIT) == 0) {
if(h & C_SPECIALBLOCK_BIT) {
/* Minor GC needs to be fast; always mark weakly held symbols */
- if (gc_mode != GC_MINOR || h != C_WEAK_BUCKET_TAG) {
+ if (gc_mode != GC_MINOR || h != C_WEAK_PAIR_TAG) {
--n;
++p;
}
@@ -10648,7 +10648,7 @@ void C_ccall C_string_to_symbol(C_word c, C_word *av)
k = av[ 1 ],
string;
int len, key;
- C_word s, *a = C_alloc(C_SIZEOF_SYMBOL + C_SIZEOF_BUCKET);
+ C_word s, *a = C_alloc(C_SIZEOF_SYMBOL + C_SIZEOF_PAIR);
C_char *name;
if(c != 3) C_bad_argc(c, 3);
@@ -13392,6 +13392,8 @@ static void C_ccall dump_heap_state_2(C_word c, C_word *av)
}
bp = hdump_table;
+ /* HACK */
+#define C_WEAK_PAIR_TYPE (C_PAIR_TYPE | C_SPECIALBLOCK_BIT)
for(n = 0; n < HDUMP_TABLE_SIZE; ++n) {
for(b = bp[ n ]; b != NULL; b = b2) {
@@ -13415,7 +13417,7 @@ static void C_ccall dump_heap_state_2(C_word c, C_word *av)
case C_LOCATIVE_TYPE: C_fprintf(C_stderr, C_text("locative ")); break;
case C_TAGGED_POINTER_TYPE: C_fprintf(C_stderr, C_text("tagged pointer ")); break;
case C_LAMBDA_INFO_TYPE: C_fprintf(C_stderr, C_text("lambda info ")); break;
- case C_BUCKET_TYPE: C_fprintf(C_stderr, C_text("bucket ")); break;
+ case C_WEAK_PAIR_TYPE: C_fprintf(C_stderr, C_text("weak pair ")); break;
case C_VECTOR_TYPE: C_fprintf(C_stderr, C_text("vector ")); break;
case C_BYTEVECTOR_TYPE: C_fprintf(C_stderr, C_text("bytevector ")); break;
/* XXX this is sort of funny: */
Trap