runtime command line switches and CFactor cleanups

library/cli.factor

@@ -36,7 +36,11 @@ kernel-internals ;
 : cli-arg ( argument -- argument )
     #! Handle a command-line argument. If the argument was
     #! consumed, returns f. Otherwise returns the argument.
-    dup f-or-"" [ "-" ?string-head [ cli-param f ] when ] unless ;
+    #! Parameters that start with + are runtime parameters.
+    dup f-or-"" [
+        "-" ?string-head [ cli-param f ] when
+        dup [ "+" ?string-head [ drop f ] when ] when
+    ] unless ;
 
 : parse-switches ( args -- args )
     [ cli-arg ] map ;

library/syntax/see.factor

@@ -56,7 +56,6 @@ presentation streams unparser words ;
 
 : stack-effect. ( word -- )
     dup "stack-effect" word-prop [
-        " " write
         [ CHAR: ( , , CHAR: ) , ] make-string
         comment.
     ] [
@@ -77,9 +76,6 @@ presentation streams unparser words ;
 
 : definer. ( word -- ) dup definer word-bl word-bl ;
 
-: (see) ( word -- )
-    dup prettyprint-IN: dup definer. stack-effect. terpri ;
-
 GENERIC: (see) ( word -- )
 
 M: compound (see) ( word -- )

native/array.c

@@ -1,7 +1,12 @@
 #include "factor.h"
 
+/* the array is full of undefined data, and must be correctly filled before the
+next GC. */
 F_ARRAY* allot_array(CELL type, CELL capacity)
 {
+	if(capacity < 0)
+		general_error(ERROR_NEGATIVE_ARRAY_SIZE,tag_fixnum(capacity));
+
 	F_ARRAY* array = allot_object(type,sizeof(F_ARRAY) + capacity * CELLS);
 	array->capacity = tag_fixnum(capacity);
 	return array;
@@ -17,20 +22,14 @@ F_ARRAY* array(CELL type, CELL capacity, CELL fill)
 
 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(ARRAY_TYPE,capacity,F)));
+	dpush(tag_object(array(ARRAY_TYPE,to_fixnum(dpop()),F)));
 }
 
 void primitive_tuple(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(TUPLE_TYPE,capacity,F)));
+	dpush(tag_object(array(TUPLE_TYPE,to_fixnum(dpop()),F)));
 }
 
 F_ARRAY* grow_array(F_ARRAY* array, CELL capacity, CELL fill)

native/array.h

@@ -20,9 +20,6 @@ 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) + \
-	array_capacity((F_ARRAY*)(pointer)) * CELLS)
-
 INLINE CELL array_capacity(F_ARRAY* array)
 {
 	return untag_fixnum_fast(array->capacity);

native/bignum.c

@@ -179,16 +179,13 @@ void primitive_bignum_shift(void)
 
 void primitive_bignum_less(void)
 {
-	F_ARRAY* y = to_bignum(dpop());
+	GC_AND_POP_BIGNUMS(x,y);
-	F_ARRAY* x = to_bignum(dpop());
 	box_boolean(s48_bignum_compare(x,y) == bignum_comparison_less);
 }
 
 void primitive_bignum_lesseq(void)
 {
-	F_ARRAY* y = to_bignum(dpop());
+	GC_AND_POP_BIGNUMS(x,y);
-	F_ARRAY* x = to_bignum(dpop());
-
 	switch(s48_bignum_compare(x,y))
 	{
 	case bignum_comparison_less:
@@ -206,16 +203,13 @@ void primitive_bignum_lesseq(void)
 
 void primitive_bignum_greater(void)
 {
-	F_ARRAY* y = to_bignum(dpop());
+	GC_AND_POP_BIGNUMS(x,y);
-	F_ARRAY* x = to_bignum(dpop());
 	box_boolean(s48_bignum_compare(x,y) == bignum_comparison_greater);
 }
 
 void primitive_bignum_greatereq(void)
 {
-	F_ARRAY* y = to_bignum(dpop());
+	GC_AND_POP_BIGNUMS(x,y);
-	F_ARRAY* x = to_bignum(dpop());
-
 	switch(s48_bignum_compare(x,y))
 	{
 	case bignum_comparison_less:

native/debug.c

@@ -1,5 +1,8 @@
 #include "factor.h"
 
+/* Implements some Factor library words in C, to dump a stack in a semi-human-readable
+form without any Factor code executing.. This is not used during normal execution, only
+when the runtime dies. */
 bool equals(CELL obj1, CELL obj2)
 {
 	if(type_of(obj1) == STRING_TYPE

native/factor.c

@@ -1,11 +1,12 @@
 #include "factor.h"
 
-void init_factor(char* image)
+void init_factor(char* image, CELL ds_size, CELL cs_size,
+	CELL data_size, CELL code_size)
 {
-	init_arena(DEFAULT_ARENA);
+	init_arena(data_size);
-	init_compiler(DEFAULT_ARENA);
+	init_compiler(code_size);
 	load_image(image);
-	init_stacks();
+	init_stacks(ds_size,cs_size);
 	init_io();
 	init_signals();
 
@@ -26,19 +27,60 @@ void init_factor(char* image)
 #endif
 }
 
+INLINE bool factor_arg(const char* str, const char* arg, CELL* value)
+{
+	int val;
+	if(sscanf(str,arg,&val))
+	{
+		*value = val;
+		return true;
+	}
+	else
+		return false;
+}
+
 int main(int argc, char** argv)
 {
+	CELL ds_size = 2048;
+	CELL cs_size = 2048;
+	CELL data_size = 16;
+	CELL code_size = 2;
 	CELL args;
+	CELL i;
 
 	if(argc == 1)
 	{
 		printf("Usage: factor <image file> [ parameters ... ]\n");
-		printf("\n");
+		printf("Runtime options -- n is a number:\n");
-		
+		printf(" +Dn   Data stack size, kilobytes\n");
+		printf(" +Cn   Call stack size, kilobytes\n");
+		printf(" +Mn   Data heap size, megabytes\n");
+		printf(" +Xn   Code heap size, megabytes\n");
+		printf("Other options are handled by the Factor library.\n");
+		printf("See the documentation for details.\n");
+		printf("Send bug reports to Slava Pestov <slava@jedit.org>.\n");
 		return 1;
 	}
 
-	init_factor(argv[1]);
+	for(i = 1; i < argc; i++)
+	{
+		if(factor_arg(argv[i],"+D%d",&ds_size)) continue;
+		if(factor_arg(argv[i],"+C%d",&cs_size)) continue;
+		if(factor_arg(argv[i],"+M%d",&data_size)) continue;
+		if(factor_arg(argv[i],"+X%d",&code_size)) continue;
+
+		if(strncmp(argv[i],"+",1) == 0)
+		{
+			printf("Unknown option: %s\n",argv[i]);
+			return 1;
+		}
+	}
+
+	init_factor(argv[1],
+		ds_size * 1024,
+		cs_size * 1024,
+		data_size * 1024 * 1024,
+		code_size * 1024 * 1024);
 
 	args = F;
 	while(--argc != 0)

native/factor.h

@@ -110,11 +110,6 @@ typedef signed long long s64;
 /* must always be 8 bits */
 typedef unsigned char BYTE;
 
-/* Memory areas */
-#define DEFAULT_ARENA (16 * 1024 * 1024)
-#define COMPILE_ZONE_SIZE (8 * 1024 * 1024)
-#define STACK_SIZE (2 * 1024 * 1024)
-
 #include "memory.h"
 #include "error.h"
 #include "types.h"

native/stack.c

@@ -14,19 +14,21 @@ void fix_stacks(void)
 {
 	if(STACK_UNDERFLOW(ds,ds_bot))
 		reset_datastack();
-	else if(STACK_OVERFLOW(ds,ds_bot))
+	else if(STACK_OVERFLOW(ds,ds_bot,ds_size))
 		reset_datastack();
 	else if(STACK_UNDERFLOW(cs,cs_bot))
 		reset_callstack();
-	else if(STACK_OVERFLOW(cs,cs_bot))
+	else if(STACK_OVERFLOW(cs,cs_bot,cs_size))
 		reset_callstack();
 }
 
-void init_stacks(void)
+void init_stacks(CELL ds_size_, CELL cs_size_)
 {
-	ds_bot = (CELL)alloc_guarded(STACK_SIZE);
+	ds_size = ds_size_;
+	cs_size = cs_size_;
+	ds_bot = (CELL)alloc_guarded(ds_size);
 	reset_datastack();
-	cs_bot = (CELL)alloc_guarded(STACK_SIZE);
+	cs_bot = (CELL)alloc_guarded(cs_size);
 	reset_callstack();
 	callframe = userenv[BOOT_ENV];
 }

native/stack.h

@@ -1,10 +1,12 @@
+CELL ds_size, cs_size;
+
 #define STACK_UNDERFLOW(stack,bot) ((stack) + CELLS < UNTAG(bot))
-#define STACK_OVERFLOW(stack,bot) ((stack) + CELLS >= UNTAG(bot) + STACK_SIZE)
+#define STACK_OVERFLOW(stack,bot,top) ((stack) + CELLS >= UNTAG(bot) + top)
 
 void reset_datastack(void);
 void reset_callstack(void);
 void fix_stacks(void);
-void init_stacks(void);
+void init_stacks(CELL ds_size, CELL cs_size);
 
 void primitive_drop(void);
 void primitive_dup(void);

native/types.c

@@ -10,7 +10,7 @@ CELL object_size(CELL pointer)
 		size = 0;
 		break;
 	case BIGNUM_TYPE:
-		size = ASIZE(UNTAG(pointer));
+		size = untagged_object_size(UNTAG(pointer));
 		break;
 	case CONS_TYPE:
 		size = sizeof(F_CONS);
@@ -54,7 +54,8 @@ CELL untagged_object_size(CELL pointer)
 	case ARRAY_TYPE:
 	case BIGNUM_TYPE:
 	case TUPLE_TYPE:
-		size = ASIZE(pointer);
+		size = align8(sizeof(F_ARRAY) +
+			array_capacity((F_ARRAY*)(pointer)) * CELLS);
 		break;
 	case HASHTABLE_TYPE:
 		size = sizeof(F_HASHTABLE);