From 0a8e84cd5ba11dac479951ad55c86c98a78051b1 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 27 Mar 2005 06:52:13 +0000 Subject: [PATCH] runtime command line switches and CFactor cleanups --- library/cli.factor | 6 ++++- library/syntax/see.factor | 4 --- native/array.c | 15 +++++------ native/array.h | 3 --- native/bignum.c | 14 +++------- native/debug.c | 3 +++ native/factor.c | 56 ++++++++++++++++++++++++++++++++++----- native/factor.h | 5 ---- native/stack.c | 12 +++++---- native/stack.h | 6 +++-- native/types.c | 5 ++-- 11 files changed, 82 insertions(+), 47 deletions(-) diff --git a/library/cli.factor b/library/cli.factor index a5606df2a2..6e25c609f7 100644 --- a/library/cli.factor +++ b/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 ; diff --git a/library/syntax/see.factor b/library/syntax/see.factor index 9c290f297b..13fc7dc4db 100644 --- a/library/syntax/see.factor +++ b/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 -- ) diff --git a/native/array.c b/native/array.c index 98244fcdff..4d1516d1e8 100644 --- a/native/array.c +++ b/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) diff --git a/native/array.h b/native/array.h index 7e18d0c027..6aa6c07a1a 100644 --- a/native/array.h +++ b/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); diff --git a/native/bignum.c b/native/bignum.c index 1e9b9b5e24..2d976f3a1a 100644 --- a/native/bignum.c +++ b/native/bignum.c @@ -179,16 +179,13 @@ void primitive_bignum_shift(void) void primitive_bignum_less(void) { - F_ARRAY* y = to_bignum(dpop()); - F_ARRAY* x = to_bignum(dpop()); + GC_AND_POP_BIGNUMS(x,y); box_boolean(s48_bignum_compare(x,y) == bignum_comparison_less); } void primitive_bignum_lesseq(void) { - F_ARRAY* y = to_bignum(dpop()); - F_ARRAY* x = to_bignum(dpop()); - + GC_AND_POP_BIGNUMS(x,y); 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()); - F_ARRAY* x = to_bignum(dpop()); + GC_AND_POP_BIGNUMS(x,y); box_boolean(s48_bignum_compare(x,y) == bignum_comparison_greater); } void primitive_bignum_greatereq(void) { - F_ARRAY* y = to_bignum(dpop()); - F_ARRAY* x = to_bignum(dpop()); - + GC_AND_POP_BIGNUMS(x,y); switch(s48_bignum_compare(x,y)) { case bignum_comparison_less: diff --git a/native/debug.c b/native/debug.c index b160ddf8ff..845f3e9273 100644 --- a/native/debug.c +++ b/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 diff --git a/native/factor.c b/native/factor.c index b8d650bc31..7141bf9027 100644 --- a/native/factor.c +++ b/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_compiler(DEFAULT_ARENA); + init_arena(data_size); + 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 [ 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 .\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) diff --git a/native/factor.h b/native/factor.h index f32f546650..9297e3f311 100644 --- a/native/factor.h +++ b/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" diff --git a/native/stack.c b/native/stack.c index 4aef61f981..edb49928e4 100644 --- a/native/stack.c +++ b/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]; } diff --git a/native/stack.h b/native/stack.h index 3d31205ca1..cfa5222336 100644 --- a/native/stack.h +++ b/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); diff --git a/native/types.c b/native/types.c index d034b67be2..1f4245f4db 100644 --- a/native/types.c +++ b/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);