lref_t ltime_apply0(lref_t fn)
{
if (!PROCEDUREP(fn))
vmerror_wrong_type_n(1, fn);
flonum_t t = sys_runtime();
flonum_t gc_t = interp.gc_total_run_time;
size_t cells = interp.gc_total_cells_allocated;
size_t fops = CURRENT_TIB()->count_fop;
size_t frames = CURRENT_TIB()->count_enter_frame;
lref_t argv[6];
argv[0] = apply1(fn, 0, NULL);
argv[1] = flocons(sys_runtime() - t);
argv[2] = flocons(interp.gc_total_run_time - gc_t);
argv[3] = fixcons(interp.gc_total_cells_allocated - cells);
argv[4] = fixcons(CURRENT_TIB()->count_fop - fops);
argv[5] = fixcons(CURRENT_TIB()->count_enter_frame - frames);
return lvector(6, argv);
}
flonum_t time_since_launch()
{
return sys_runtime() - interp.launch_realtime;
}
void init0(int argc, _TCHAR * argv[], enum debug_flag_t initial_debug_flags)
{
global_environment_asserts();
previous_panic_handler = set_panic_handler(scan_panic_handler);
/** Initialize the interpreter globals */
memset(&interp, 0, sizeof(interp));
/* We need the debug flags pretty early on, so that we know how
* to set up debugger I/O. */
interp.debug_flags = debug_flags_from_environment(initial_debug_flags);
init_debugger_output();
interp.init_load_file_count = 0;
interp.intr_pending = VMINTR_NONE;
interp.intr_masked = false;
interp.launch_realtime = sys_runtime();
interp.fasl_package_list = NIL;
gc_protect(_T("fasl-package-list"), &interp.fasl_package_list, 1);
/* Statistics Counters */
interp.gc_heap_segment_size = DEFAULT_HEAP_SEGMENT_SIZE;
interp.gc_max_heap_segments = DEFAULT_MAX_HEAP_SEGMENTS;
interp.gc_current_heap_segments = 0;
interp.gc_heap_segments = NULL;
interp.gc_total_cells_allocated = 0;
interp.gc_malloc_bytes_threshold = (sizeof(struct lobject_t) * interp.gc_heap_segment_size);
interp.gc_total_run_time = 0.0;
interp.gc_start_time = 0.0;
interp.thread.fsp = &(interp.thread.frame_stack[FRAME_STACK_SIZE]);
interp.thread.frame = NULL;
process_vm_arguments(argc, argv);
if (interp.debug_flags != DF_NONE)
dscwritef(DF_ALWAYS, ("; DEBUG: debug_flags=0x~cx\n", interp.debug_flags));
/*** Create the gc heap and populate it with the standard objects */
gc_initialize_heap();
create_initial_packages();
init_base_scheme_objects();
init_stdio_ports();
register_main_subrs();
gc_protect(_T("handler-frames"), &(CURRENT_TIB()->handler_frames), 1);
gc_protect(_T("frame-stack"), (struct lobject_t **)&(CURRENT_TIB()->frame_stack[0]), sizeof(CURRENT_TIB()->frame_stack) / sizeof(lref_t));
accept_command_line_arguments(argc, argv);
load_init_load_files();
}