hashtables bootstrap correctly

Makefile

@@ -24,7 +24,8 @@ OBJS = native/arithmetic.o native/array.o native/bignum.o \
 	native/unix/read.o \
 	native/unix/write.o \
 	native/unix/ffi.o \
-	native/debug.o
+	native/debug.o \
+	native/hashtable.o
 
 default:
 	@echo "Run 'make' with one of the following parameters:"

library/arrays.factor

@@ -29,6 +29,7 @@ IN: kernel-internals
 USE: generic
 USE: math-internals
 USE: kernel
+USE: lists
 
 ! An array is a range of memory storing pointers to other
 ! objects. Arrays are not used directly, and their access words
@@ -42,7 +43,7 @@ USE: kernel
 
 BUILTIN: array 8
 
-: array-capacity   ( array -- n )   1 integer-slot ; inline
+: array-capacity   ( array -- n )   1 slot ; inline
 : vector-array     ( vec -- array ) 2 slot ; inline
 : set-vector-array ( array vec -- ) 2 set-slot ; inline
 
@@ -51,3 +52,14 @@ BUILTIN: array 8
 
 : set-array-nth ( obj n array -- )
     swap 2 fixnum+ set-slot ; inline
+
+: (array>list) ( n i array -- list )
+    pick pick fixnum<= [
+        3drop [ ]
+    ] [
+        2dup array-nth >r >r 1 fixnum+ r> (array>list) r>
+        swap cons
+    ] ifte ;
+
+: array>list ( n array -- list )
+    0 swap (array>list) ;

library/bootstrap/image.factor

@@ -41,6 +41,7 @@
 IN: image
 USE: errors
 USE: generic
+USE: kernel-internals
 USE: hashtables
 USE: kernel
 USE: lists
@@ -86,9 +87,9 @@ SYMBOL: boot-quot
 : cons-tag    BIN: 010 ; inline
 : object-tag  BIN: 011 ; inline
 
-: f-type      6  ; inline
 : t-type         7  ; inline
 : array-type     8  ; inline
+: hashtable-type 10 ; inline
 : vector-type    11 ; inline
 : string-type    12 ; inline
 : word-type      17 ; inline
@@ -142,6 +143,8 @@ GENERIC: ' ( obj -- ptr )
 
 ( Fixnums )
 
+: emit-fixnum ( n -- ) fixnum-tag immediate emit ;
+
 M: fixnum ' ( n -- tagged ) fixnum-tag immediate ;
 
 ( Bignums )
@@ -154,7 +157,7 @@ M: bignum ' ( bignum -- tagged )
         [[ 0  [ 1 0   ] ]]
         [[ -1 [ 2 1 1 ] ]]
         [[ 1  [ 2 0 1 ] ]]
-    ] assoc [ emit ] each align-here r> ;
+    ] assoc unswons emit-fixnum [ emit ] each align-here r> ;
 
 ( Special objects )
 
@@ -175,7 +178,7 @@ M: f ' ( obj -- ptr )
 : -1, -1 >bignum ' drop ;
 
 ( Beginning of the image )
-! The image proper begins with the header, then T,
+! The image begins with the header, then T,
 ! and the bignums 0, 1, and -1.
 
 : begin ( -- ) header t, 0, 1, -1, ;
@@ -249,7 +252,7 @@ M: cons ' ( c -- tagged )
     object-tag here-as swap
     string-type >header emit
     dup str-length emit
-    dup hashcode fixnum-tag immediate emit
+    dup hashcode emit-fixnum
     pack-string
     align-here ;
 
@@ -266,7 +269,7 @@ M: string ' ( string -- pointer )
     [ ' ] map
     object-tag here-as >r
     array-type >header emit
-    dup length emit
+    dup length emit-fixnum
     ( elements -- ) [ emit ] each
     align-here r> ;
 
@@ -274,7 +277,7 @@ M: string ' ( string -- pointer )
     dup vector>list emit-array swap vector-length
     object-tag here-as >r
     vector-type >header emit
-    emit ( length )
+    emit-fixnum ( length )
     emit ( array ptr )
     align-here r> ;
 
@@ -284,24 +287,30 @@ M: vector ' ( vector -- pointer )
 : rehash ( hashtable -- )
     ! Now make a rehashing boot quotation
     dup hash>alist [
-        >r dup vector-length [
+        over hash-clear
-            [ f swap pick set-vector-nth ] keep
-        ] repeat r>
         [ unswons rot set-hash ] each-with
     ] cons cons
     boot-quot [ append ] change ;
 
+: emit-hashtable ( hash -- pointer )
+    dup buckets>list emit-array swap hash-size
+    object-tag here-as >r
+    hashtable-type >header emit
+    emit-fixnum ( length )
+    emit ( array ptr )
+    align-here r> ;
+
 M: hashtable ' ( hashtable -- pointer )
     #! Only hashtables are pooled, not vectors!
     dup pooled-object [
-        [ dup emit-vector [ pool-object ] keep ] keep rehash
+        [ dup emit-hashtable [ pool-object ] keep ] keep rehash
     ] ?unless ;
 
 ( End of the image )
 
 : vocabularies, ( vocabularies -- )
     [
-        cdr dup vector? [
+        cdr dup hashtable? [
             [
                 cdr dup word? [ word, ] [ drop ] ifte
             ] hash-each

library/bootstrap/primitives.factor

@@ -218,11 +218,14 @@ vocabularies get [
     [[ "vectors" ">vector" ]]
     [[ "strings" ">string" ]]
     [[ "words" ">word" ]]
+    [[ "hashtables" ">hashtable" ]]
     [[ "kernel-internals" "slot" ]]
     [[ "kernel-internals" "set-slot" ]]
     [[ "kernel-internals" "integer-slot" ]]
     [[ "kernel-internals" "set-integer-slot" ]]
     [[ "kernel-internals" "grow-array" ]]
+    [[ "hashtables" "<hashtable>" ]]
+    [[ "kernel-internals" "<array>" ]]
 ] [
     unswons create swap 1 + [ f define ] keep
 ] each drop

library/generic/traits.factor

@@ -39,7 +39,7 @@ USE: vectors
 ! Traits metaclass for user-defined classes based on hashtables
 
 : traits ( object -- symbol )
-    dup vector? [ \ traits swap hash ] [ drop f ] ifte ;
+    dup hashtable? [ \ traits swap hash ] [ drop f ] ifte ;
 
 ! Hashtable slot holding an optional delegate. Any undefined
 ! methods are called on the delegate. The object can also
@@ -58,7 +58,7 @@ SYMBOL: delegate
     ] ifte ;
 
 : add-traits-dispatch ( word vtable -- )
-    >r unit [ car traits-dispatch call ] cons \ vector r>
+    >r unit [ car traits-dispatch call ] cons \ hashtable r>
     set-vtable ;
 
 \ traits [

library/hashtables.factor

@@ -25,37 +25,45 @@
 ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
-IN: kernel-internals
+IN: hashtables
 USE: generic
 USE: kernel
 USE: lists
 USE: math
 USE: vectors
 
-: hash-array vector-array ; inline
+BUILTIN: hashtable 10
-: bucket-count >vector hash-array array-capacity ; inline
+
+! A hashtable is implemented as an array of buckets. The
+! array index is determined using a hash function, and the
+! buckets are associative lists which are searched
+! linearly.
+
+IN: kernel-internals
+
+: hash-array 2 slot ; inline
 
 : hash-bucket ( n hash -- alist )
-    swap >fixnum swap >vector hash-array array-nth ; inline
+    swap >fixnum swap >hashtable hash-array array-nth ; inline
 
 : set-hash-bucket ( obj n hash -- )
-    >r >fixnum r> hash-array set-array-nth ; inline
+    swap >fixnum swap >hashtable hash-array set-array-nth ;
+    inline
+
+: hash-size+ ( hash -- )
+    >hashtable dup 1 slot 1 + swap 1 set-slot ; inline
+
+: hash-size- ( hash -- )
+    >hashtable dup 1 slot 1 - swap 1 set-slot ; inline
 
 IN: hashtables
 
-! Note that the length of a hashtable vector must not change
+: hash-size ( hash -- n )
-! for the lifetime of the hashtable, otherwise problems will
+    #! Number of elements in the hashtable.
-! occur. Do not use vector words with hashtables.
+    >hashtable 1 slot ;
 
-PREDICATE: vector hashtable ( obj -- ? )
+: bucket-count ( hash -- n )
-    [ assoc? ] vector-all? ;
+    >hashtable hash-array array-capacity ; inline
-
-: <hashtable> ( buckets -- )
-    #! A hashtable is implemented as an array of buckets. The
-    #! array index is determined using a hash function, and the
-    #! buckets are associative lists which are searched
-    #! linearly. The number of buckets must be a power of two.
-    empty-vector ;
 
 : (hashcode) ( key table -- index )
     #! Compute the index of the bucket for a key.
@@ -74,6 +82,8 @@ PREDICATE: vector hashtable ( obj -- ? )
 
 : set-hash* ( key table quot -- )
     #! Apply the quotation to yield a new association list.
+    #! If the association list already contains the key,
+    #! decrement the hash size, since it will get removed.
     >r
         2dup (hashcode)
     r> pick >r
@@ -86,27 +96,46 @@ PREDICATE: vector hashtable ( obj -- ? )
     #! Store the value in the hashtable. Either replaces an
     #! existing value in the appropriate bucket, or adds a new
     #! key/value pair.
+    dup hash-size+
     [ set-assoc ] set-hash* ;
 
 : remove-hash ( key table -- )
     #! Remove a value from a hashtable.
     [ remove-assoc ] set-hash* ;
 
-: hash-each ( hash code -- )
+: hash-clear ( hash -- )
-    #! Apply the code to each key/value pair of the hashtable.
+    #! Remove all entries from a hashtable.
-    swap [ swap dup >r each r> ] vector-each drop ; inline
+    dup bucket-count [
+        [ f swap pick set-hash-bucket ] keep
+    ] repeat drop ;
+
+: buckets>list ( hash -- list )
+    #! Push a list of key/value pairs in a hashtable.
+    dup bucket-count swap hash-array array>list ;
+
+: (hash>alist) ( alist n hash -- alist )
+    2dup bucket-count >= [
+        2drop
+    ] [
+        [ hash-bucket [ swons ] each ] 2keep
+        >r 1 + r> (hash>alist)
+    ] ifte ;
+
+: hash>alist ( hash -- alist )
+    #! Push a list of key/value pairs in a hashtable.
+    [ ] 0 rot (hash>alist) ;
+
+: alist>hash ( alist -- hash )
+    dup length <hashtable> swap [ unswons pick set-hash ] each ;
 
 : hash-keys ( hash -- list )
     #! Push a list of keys in a hashtable.
-    [ ] swap [ car swons ] hash-each ;
+    hash>alist [ car ] map ;
 
 : hash-values ( hash -- alist )
     #! Push a list of values in a hashtable.
-    [ ] swap [ cdr swons ] hash-each ;
+    hash>alist [ cdr ] map ;
 
-: hash>alist ( hash -- list )
+: hash-each ( hash code -- )
-    #! Push a list of key/value pairs in a hashtable.
+    #! Apply the code to each key/value pair of the hashtable.
-    [ ] swap [ swons ] hash-each ;
+    >r hash>alist r> each ; inline
-
-: alist>hash ( alist -- hash )
-    37 <hashtable> swap [ unswons pick set-hash ] each ;

library/namespaces.factor

@@ -61,7 +61,7 @@ USE: math
 
 : >n ( namespace -- n:namespace )
     #! Push a namespace on the namespace stack.
-    >vector namestack cons set-namestack ; inline
+    >hashtable namestack cons set-namestack ; inline
 
 : n> ( n:namespace -- namespace )
     #! Pop the top of the namespace stack.

library/primitives.factor

@@ -26,6 +26,7 @@
 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 IN: alien
+USE: hashtables
 DEFER: alien
 DEFER: dll
 
@@ -215,12 +216,15 @@ USE: words
     [ >cons                  [ [ object ] [ cons ] ] ]
     [ >vector                [ [ object ] [ vector ] ] ]
     [ >string                [ [ object ] [ string ] ] ]
-    [ >word                  [ [ word ] [ word ] ] ]
+    [ >word                  [ [ object ] [ word ] ] ]
+    [ >hashtable             [ [ object ] [ hashtable ] ] ]
     [ slot                   [ [ object fixnum ] [ object ] ] ]
     [ set-slot               [ [ object object fixnum ] [ ] ] ]
     [ integer-slot           [ [ object fixnum ] [ integer ] ] ]
     [ set-integer-slot       [ [ integer object fixnum ] [ ] ] ]
     [ grow-array             [ [ integer array ] [ object ] ] ]
+    [ <hashtable>            [ [ number ] [ hashtable ] ] ]
+    [ <array>                [ [ number ] [ array ] ] ]
 ] [
     2unlist dup string? [
         "stack-effect" set-word-property

library/test/hashtables.factor

@@ -58,3 +58,17 @@ f 100000000000000000000000000 "testhash" get set-hash
     "visual basic" "testhash" get remove-hash
     "visual basic" "testhash" get hash*
 ] unit-test
+
+[ 4 ] [
+    "hey"
+    {{ [[ "hey" 4 ]] [[ "whey" 5 ]] }} 2dup (hashcode)
+    >r buckets>list r> [ cdr ] times car assoc
+] unit-test
+
+! Testing the hash element counting
+
+<namespace> "counting" set
+"key" "value" "counting" get set-hash
+[ 1 ] [ "counting" get hash-size ] unit-test
+"key" "value" "counting" get set-hash
+[ 1 ] [ "counting" get hash-size ] unit-test

library/test/vectors.factor

@@ -78,7 +78,7 @@ unit-test
 [ "funky" ] [ "funny-stack" get vector-pop ] unit-test
 
 [ t ] [
-    10 <vector> dup vector-array array-capacity
+    { 1 2 3 4 } dup vector-array array-capacity
     >r vector-clone vector-array array-capacity r>
     =
 ] unit-test

library/vectors.factor

@@ -36,11 +36,11 @@ USE: math-internals
 
 BUILTIN: vector 11
 
-: vector-length ( vec -- len ) >vector 1 integer-slot ; inline
+: vector-length ( vec -- len ) >vector 1 slot ; inline
 
 IN: kernel-internals
 
-: (set-vector-length) ( len vec -- ) 1 set-integer-slot ; inline
+: (set-vector-length) ( len vec -- ) 1 set-slot ; inline
 
 : assert-positive ( fx -- )
     0 fixnum<
@@ -107,15 +107,8 @@ IN: vectors
 : >pop> ( stack -- stack )
     dup vector-pop drop ;
 
-: (vector>list) ( i vec -- list )
+: vector>list ( vec -- list )
-    2dup vector-length >= [
+    dup vector-length swap vector-array array>list ;
-        2drop [ ]
-    ] [
-        2dup vector-nth >r >r 1 + r> (vector>list) r> swons
-    ] ifte ;
-
-: vector>list ( str -- list )
-    0 swap (vector>list) ;
 
 : vector-each ( vector quotation -- )
     #! Execute the quotation with each element of the vector

native/array.c

@@ -5,7 +5,7 @@ F_ARRAY* allot_array(CELL type, CELL capacity)
 {
 	F_ARRAY* array;
 	array = allot_object(type,sizeof(F_ARRAY) + capacity * CELLS);
-	array->capacity = capacity;
+	array->capacity = tag_fixnum(capacity);
 	return array;
 }
 
@@ -22,20 +22,30 @@ F_ARRAY* array(CELL capacity, CELL fill)
 	return array;
 }
 
+void primitive_array(void)
+{
+	F_FIXNUM capacity = to_fixnum(dpop());
+	if(capacity < 0)
+		general_error(ERROR_NEGATIVE_ARRAY_SIZE,tag_fixnum(capacity));
+	maybe_garbage_collection();
+	dpush(tag_object(array(capacity,F)));
+}
+
 F_ARRAY* grow_array(F_ARRAY* array, CELL capacity, CELL fill)
 {
 	/* later on, do an optimization: if end of array is here, just grow */
 	int i;
 	F_ARRAY* new_array;
+	CELL curr_cap = untag_fixnum_fast(array->capacity);
 
-	if(array->capacity >= capacity)
+	if(curr_cap >= capacity)
 		return array;
 
 	new_array = allot_array(untag_header(array->header),capacity);
 
 	memcpy(new_array + 1,array + 1,array->capacity * CELLS);
 
-	for(i = array->capacity; i < capacity; i++)
+	for(i = curr_cap; i < capacity; i++)
 		put(AREF(new_array,i),fill);
 
 	return new_array;
@@ -43,8 +53,11 @@ F_ARRAY* grow_array(F_ARRAY* array, CELL capacity, CELL fill)
 
 void primitive_grow_array(void)
 {
-	F_ARRAY* array = untag_array(dpop());
+	F_ARRAY* array;
-	CELL capacity = to_fixnum(dpop());
+	CELL capacity;
+	maybe_garbage_collection();
+	array = untag_array(dpop());
+	capacity = to_fixnum(dpop());
 	dpush(tag_object(grow_array(array,capacity,F)));
 }
 
@@ -58,13 +71,15 @@ F_ARRAY* shrink_array(F_ARRAY* array, CELL capacity)
 void fixup_array(F_ARRAY* array)
 {
 	int i = 0;
-	for(i = 0; i < array->capacity; i++)
+	CELL capacity = untag_fixnum_fast(array->capacity);
+	for(i = 0; i < capacity; i++)
 		data_fixup((void*)AREF(array,i));
 }
 
 void collect_array(F_ARRAY* array)
 {
 	int i = 0;
-	for(i = 0; i < array->capacity; i++)
+	CELL capacity = untag_fixnum_fast(array->capacity);
+	for(i = 0; i < capacity; i++)
 		copy_object((void*)AREF(array,i));
 }

native/array.h

@@ -1,17 +1,18 @@
 typedef struct {
 	CELL header;
-	/* untagged */
+	/* tagged */
 	CELL capacity;
 } F_ARRAY;
 
 INLINE F_ARRAY* untag_array(CELL tagged)
 {
-	/* type_check(ARRAY_TYPE,tagged); */
+	type_check(ARRAY_TYPE,tagged);
-	return (F_ARRAY*)UNTAG(tagged); /* FIXME */
+	return (F_ARRAY*)UNTAG(tagged);
 }
 
 F_ARRAY* allot_array(CELL type, CELL capacity);
 F_ARRAY* array(CELL capacity, CELL fill);
+void primitive_array(void);
 F_ARRAY* grow_array(F_ARRAY* array, CELL capacity, CELL fill);
 void primitive_grow_array(void);
 F_ARRAY* shrink_array(F_ARRAY* array, CELL capacity);
@@ -19,7 +20,7 @@ F_ARRAY* shrink_array(F_ARRAY* array, CELL capacity);
 #define AREF(array,index) ((CELL)(array) + sizeof(F_ARRAY) + (index) * CELLS)
 
 #define ASIZE(pointer) align8(sizeof(F_ARRAY) + \
-	((F_ARRAY*)(pointer))->capacity * CELLS)
+	untag_fixnum_fast(((F_ARRAY*)(pointer))->capacity) * CELLS)
 
 void fixup_array(F_ARRAY* array);
 void collect_array(F_ARRAY* array);

native/factor.h

@@ -135,6 +135,7 @@ typedef unsigned char BYTE;
 #include "image.h"
 #include "primitives.h"
 #include "vector.h"
+#include "hashtable.h"
 #include "stack.h"
 #include "compiler.h"
 #include "relocate.h"

native/gc.c

@@ -71,6 +71,9 @@ INLINE void collect_object(CELL scan)
 	case ARRAY_TYPE:
 		collect_array((F_ARRAY*)scan);
 		break;
+	case HASHTABLE_TYPE:
+		collect_hashtable((F_HASHTABLE*)scan);
+		break;
 	case VECTOR_TYPE:
 		collect_vector((F_VECTOR*)scan);
 		break;

native/gc.h

@@ -27,6 +27,9 @@ INLINE void copy_object(CELL* handle)
 	if(tag == FIXNUM_TYPE)
 		return;
 
+	if(headerp(pointer))
+		critical_error("Asked to copy header",pointer);
+
 	header = get(UNTAG(pointer));
 	if(TAG(header) == GC_COLLECTED)
 		newpointer = UNTAG(header);

native/hashtable.c

@@ -0,0 +1,33 @@
+#include "factor.h"
+
+F_HASHTABLE* hashtable(F_FIXNUM capacity)
+{
+	F_HASHTABLE* hash;
+	if(capacity < 0)
+		general_error(ERROR_NEGATIVE_ARRAY_SIZE,tag_fixnum(capacity));
+	hash = allot_object(HASHTABLE_TYPE,sizeof(F_VECTOR));
+	hash->count = tag_fixnum(0);
+	hash->array = tag_object(array(capacity,F));
+	return hash;
+}
+
+void primitive_hashtable(void)
+{
+	maybe_garbage_collection();
+	drepl(tag_object(hashtable(to_fixnum(dpeek()))));
+}
+
+void primitive_to_hashtable(void)
+{
+	type_check(HASHTABLE_TYPE,dpeek());
+}
+
+void fixup_hashtable(F_HASHTABLE* hashtable)
+{
+	data_fixup(&hashtable->array);
+}
+
+void collect_hashtable(F_HASHTABLE* hashtable)
+{
+	copy_object(&hashtable->array);
+}

native/hashtable.h

@@ -0,0 +1,15 @@
+typedef struct {
+	/* always tag_header(HASHTABLE_TYPE) */
+	CELL header;
+	/* tagged */
+	CELL count;
+	/* tagged */
+	CELL array;
+} F_HASHTABLE;
+
+F_HASHTABLE* hashtable(F_FIXNUM capacity);
+
+void primitive_hashtable(void);
+void primitive_to_hashtable(void);
+void fixup_hashtable(F_HASHTABLE* hashtable);
+void collect_hashtable(F_HASHTABLE* hashtable);

native/primitives.c

@@ -168,11 +168,14 @@ void* primitives[] = {
 	primitive_to_vector,
 	primitive_to_string,
 	primitive_to_word,
+	primitive_to_hashtable,
 	primitive_slot,
 	primitive_set_slot,
 	primitive_integer_slot,
 	primitive_set_integer_slot,
-	primitive_grow_array
+	primitive_grow_array,
+	primitive_hashtable,
+	primitive_array
 };
 
 CELL primitive_to_xt(CELL primitive)

native/relocate.c

@@ -10,6 +10,9 @@ void relocate_object(CELL relocating)
 	case ARRAY_TYPE:
 		fixup_array((F_ARRAY*)relocating);
 		break;
+	case HASHTABLE_TYPE:
+		fixup_hashtable((F_HASHTABLE*)relocating);
+		break;
 	case VECTOR_TYPE:
 		fixup_vector((F_VECTOR*)relocating);
 		break;

native/s48_bignumint.h

@@ -83,7 +83,7 @@ typedef long bignum_length_type;
 #define BIGNUM_START_PTR(bignum)					\
   ((BIGNUM_TO_POINTER (bignum)) + 1)
 
-#define BIGNUM_LENGTH(bignum) ((bignum)->capacity - 1)
+#define BIGNUM_LENGTH(bignum) (untag_fixnum_fast((bignum)->capacity) - 1)
 
 #define BIGNUM_NEGATIVE_P(bignum) (get(AREF(bignum,0)) != 0)
 #define BIGNUM_SET_NEGATIVE_P(bignum,neg) put(AREF(bignum,0),neg)

native/stack.c

@@ -81,7 +81,7 @@ F_VECTOR* stack_to_vector(CELL bottom, CELL top)
 	F_VECTOR* v = vector(depth);
 	F_ARRAY* a = untag_array(v->array);
 	memcpy(a + 1,(void*)bottom,depth * CELLS);
-	v->top = depth;
+	v->top = tag_fixnum(depth);
 	return v;
 }
 
@@ -101,7 +101,7 @@ void primitive_callstack(void)
 CELL vector_to_stack(F_VECTOR* vector, CELL bottom)
 {
 	CELL start = bottom;
-	CELL len = vector->top * CELLS;
+	CELL len = untag_fixnum_fast(vector->top) * CELLS;
 	memcpy((void*)start,untag_array(vector->array) + 1,len);
 	return start + len - CELLS;
 }

native/types.c

@@ -55,6 +55,9 @@ CELL untagged_object_size(CELL pointer)
 	case BIGNUM_TYPE:
 		size = ASIZE(pointer);
 		break;
+	case HASHTABLE_TYPE:
+		size = sizeof(F_HASHTABLE);
+		break;
 	case VECTOR_TYPE:
 		size = sizeof(F_VECTOR);
 		break;

native/types.h

@@ -27,6 +27,7 @@ CELL T;
 #define F_TYPE 9
 #define F RETAG(0,OBJECT_TYPE)
 
+#define HASHTABLE_TYPE 10
 #define VECTOR_TYPE 11
 #define STRING_TYPE 12
 #define SBUF_TYPE 13

native/vector.c

@@ -6,7 +6,7 @@ F_VECTOR* vector(F_FIXNUM capacity)
 	if(capacity < 0)
 		general_error(ERROR_NEGATIVE_ARRAY_SIZE,tag_fixnum(capacity));
 	vector = allot_object(VECTOR_TYPE,sizeof(F_VECTOR));
-	vector->top = 0;
+	vector->top = tag_fixnum(0);
 	vector->array = tag_object(array(capacity,F));
 	return vector;
 }

native/vector.h

@@ -1,7 +1,7 @@
 typedef struct {
 	/* always tag_header(VECTOR_TYPE) */
 	CELL header;
-	/* untagged */
+	/* tagged */
 	CELL top;
 	/* tagged */
 	CELL array;