Exploit the fast-path for allocation of array with initial element 0 by changing

new-sequence on arrays, the vector constructor, and resize-array, called when
growing vectors, to fill arrays with 0 instead of f. user code never observes the
initial value in these situations anyway. small speedup on bootstrap

core/arrays/arrays.factor

@@ -12,9 +12,9 @@ M: array resize resize-array ;
 
 : >array ( seq -- array ) { } clone-like ;
 
-M: object new-sequence drop f <array> ;
+M: object new-sequence drop 0 <array> ;
 
-M: f new-sequence drop dup zero? [ drop f ] [ f <array> ] if ;
+M: f new-sequence drop dup zero? [ drop f ] [ 0 <array> ] if ;
 
 M: array equal?
     over array? [ sequence= ] [ 2drop f ] if ;

core/assocs/assocs.factor

@@ -90,7 +90,7 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc )
     ] if ; inline recursive
 
 : assoc-stack ( key seq -- value )
-    dup length 1- swap (assoc-stack) ;
+    dup length 1- swap (assoc-stack) ; flushable
 
 : assoc-subset? ( assoc1 assoc2 -- ? )
     [ swapd at* [ = ] [ 2drop f ] if ] curry assoc-all? ;

core/namespaces/namespaces.factor

@@ -12,12 +12,12 @@ IN: namespaces
 
 PRIVATE>
 
-: namespace ( -- namespace ) namestack* peek ;
+: namespace ( -- namespace ) namestack* peek ; inline
 : namestack ( -- namestack ) namestack* clone ;
 : set-namestack ( namestack -- ) >vector 0 setenv ;
 : global ( -- g ) 21 getenv { hashtable } declare ; inline
 : init-namespaces ( -- ) global 1array set-namestack ;
-: get ( variable -- value ) namestack* assoc-stack ; flushable
+: get ( variable -- value ) namestack* assoc-stack ; inline
 : set ( value variable -- ) namespace set-at ;
 : on ( variable -- ) t swap set ; inline
 : off ( variable -- ) f swap set ; inline
@@ -28,7 +28,7 @@ PRIVATE>
 : inc ( variable -- ) 1 swap +@ ; inline
 : dec ( variable -- ) -1 swap +@ ; inline
 : bind ( ns quot -- ) swap >n call ndrop ; inline
-: counter ( variable -- n ) global [ dup inc get ] bind ;
+: counter ( variable -- n ) global [ 0 or 1+ dup ] change-at ;
 
 : make-assoc ( quot exemplar -- hash )
     20 swap new-assoc [ >n call ndrop ] keep ; inline

core/vectors/vectors.factor

@@ -8,7 +8,7 @@ TUPLE: vector
 { underlying array }
 { length array-capacity } ;
 
-: <vector> ( n -- vector ) f <array> 0 vector boa ; inline
+: <vector> ( n -- vector ) 0 <array> 0 vector boa ; inline
 
 : >vector ( seq -- vector ) V{ } clone-like ;
 

vm/bignum.c

@@ -1396,7 +1396,7 @@ allot_bignum_zeroed(bignum_length_type length, int negative_p)
 }
 
 #define BIGNUM_REDUCE_LENGTH(source, length) \
-     source = reallot_array(source,length + 1,0)
+     source = reallot_array(source,length + 1)
 
 /* allocates memory */
 bignum_type

vm/types.c

@@ -157,27 +157,18 @@ CELL allot_array_4(CELL v1, CELL v2, CELL v3, CELL v4)
 	return tag_object(a);
 }
 
-F_ARRAY *reallot_array(F_ARRAY* array, CELL capacity, CELL fill)
+F_ARRAY *reallot_array(F_ARRAY* array, CELL capacity)
 {
-	int i;
-	F_ARRAY* new_array;
-
 	CELL to_copy = array_capacity(array);
 	if(capacity < to_copy)
 		to_copy = capacity;
 
 	REGISTER_UNTAGGED(array);
-	REGISTER_ROOT(fill);
+	F_ARRAY* new_array = allot_array_internal(untag_header(array->header),capacity);
-
-	new_array = allot_array_internal(untag_header(array->header),capacity);
-
-	UNREGISTER_ROOT(fill);
 	UNREGISTER_UNTAGGED(array);
 
 	memcpy(new_array + 1,array + 1,to_copy * CELLS);
-
+	memset((char *)AREF(new_array,to_copy),'\0',(capacity - to_copy) * CELLS);
-	for(i = to_copy; i < capacity; i++)
-		put(AREF(new_array,i),fill);
 
 	return new_array;
 }
@@ -186,7 +177,7 @@ void primitive_resize_array(void)
 {
 	F_ARRAY* array = untag_array(dpop());
 	CELL capacity = unbox_array_size();
-	dpush(tag_object(reallot_array(array,capacity,F)));
+	dpush(tag_object(reallot_array(array,capacity)));
 }
 
 F_ARRAY *growable_array_add(F_ARRAY *result, CELL elt, CELL *result_count)
@@ -195,8 +186,7 @@ F_ARRAY *growable_array_add(F_ARRAY *result, CELL elt, CELL *result_count)
 
 	if(*result_count == array_capacity(result))
 	{
-		result = reallot_array(result,
+		result = reallot_array(result,*result_count * 2);
-			*result_count * 2,F);
 	}
 
 	UNREGISTER_ROOT(elt);
@@ -214,7 +204,7 @@ F_ARRAY *growable_array_append(F_ARRAY *result, F_ARRAY *elts, CELL *result_coun
 	CELL new_size = *result_count + elts_size;
 
 	if(new_size >= array_capacity(result))
-		result = reallot_array(result,new_size * 2,F);
+		result = reallot_array(result,new_size * 2);
 
 	UNREGISTER_UNTAGGED(elts);
 
@@ -433,7 +423,7 @@ void primitive_string(void)
 	dpush(tag_object(allot_string(length,initial)));
 }
 
-F_STRING* reallot_string(F_STRING* string, CELL capacity, CELL fill)
+F_STRING* reallot_string(F_STRING* string, CELL capacity)
 {
 	CELL to_copy = string_capacity(string);
 	if(capacity < to_copy)
@@ -462,7 +452,7 @@ F_STRING* reallot_string(F_STRING* string, CELL capacity, CELL fill)
 
 	REGISTER_UNTAGGED(string);
 	REGISTER_UNTAGGED(new_string);
-	fill_string(new_string,to_copy,capacity,fill);
+	fill_string(new_string,to_copy,capacity,'\0');
 	UNREGISTER_UNTAGGED(new_string);
 	UNREGISTER_UNTAGGED(string);
 
@@ -473,7 +463,7 @@ void primitive_resize_string(void)
 {
 	F_STRING* string = untag_string(dpop());
 	CELL capacity = unbox_array_size();
-	dpush(tag_object(reallot_string(string,capacity,0)));
+	dpush(tag_object(reallot_string(string,capacity)));
 }
 
 /* Some ugly macros to prevent a 2x code duplication */

vm/types.h

@@ -118,7 +118,7 @@ void primitive_tuple_layout(void);
 void primitive_byte_array(void);
 void primitive_clone(void);
 
-F_ARRAY *reallot_array(F_ARRAY* array, CELL capacity, CELL fill);
+F_ARRAY *reallot_array(F_ARRAY* array, CELL capacity);
 F_BYTE_ARRAY *reallot_byte_array(F_BYTE_ARRAY *array, CELL capacity);
 void primitive_resize_array(void);
 void primitive_resize_byte_array(void);
@@ -126,7 +126,7 @@ void primitive_resize_byte_array(void);
 F_STRING* allot_string_internal(CELL capacity);
 F_STRING* allot_string(CELL capacity, CELL fill);
 void primitive_string(void);
-F_STRING *reallot_string(F_STRING *string, CELL capacity, CELL fill);
+F_STRING *reallot_string(F_STRING *string, CELL capacity);
 void primitive_resize_string(void);
 
 F_STRING *memory_to_char_string(const char *string, CELL length);
@@ -177,7 +177,7 @@ F_ARRAY *growable_array_append(F_ARRAY *result, F_ARRAY *elts, CELL *result_coun
 	result = tag_object(growable_array_append(untag_object(result),elts,&result##_count))
 
 #define GROWABLE_ARRAY_TRIM(result) \
-	result = tag_object(reallot_array(untag_object(result),result##_count,F))
+	result = tag_object(reallot_array(untag_object(result),result##_count))
 
 /* Macros to simulate a byte vector in C */
 #define GROWABLE_BYTE_ARRAY(result) \