ScmObj Scm_Force(ScmObj obj) { if (!SCM_PROMISEP(obj)) { SCM_RETURN(obj); } else { ScmPromiseContent *c = SCM_PROMISE(obj)->content; if (c->forced) SCM_RETURN(c->code); else { ScmVM *vm = Scm_VM(); void *data[2]; data[0] = obj; data[1] = vm->handlers; if (c->owner == vm) { /* we already have the lock and evaluating this promise. */ c->count++; Scm_VMPushCC(force_cc, data, 2); SCM_RETURN(Scm_VMApply0(c->code)); } else { /* TODO: check if the executing thread terminates prematurely */ SCM_INTERNAL_MUTEX_LOCK(c->mutex); if (c->forced) { SCM_INTERNAL_MUTEX_UNLOCK(c->mutex); SCM_RETURN(c->code); } SCM_ASSERT(c->owner == NULL); c->owner = vm; install_release_thunk(vm, obj); c->count++; /* mutex is unlocked by force_cc. */ Scm_VMPushCC(force_cc, data, 2); SCM_RETURN(Scm_VMApply0(c->code)); } } } }
/* Returns the statHash */ ScmObj Scm_ProfilerRawResult(void) { ScmVM *vm = Scm_VM(); if (vm->prof == NULL) return SCM_FALSE; if (vm->prof->state == SCM_PROFILER_INACTIVE) return SCM_FALSE; if (vm->prof->state == SCM_PROFILER_RUNNING) Scm_ProfilerStop(); if (vm->prof->errorOccurred > 0) { Scm_Warn("profiler: An error has been occurred during saving profiling samples. The result may not be accurate"); } Scm_ProfilerCountBufferFlush(vm); /* collect samples in the current buffer */ collect_samples(vm->prof); /* collect samples in the saved file */ off_t off; SCM_SYSCALL(off, lseek(vm->prof->samplerFd, 0, SEEK_SET)); if (off == (off_t)-1) { Scm_ProfilerReset(); Scm_Error("profiler: seek failed in retrieving sample data"); } for (;;) { ssize_t r = read(vm->prof->samplerFd, vm->prof->samples, sizeof(ScmProfSample[1]) * SCM_PROF_SAMPLES_IN_BUFFER); if (r <= 0) break; vm->prof->currentSample = r / sizeof(ScmProfSample[1]); collect_samples(vm->prof); } vm->prof->currentSample = 0; if (ftruncate(vm->prof->samplerFd, 0) < 0) { Scm_SysError("profiler: failed to truncate temporary file"); } return SCM_OBJ(vm->prof->statHash); }
/*============================================================= * External API */ void Scm_ProfilerStart(void) { ScmVM *vm = Scm_VM(); ScmObj templat = Scm_StringAppendC(SCM_STRING(Scm_TmpDir()), "/gauche-profXXXXXX", -1, -1); char *templat_buf = Scm_GetString(SCM_STRING(templat)); /*mutable copy*/ if (!vm->prof) { vm->prof = SCM_NEW(ScmVMProfiler); vm->prof->state = SCM_PROFILER_INACTIVE; vm->prof->samplerFd = Scm_Mkstemp(templat_buf); vm->prof->currentSample = 0; vm->prof->totalSamples = 0; vm->prof->errorOccurred = 0; vm->prof->currentCount = 0; vm->prof->statHash = SCM_HASH_TABLE(Scm_MakeHashTableSimple(SCM_HASH_EQ, 0)); unlink(templat_buf); /* keep anonymous tmpfile */ } else if (vm->prof->samplerFd < 0) { vm->prof->samplerFd = Scm_Mkstemp(templat_buf); unlink(templat_buf); } if (vm->prof->state == SCM_PROFILER_RUNNING) return; vm->prof->state = SCM_PROFILER_RUNNING; vm->profilerRunning = TRUE; /* NB: this should be done globally!!! */ struct sigaction act; act.sa_handler = sampler_sample; sigfillset(&act.sa_mask); act.sa_flags = SA_RESTART; if (sigaction(SIGPROF, &act, NULL) < 0) { Scm_SysError("sigaction failed"); } ITIMER_START(); }
void Scm_ProfilerReset(void) { ScmVM *vm = Scm_VM(); if (vm->prof == NULL) return; if (vm->prof->state == SCM_PROFILER_INACTIVE) return; if (vm->prof->state == SCM_PROFILER_RUNNING) Scm_ProfilerStop(); if (vm->prof->samplerFd >= 0) { close(vm->prof->samplerFd); vm->prof->samplerFd = -1; #if defined(GAUCHE_WINDOWS) unlink(vm->prof->samplerFileName); #endif /* GAUCHE_WINDOWS */ } vm->prof->totalSamples = 0; vm->prof->currentSample = 0; vm->prof->errorOccurred = 0; vm->prof->currentCount = 0; vm->prof->statHash = SCM_HASH_TABLE(Scm_MakeHashTableSimple(SCM_HASH_EQ, 0)); vm->prof->state = SCM_PROFILER_INACTIVE; }
/* signal handler */ #if defined(GAUCHE_WINDOWS) static void sampler_sample(ScmVM *vm) #else /* !GAUCHE_WINDOWS */ static void sampler_sample(int sig) #endif /* !GAUCHE_WINDOWS */ { #if !defined(GAUCHE_WINDOWS) ScmVM *vm = Scm_VM(); #endif /* !GAUCHE_WINDOWS */ if (vm == NULL || vm->prof == NULL) return; if (vm->prof->state != SCM_PROFILER_RUNNING) return; if (vm->prof->currentSample >= SCM_PROF_SAMPLES_IN_BUFFER) { #if !defined(GAUCHE_WINDOWS) ITIMER_STOP(); #endif /* !GAUCHE_WINDOWS */ sampler_flush(vm); #if !defined(GAUCHE_WINDOWS) ITIMER_START(); #endif /* !GAUCHE_WINDOWS */ } int i = vm->prof->currentSample++; if (vm->base) { /* If vm->pc is RET and val0 is a subr, it is pretty likely that we're actually executing that subr. */ if (vm->pc && SCM_VM_INSN_CODE(*vm->pc) == SCM_VM_RET && SCM_SUBRP(vm->val0)) { vm->prof->samples[i].func = vm->val0; vm->prof->samples[i].pc = NULL; } else { vm->prof->samples[i].func = SCM_OBJ(vm->base); vm->prof->samples[i].pc = vm->pc; } } else { vm->prof->samples[i].func = SCM_FALSE; vm->prof->samples[i].pc = NULL; } vm->prof->totalSamples++; }
void *rts_scheduler (void *reso) { struct timeval currenttime; struct timeval targettime; struct timeval deltatime; struct timeval intervaltime; struct timespec waittime; qtime_t utime, qtime, etime; qentry_t *entry; qdata_t edata; qtype_t etype; #ifdef HAVE_GAUCHE char tmp[64] = "cm gauche vm"; ScmVM *vm; ScmVM *parentvm; int res = 0; parentvm = Scm_VM(); vm = Scm_NewVM(parentvm, SCM_MAKE_STR_IMMUTABLE(tmp)); // probably should check to make sure there is no error res = Scm_AttachVM(vm); #endif intervaltime.tv_sec = 0; intervaltime.tv_usec = (int32_t)reso; // 100=.1 millisecond deltatime.tv_sec = 0; while (TRUE) { pthread_mutex_lock(&state_lock); if (rts_state == RTS_STATUS_STOPPED) break; else while (rts_state == RTS_STATUS_PAUSED) pthread_cond_wait(&pause_cond, &state_lock); pthread_mutex_unlock(&state_lock); gettimeofday(¤ttime, NULL); //add_timevals(¤ttime, &intervaltime, &targettime); timeradd(¤ttime, &intervaltime, &targettime); while (TRUE) { pthread_mutex_lock(&queue_lock); if (rts_queue_empty_p()) { pthread_mutex_unlock(&queue_lock); break; } entry=rts_queue_pop(); qtime=qentry_time(entry); utime=rts_scheduler_time_usec(); if (qtime>utime) { rts_queue_prepend(entry); pthread_mutex_unlock(&queue_lock); break; } // drop entries more than a second late (?) if (qtime<(utime-1000000)) { qentry_free(entry); pthread_mutex_unlock(&queue_lock); break; } edata=qentry_data(entry); etype=qentry_type(entry); //etime=(rts_tunit == TIME_UNIT_MSEC) ? (utime/1000) : utime; // use queue time not clock time! etime=(rts_tunit == TIME_UNIT_MSEC) ? (qtime/1000) : qtime; qentry_free(entry); pthread_mutex_unlock(&queue_lock); // queue unlocked during callback, enqueue should always lock pthread_mutex_lock(&lisp_lock); (*rts_callb) (edata, etype, etime); pthread_mutex_unlock(&lisp_lock); } gettimeofday(¤ttime, NULL); //fprintf(log_file, "%f \n", currenttime.tv_usec / 1000.0); //find_positive_delta(&targettime, ¤ttime, &deltatime); timersub(&targettime, ¤ttime, &deltatime); if (deltatime.tv_usec > 0) { waittime.tv_sec = deltatime.tv_sec; waittime.tv_nsec = deltatime.tv_usec * 1000L; //TIMEVAL_TO_TIMESPEC(&deltatime, &waittime); nanosleep(&waittime, NULL); } } rts_scheduler_reset(); fclose(log_file); pthread_exit(NULL); }
static ScmObj mutex_locker(ScmObj *args, int argc, void *mutex) { return Scm_MutexLock((ScmMutex*)mutex, SCM_FALSE, Scm_VM()); }
void further_options(const char *optarg) { ScmVM *vm = Scm_VM(); if (strcmp(optarg, "no-inline-globals") == 0) { SCM_VM_COMPILER_FLAG_SET(vm, SCM_COMPILE_NOINLINE_GLOBALS); } else if (strcmp(optarg, "no-inline-locals") == 0) { SCM_VM_COMPILER_FLAG_SET(vm, SCM_COMPILE_NOINLINE_LOCALS); } else if (strcmp(optarg, "no-inline-constants") == 0) { SCM_VM_COMPILER_FLAG_SET(vm, SCM_COMPILE_NOINLINE_CONSTS); } else if (strcmp(optarg, "no-inline") == 0) { SCM_VM_COMPILER_FLAG_SET(vm, SCM_COMPILE_NOINLINE_GLOBALS); SCM_VM_COMPILER_FLAG_SET(vm, SCM_COMPILE_NOINLINE_LOCALS); SCM_VM_COMPILER_FLAG_SET(vm, SCM_COMPILE_NOINLINE_CONSTS); } else if (strcmp(optarg, "no-post-inline-pass") == 0) { SCM_VM_COMPILER_FLAG_SET(vm, SCM_COMPILE_NO_POST_INLINE_OPT); } else if (strcmp(optarg, "no-lambda-lifting-pass") == 0) { SCM_VM_COMPILER_FLAG_SET(vm, SCM_COMPILE_NO_LIFTING); } else if (strcmp(optarg, "no-source-info") == 0) { SCM_VM_COMPILER_FLAG_SET(vm, SCM_COMPILE_NOSOURCE); } else if (strcmp(optarg, "load-verbose") == 0) { SCM_VM_RUNTIME_FLAG_SET(vm, SCM_LOAD_VERBOSE); } else if (strcmp(optarg, "include-verbose") == 0) { SCM_VM_COMPILER_FLAG_SET(vm, SCM_COMPILE_INCLUDE_VERBOSE); } else if (strcmp(optarg, "case-fold") == 0) { SCM_VM_RUNTIME_FLAG_SET(vm, SCM_CASE_FOLD); } else if (strcmp(optarg, "warn-legacy-syntax") == 0) { Scm_SetReaderLexicalMode(SCM_INTERN("warn-legacy")); } else if (strcmp(optarg, "test") == 0) { test_mode = TRUE; } /* For development; not for public use */ else if (strcmp(optarg, "collect-stats") == 0) { stats_mode = TRUE; SCM_VM_RUNTIME_FLAG_SET(vm, SCM_COLLECT_VM_STATS); } /* For development; not for public use */ else if (strcmp(optarg, "no-combine-instructions") == 0) { SCM_VM_COMPILER_FLAG_SET(vm, SCM_COMPILE_NOCOMBINE); } /* For development; not for public use */ else if (strcmp(optarg, "debug-compiler") == 0) { SCM_VM_COMPILER_FLAG_SET(vm, SCM_COMPILE_SHOWRESULT); } /* Experimental */ else if (strcmp(optarg, "limit-module-mutation") == 0) { SCM_VM_RUNTIME_FLAG_SET(vm, SCM_LIMIT_MODULE_MUTATION); } /* Experimental */ else if (strcmp(optarg, "c-expr") == 0) { SCM_VM_COMPILER_FLAG_SET(vm, SCM_COMPILE_ENABLE_CEXPR); } else { fprintf(stderr, "unknown -f option: %s\n", optarg); fprintf(stderr, "supported options are: -fcase-fold, -fload-verbose, -finclude-verbose, -fno-inline, -fno-inline-globals, -fno-inline-locals, -fno-inline-constants, -fno-source-info, -fno-post-inline-pass, -fno-lambda-lifting-pass, -fwarn-legacy-syntax, or -ftest\n"); exit(1); } }
} else if (access("../../src/gauche/config.h", R_OK) == 0 && access("../../libsrc/srfi-1.scm", R_OK) == 0 && access("../../lib/srfi-0.scm", R_OK) == 0) { Scm_AddLoadPath("../../src", FALSE); Scm_AddLoadPath("../../libsrc", FALSE); Scm_AddLoadPath("../../lib", FALSE); } /* Also set a feature identifier gauche.in-place, so that other modules may initialize differently if needed. */ Scm_AddFeature("gauche.in-place", NULL); } /* Cleanup */ void cleanup_main(void *data SCM_UNUSED) { ScmVM *vm = Scm_VM(); if (profiling_mode) { Scm_ProfilerStop(); Scm_EvalCString("(profiler-show)", SCM_OBJ(Scm_GaucheModule()), NULL); /* ignore errors */ } /* EXPERIMENTAL */ if (stats_mode) { fprintf(stderr, "\n;; Statistics (*: main thread only):\n"); fprintf(stderr, ";; GC: %zubytes heap, %zubytes allocated\n", GC_get_heap_size(), GC_get_total_bytes()); fprintf(stderr,