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(); }