vm/factor.c

   1 #include "master.h"
   2
   3 void default_parameters(F_PARAMETERS *p)
   4 {
   5         p->image_path = NULL;
   6
   7         /* We make a wild guess here that if we're running on ARM, we don't
   8         have a lot of memory. */
   9 #ifdef FACTOR_ARM
  10         p->ds_size = 8 * CELLS;
  11         p->rs_size = 8 * CELLS;
  12
  13         p->gen_count = 2;
  14         p->code_size = 4;
  15         p->young_size = 1;
  16         p->aging_size = 1;
  17         p->tenured_size = 6;
  18 #else
  19         p->ds_size = 32 * CELLS;
  20         p->rs_size = 32 * CELLS;
  21
  22         p->gen_count = 3;
  23         p->code_size = 8 * CELLS;
  24         p->young_size = CELLS / 4;
  25         p->aging_size = CELLS / 2;
  26         p->tenured_size = 4 * CELLS;
  27 #endif
  28
  29         p->secure_gc = false;
  30         p->fep = false;
  31
  32 #ifdef WINDOWS
  33         p->console = false;
  34 #else
  35         p->console = true;
  36 #endif
  37
  38         p->stack_traces = true;
  39 }
  40
  41 INLINE bool factor_arg(const F_CHAR* str, const F_CHAR* arg, CELL* value)
  42 {
  43         int val;
  44         if(SSCANF(str,arg,&val) > 0)
  45         {
  46                 *value = val;
  47                 return true;
  48         }
  49         else
  50                 return false;
  51 }
  52
  53 void init_parameters_from_args(F_PARAMETERS *p, int argc, F_CHAR **argv)
  54 {
  55         default_parameters(p);
  56
  57         int i;
  58
  59         for(i = 1; i < argc; i++)
  60         {
  61                 if(factor_arg(argv[i],STRING_LITERAL("-datastack=%d"),&p->ds_size));
  62                 else if(factor_arg(argv[i],STRING_LITERAL("-retainstack=%d"),&p->rs_size));
  63                 else if(factor_arg(argv[i],STRING_LITERAL("-generations=%d"),&p->gen_count));
  64                 else if(factor_arg(argv[i],STRING_LITERAL("-young=%d"),&p->young_size));
  65                 else if(factor_arg(argv[i],STRING_LITERAL("-aging=%d"),&p->aging_size));
  66                 else if(factor_arg(argv[i],STRING_LITERAL("-tenured=%d"),&p->tenured_size));
  67                 else if(factor_arg(argv[i],STRING_LITERAL("-codeheap=%d"),&p->code_size));
  68                 else if(STRCMP(argv[i],STRING_LITERAL("-securegc")) == 0) p->secure_gc = true;
  69                 else if(STRCMP(argv[i],STRING_LITERAL("-fep")) == 0) p->fep = true;
  70                 else if(STRNCMP(argv[i],STRING_LITERAL("-i="),3) == 0) p->image_path = argv[i] + 3;
  71                 else if(STRCMP(argv[i],STRING_LITERAL("-console")) == 0) p->console = true;
  72                 else if(STRCMP(argv[i],STRING_LITERAL("-no-stack-traces")) == 0) p->stack_traces = false;
  73         }
  74 }
  75
  76 /* Do some initialization that we do once only */
  77 void do_stage1_init(void)
  78 {
  79         print_string("*** Stage 2 early init... ");
  80         fflush(stdout);
  81
  82         compile_all_words();
  83         userenv[STAGE2_ENV] = T;
  84
  85         print_string("done\n");
  86         fflush(stdout);
  87 }
  88
  89 void init_factor(F_PARAMETERS *p)
  90 {
  91         /* Kilobytes */
  92         p->ds_size = align_page(p->ds_size << 10);
  93         p->rs_size = align_page(p->rs_size << 10);
  94
  95         /* Megabytes */
  96         p->young_size <<= 20;
  97         p->aging_size <<= 20;
  98         p->tenured_size <<= 20;
  99         p->code_size <<= 20;
 100
 101         /* Disable GC during init as a sanity check */
 102         gc_off = true;
 103
 104         /* OS-specific initialization */
 105         early_init();
 106
 107         if(p->image_path == NULL)
 108                 p->image_path = default_image_path();
 109
 110         const F_CHAR *executable_path = vm_executable_path();
 111         if(executable_path)
 112                 p->executable_path = executable_path;
 113
 114         srand(current_micros());
 115         init_ffi();
 116         init_stacks(p->ds_size,p->rs_size);
 117         load_image(p);
 118         init_c_io();
 119         init_signals();
 120
 121         if(p->console)
 122                 open_console();
 123
 124         stack_chain = NULL;
 125         profiling_p = false;
 126         performing_gc = false;
 127         last_code_heap_scan = NURSERY;
 128         collecting_aging_again = false;
 129
 130         userenv[CPU_ENV] = tag_object(from_char_string(FACTOR_CPU_STRING));
 131         userenv[OS_ENV] = tag_object(from_char_string(FACTOR_OS_STRING));
 132         userenv[CELL_SIZE_ENV] = tag_fixnum(sizeof(CELL));
 133         userenv[STACK_TRACES_ENV] = tag_boolean(p->stack_traces);
 134         userenv[EXECUTABLE_ENV] = (p->executable_path ?
 135                 tag_object(from_native_string(p->executable_path)) : F);
 136         userenv[ARGS_ENV] = F;
 137         userenv[EMBEDDED_ENV] = F;
 138
 139         /* We can GC now */
 140         gc_off = false;
 141
 142         if(!stage2)
 143                 do_stage1_init();
 144 }
 145
 146 /* May allocate memory */
 147 void pass_args_to_factor(int argc, F_CHAR **argv)
 148 {
 149         F_ARRAY *args = allot_array(ARRAY_TYPE,argc,F);
 150         int i;
 151
 152         for(i = 1; i < argc; i++)
 153         {
 154                 REGISTER_UNTAGGED(args);
 155                 CELL arg = tag_object(from_native_string(argv[i]));
 156                 UNREGISTER_UNTAGGED(args);
 157                 set_array_nth(args,i,arg);
 158         }
 159
 160         userenv[ARGS_ENV] = tag_object(args);
 161 }
 162
 163 void start_factor(F_PARAMETERS *p)
 164 {
 165         if(p->fep) factorbug();
 166
 167         nest_stacks();
 168         c_to_factor_toplevel(userenv[BOOT_ENV]);
 169         unnest_stacks();
 170 }
 171
 172 void start_embedded_factor(F_PARAMETERS *p)
 173 {
 174         userenv[EMBEDDED_ENV] = T;
 175         start_factor(p);
 176 }
 177
 178 void start_standalone_factor(int argc, F_CHAR **argv)
 179 {
 180         F_PARAMETERS p;
 181         default_parameters(&p);
 182         init_parameters_from_args(&p,argc,argv);
 183         init_factor(&p);
 184         pass_args_to_factor(argc,argv);
 185         start_factor(&p);
 186 }
 187
 188 char *factor_eval_string(char *string)
 189 {
 190         char* (*callback)(char*) = alien_offset(userenv[EVAL_CALLBACK_ENV]);
 191         return callback(string);
 192 }
 193
 194 void factor_eval_free(char *result)
 195 {
 196         free(result);
 197 }
 198
 199 void factor_yield(void)
 200 {
 201         void (*callback)() = alien_offset(userenv[YIELD_CALLBACK_ENV]);
 202         callback();
 203 }
 204
 205 void factor_sleep(long us)
 206 {
 207         void (*callback)() = alien_offset(userenv[SLEEP_CALLBACK_ENV]);
 208         callback(us);
 209 }