diff --git a/vm/debug.c b/vm/debug.c index 909cc8f710..172e889ddb 100755 --- a/vm/debug.c +++ b/vm/debug.c @@ -456,7 +456,7 @@ void factorbug(void) else if(strcmp(cmd,"x") == 0) exit(1); else if(strcmp(cmd,"im") == 0) - save_image(STR_FORMAT("fep.image")); + save_image(STRING_LITERAL("fep.image")); else if(strcmp(cmd,"data") == 0) dump_objects(-1); else if(strcmp(cmd,"refs") == 0) diff --git a/vm/factor.c b/vm/factor.c index 2f78a797d4..717322d1ad 100755 --- a/vm/factor.c +++ b/vm/factor.c @@ -2,7 +2,7 @@ void default_parameters(F_PARAMETERS *p) { - p->image = NULL; + p->image_path = NULL; /* We make a wild guess here that if we're running on ARM, we don't have a lot of memory. */ @@ -38,6 +38,41 @@ void default_parameters(F_PARAMETERS *p) p->stack_traces = true; } +INLINE bool factor_arg(const F_CHAR* str, const F_CHAR* arg, CELL* value) +{ + int val; + if(SSCANF(str,arg,&val) > 0) + { + *value = val; + return true; + } + else + return false; +} + +void init_parameters_from_args(F_PARAMETERS *p, int argc, F_CHAR **argv) +{ + default_parameters(p); + + int i; + + for(i = 1; i < argc; i++) + { + if(factor_arg(argv[i],STRING_LITERAL("-datastack=%d"),&p->ds_size)); + else if(factor_arg(argv[i],STRING_LITERAL("-retainstack=%d"),&p->rs_size)); + else if(factor_arg(argv[i],STRING_LITERAL("-generations=%d"),&p->gen_count)); + else if(factor_arg(argv[i],STRING_LITERAL("-young=%d"),&p->young_size)); + else if(factor_arg(argv[i],STRING_LITERAL("-aging=%d"),&p->aging_size)); + else if(factor_arg(argv[i],STRING_LITERAL("-tenured=%d"),&p->tenured_size)); + else if(factor_arg(argv[i],STRING_LITERAL("-codeheap=%d"),&p->code_size)); + else if(STRCMP(argv[i],STRING_LITERAL("-securegc")) == 0) p->secure_gc = true; + else if(STRCMP(argv[i],STRING_LITERAL("-fep")) == 0) p->fep = true; + else if(STRNCMP(argv[i],STRING_LITERAL("-i="),3) == 0) p->image_path = argv[i] + 3; + else if(STRCMP(argv[i],STRING_LITERAL("-console")) == 0) p->console = true; + else if(STRCMP(argv[i],STRING_LITERAL("-no-stack-traces")) == 0) p->stack_traces = false; + } +} + /* Do some initialization that we do once only */ void do_stage1_init(void) { @@ -51,7 +86,6 @@ void do_stage1_init(void) fflush(stdout); } -/* Get things started */ void init_factor(F_PARAMETERS *p) { /* Kilobytes */ @@ -70,8 +104,12 @@ void init_factor(F_PARAMETERS *p) /* OS-specific initialization */ early_init(); - if(p->image == NULL) - p->image = default_image_path(); + if(p->image_path == NULL) + p->image_path = default_image_path(); + + const F_CHAR *executable_path = vm_executable_path(); + if(executable_path) + p->executable_path = executable_path; srand(current_micros()); init_ffi(); @@ -93,6 +131,10 @@ void init_factor(F_PARAMETERS *p) userenv[OS_ENV] = tag_object(from_char_string(FACTOR_OS_STRING)); userenv[CELL_SIZE_ENV] = tag_fixnum(sizeof(CELL)); userenv[STACK_TRACES_ENV] = tag_boolean(p->stack_traces); + userenv[EXECUTABLE_ENV] = (p->executable_path ? + tag_object(from_native_string(p->executable_path)) : F); + userenv[ARGS_ENV] = F; + userenv[EMBEDDED_ENV] = F; /* We can GC now */ gc_off = false; @@ -101,57 +143,11 @@ void init_factor(F_PARAMETERS *p) do_stage1_init(); } -INLINE bool factor_arg(const F_CHAR* str, const F_CHAR* arg, CELL* value) +/* May allocate memory */ +void pass_args_to_factor(int argc, F_CHAR **argv) { - int val; - if(SSCANF(str,arg,&val) > 0) - { - *value = val; - return true; - } - else - return false; -} - -void init_factor_from_args(F_CHAR *image, int argc, F_CHAR **argv, bool embedded) -{ - F_PARAMETERS p; - default_parameters(&p); - - if(image) p.image = image; - - CELL i; - - posix_argc = argc; - posix_argv = safe_malloc(argc * sizeof(F_CHAR*)); - posix_argv[0] = safe_strdup(argv[0]); - - for(i = 1; i < argc; i++) - { - posix_argv[i] = safe_strdup(argv[i]); - if(factor_arg(argv[i],STR_FORMAT("-datastack=%d"),&p.ds_size)); - else if(factor_arg(argv[i],STR_FORMAT("-retainstack=%d"),&p.rs_size)); - else if(factor_arg(argv[i],STR_FORMAT("-generations=%d"),&p.gen_count)); - else if(factor_arg(argv[i],STR_FORMAT("-young=%d"),&p.young_size)); - else if(factor_arg(argv[i],STR_FORMAT("-aging=%d"),&p.aging_size)); - else if(factor_arg(argv[i],STR_FORMAT("-tenured=%d"),&p.tenured_size)); - else if(factor_arg(argv[i],STR_FORMAT("-codeheap=%d"),&p.code_size)); - else if(STRCMP(argv[i],STR_FORMAT("-securegc")) == 0) - p.secure_gc = true; - else if(STRCMP(argv[i],STR_FORMAT("-fep")) == 0) - p.fep = true; - else if(STRNCMP(argv[i],STR_FORMAT("-i="),3) == 0) - p.image = argv[i] + 3; - else if(STRCMP(argv[i],STR_FORMAT("-console")) == 0) - p.console = true; - else if(STRCMP(argv[i],STR_FORMAT("-no-stack-traces")) == 0) - p.stack_traces = false; - } - - init_factor(&p); - nest_stacks(); - F_ARRAY *args = allot_array(ARRAY_TYPE,argc,F); + int i; for(i = 1; i < argc; i++) { @@ -162,23 +158,31 @@ void init_factor_from_args(F_CHAR *image, int argc, F_CHAR **argv, bool embedded } userenv[ARGS_ENV] = tag_object(args); +} - const F_CHAR *executable_path = vm_executable_path(); - if(!executable_path) - executable_path = argv[0]; - - userenv[EXECUTABLE_ENV] = tag_object(from_native_string(executable_path)); - userenv[EMBEDDED_ENV] = (embedded ? T : F); - - if(p.fep) - factorbug(); +void start_factor(F_PARAMETERS *p) +{ + if(p->fep) factorbug(); + nest_stacks(); c_to_factor_toplevel(userenv[BOOT_ENV]); unnest_stacks(); +} - for(i = 0; i < argc; i++) - free(posix_argv[i]); - free(posix_argv); +void start_embedded_factor(F_PARAMETERS *p) +{ + userenv[EMBEDDED_ENV] = T; + start_factor(p); +} + +void start_standalone_factor(int argc, F_CHAR **argv) +{ + F_PARAMETERS p; + default_parameters(&p); + init_parameters_from_args(&p,argc,argv); + init_factor(&p); + pass_args_to_factor(argc,argv); + start_factor(&p); } char *factor_eval_string(char *string) diff --git a/vm/factor.h b/vm/factor.h index a0632c3138..a3de31a502 100644 --- a/vm/factor.h +++ b/vm/factor.h @@ -1,7 +1,10 @@ -int posix_argc; -F_CHAR **posix_argv; +DLLEXPORT void default_parameters(F_PARAMETERS *p); +DLLEXPORT void init_parameters_from_args(F_PARAMETERS *p, int argc, F_CHAR **argv); +DLLEXPORT void init_factor(F_PARAMETERS *p); +DLLEXPORT void pass_args_to_factor(int argc, F_CHAR **argv); +DLLEXPORT void start_embedded_factor(F_PARAMETERS *p); +DLLEXPORT void start_standalone_factor(int argc, F_CHAR **argv); -DLLEXPORT void init_factor_from_args(F_CHAR *image, int argc, F_CHAR **argv, bool embedded); DLLEXPORT char *factor_eval_string(char *string); DLLEXPORT void factor_eval_free(char *result); DLLEXPORT void factor_yield(void); diff --git a/vm/image.c b/vm/image.c index 6fb5910392..5f4492e537 100755 --- a/vm/image.c +++ b/vm/image.c @@ -75,10 +75,10 @@ INLINE void load_code_heap(FILE *file, F_HEADER *h, F_PARAMETERS *p) /* This function also initializes the data and code heaps */ void load_image(F_PARAMETERS *p) { - FILE *file = OPEN_READ(p->image); + FILE *file = OPEN_READ(p->image_path); if(file == NULL) { - print_string("Cannot open image file: "); print_native_string(p->image); nl(); + print_string("Cannot open image file: "); print_native_string(p->image_path); nl(); print_string(strerror(errno)); nl(); exit(1); } @@ -103,7 +103,7 @@ void load_image(F_PARAMETERS *p) relocate_code(); /* Store image path name */ - userenv[IMAGE_ENV] = tag_object(from_native_string(p->image)); + userenv[IMAGE_ENV] = tag_object(from_native_string(p->image_path)); } /* Save the current image to disk */ diff --git a/vm/image.h b/vm/image.h index 6e1b03af0d..e26a6bb5b4 100755 --- a/vm/image.h +++ b/vm/image.h @@ -26,7 +26,8 @@ typedef struct { } F_HEADER; typedef struct { - const F_CHAR* image; + const F_CHAR *image_path; + const F_CHAR *executable_path; CELL ds_size, rs_size; CELL gen_count, young_size, aging_size, tenured_size; CELL code_size; diff --git a/vm/main-unix.c b/vm/main-unix.c index 5af454e51f..b177c58eb3 100644 --- a/vm/main-unix.c +++ b/vm/main-unix.c @@ -2,6 +2,6 @@ int main(int argc, char **argv) { - init_factor_from_args(NULL,argc,argv,false); + start_standalone_factor(argc,argv); return 0; } diff --git a/vm/main-windows-ce.c b/vm/main-windows-ce.c index e67f08abb9..fc04d455db 100644 --- a/vm/main-windows-ce.c +++ b/vm/main-windows-ce.c @@ -1,5 +1,3 @@ -#include -#include #include "master.h" /* @@ -8,7 +6,9 @@ This would not be necessary if Windows CE had CommandLineToArgvW. - Based on MinGW's public domain char** version. */ + Based on MinGW's public domain char** version. + +*/ int __argc; wchar_t **__argv; @@ -128,7 +128,7 @@ WinMain( int nCmdShow) { parse_args(&__argc, &__argv, lpCmdLine); - init_factor_from_args(NULL,__argc,(LPWSTR*)__argv,false); + start_standalone_factor(__argc,(LPWSTR*)__argv); // memory leak from malloc, wcsdup return 0; } diff --git a/vm/main-windows-nt.c b/vm/main-windows-nt.c index ef66651846..a7bd335c82 100755 --- a/vm/main-windows-nt.c +++ b/vm/main-windows-nt.c @@ -19,7 +19,7 @@ int WINAPI WinMain( return 1; } - init_factor_from_args(NULL,nArgs,szArglist,false); + init_factor_from_args(nArgs,szArglist); LocalFree(szArglist); diff --git a/vm/os-unix.h b/vm/os-unix.h index b2a1735fd7..d2f34b4bc4 100755 --- a/vm/os-unix.h +++ b/vm/os-unix.h @@ -16,7 +16,7 @@ typedef char F_SYMBOL; #define string_to_native_alien(string) string_to_char_alien(string,true) #define unbox_symbol_string unbox_char_string -#define STR_FORMAT(string) string +#define STRING_LITERAL(string) string #define SSCANF sscanf #define STRCMP strcmp diff --git a/vm/os-windows.h b/vm/os-windows.h index c5a74e5b09..a9c3f6d803 100755 --- a/vm/os-windows.h +++ b/vm/os-windows.h @@ -11,7 +11,7 @@ typedef wchar_t F_CHAR; #define unbox_native_string unbox_u16_string #define string_to_native_alien(string) string_to_u16_alien(string,true) -#define STR_FORMAT(string) L##string +#define STRING_LITERAL(string) L##string #define MAX_UNICODE_PATH 32768 #define DLLEXPORT __declspec(dllexport) @@ -20,20 +20,18 @@ typedef wchar_t F_CHAR; #define STRNCMP wcsncmp #define STRDUP _wcsdup - #ifdef WIN64 #define CELL_FORMAT "%Iu" - #define CELL_HEX_FORMAT "%Ix" + #define CELL_HEX_FORMAT "%Ix" #define CELL_HEX_PAD_FORMAT "%016Ix" - #define FIXNUM_FORMAT "%Id" + #define FIXNUM_FORMAT "%Id" #else #define CELL_FORMAT "%lu" - #define CELL_HEX_FORMAT "%lx" + #define CELL_HEX_FORMAT "%lx" #define CELL_HEX_PAD_FORMAT "%08lx" - #define FIXNUM_FORMAT "%ld" + #define FIXNUM_FORMAT "%ld" #endif - #define OPEN_READ(path) _wfopen(path,L"rb") #define OPEN_WRITE(path) _wfopen(path,L"wb")