steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

runtime command line switches and CFactor cleanups

cvs
Slava Pestov 2005-03-27 06:52:13 +00:00
parent 4e3a5b3d1a
commit 0a8e84cd5b
11 changed files with 82 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
library/cli.factor
View File

@ -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 ;

4
library/syntax/see.factor
View File

@ -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 -- )

15
native/array.c
View File

@ -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)

3
native/array.h
View File

@ -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);

14
native/bignum.c
View File

@ -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:

3
native/debug.c
View File

@ -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

56
native/factor.c
View File

@ -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 <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)

5
native/factor.h
View File

@ -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"

12
native/stack.c
View File

@ -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];
}

6
native/stack.h
View File

@ -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);

5
native/types.c
View File

@ -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);