1: /*
    2:  * prof.c - profiler
    3:  *
    4:  *   Copyright (c) 2005-2007  Shiro Kawai  <shiro@acm.org>
    5:  * 
    6:  *   Redistribution and use in source and binary forms, with or without
    7:  *   modification, are permitted provided that the following conditions
    8:  *   are met:
    9:  * 
   10:  *   1. Redistributions of source code must retain the above copyright
   11:  *      notice, this list of conditions and the following disclaimer.
   12:  *
   13:  *   2. Redistributions in binary form must reproduce the above copyright
   14:  *      notice, this list of conditions and the following disclaimer in the
   15:  *      documentation and/or other materials provided with the distribution.
   16:  *
   17:  *   3. Neither the name of the authors nor the names of its contributors
   18:  *      may be used to endorse or promote products derived from this
   19:  *      software without specific prior written permission.
   20:  *
   21:  *   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22:  *   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23:  *   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
   24:  *   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
   25:  *   OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
   26:  *   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
   27:  *   TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
   28:  *   PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
   29:  *   LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
   30:  *   NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
   31:  *   SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
   32:  *
   33:  *  $Id: prof.c,v 1.10 2007/08/24 23:55:43 shirok Exp $
   34:  */
   35: 
   36: #define LIBGAUCHE_BODY
   37: #include "gauche.h"
   38: #include "gauche/vm.h"
   39: #include "gauche/code.h"
   40: #include "gauche/vminsn.h"
   41: #include "gauche/prof.h"
   42: 
   43: #ifdef GAUCHE_PROFILE
   44: 
   45: /* WARNING: duplicated code - see signal.c; we should integrate them later */
   46: #ifdef GAUCHE_USE_PTHREADS
   47: #define SIGPROCMASK pthread_sigmask
   48: #else
   49: #define SIGPROCMASK sigprocmask
   50: #endif
   51: 
   52: /*=============================================================
   53:  * Interval timer operation
   54:  */
   55: 
   56: #define SAMPLING_PERIOD 10000
   57: 
   58: #define ITIMER_START()                                  \
   59:     do {                                                \
   60:         struct itimerval tval, oval;                    \
   61:         tval.it_interval.tv_sec = 0;                    \
   62:         tval.it_interval.tv_usec = SAMPLING_PERIOD;     \
   63:         tval.it_value.tv_sec = 0;                       \
   64:         tval.it_value.tv_usec = SAMPLING_PERIOD;        \
   65:         setitimer(ITIMER_PROF, &tval, &oval);           \
   66:     } while (0)
   67: 
   68: #define ITIMER_STOP()                           \
   69:     do {                                        \
   70:         struct itimerval tval, oval;            \
   71:         tval.it_interval.tv_sec = 0;            \
   72:         tval.it_interval.tv_usec = 0;           \
   73:         tval.it_value.tv_sec = 0;               \
   74:         tval.it_value.tv_usec = 0;              \
   75:         setitimer(ITIMER_PROF, &tval, &oval);   \
   76:     } while (0)
   77: 
   78: /*=============================================================
   79:  * Statistic sampler
   80:  */
   81: 
   82: /* Flush sample buffer to the file.
   83:    We save the address value to the file.  The address should also be
   84:    recorded in the call counter, thus we don't need to worry about
   85:    the addressed object being GCed. */
   86: 
   87: #define CHK(exp)  do { if (!(exp)) goto bad; } while (0)
   88: 
   89: static void sampler_flush(ScmVM *vm)
   90: {
   91:     int nsamples;
   92:     ssize_t r;
   93:     
   94:     if (vm->prof == NULL) return; /* for safety */
   95:     if (vm->prof->samplerFd < 0 || vm->prof->currentSample == 0) return;
   96: 
   97:     nsamples = vm->prof->currentSample;
   98:     r = write(vm->prof->samplerFd, vm->prof->samples,
   99:               nsamples * sizeof(ScmProfSample[1]));
  100:     if (r == (ssize_t)-1) {
  101:         vm->prof->errorOccurred++;
  102:     }
  103:     vm->prof->currentSample = 0;
  104:     return;
  105: }
  106: 
  107: /* signal handler */
  108: static void sampler_sample(int sig)
  109: {
  110:     ScmVM *vm;
  111:     int i;
  112: 
  113:     vm = Scm_VM();
  114:     if (vm->prof == NULL) return;
  115:     if (vm->prof->state != SCM_PROFILER_RUNNING) return;
  116: 
  117:     if (vm->prof->currentSample >= SCM_PROF_SAMPLES_IN_BUFFER) {
  118:         ITIMER_STOP();
  119:         sampler_flush(vm);
  120:         ITIMER_START();
  121:     }
  122: 
  123:     i = vm->prof->currentSample++;
  124:     if (vm->base) {
  125:         /* If vm->pc is RET and val0 is a subr, it is pretty likely that
  126:            we're actually executing that subr. */
  127:         if (vm->pc && SCM_VM_INSN_CODE(*vm->pc) == SCM_VM_RET
  128:             && SCM_SUBRP(vm->val0)) {
  129:             vm->prof->samples[i].func = vm->val0;
  130:             vm->prof->samples[i].pc = NULL;
  131:         } else {
  132:             vm->prof->samples[i].func = SCM_OBJ(vm->base);
  133:             vm->prof->samples[i].pc = vm->pc;
  134:         }
  135:     } else {
  136:         vm->prof->samples[i].func = SCM_FALSE;
  137:         vm->prof->samples[i].pc = NULL;
  138:     }
  139:     vm->prof->totalSamples++;
  140: }
  141: 
  142: /* register samples into the stat table.  Called from Scm_ProfilerResult */
  143: void collect_samples(ScmVMProfiler *prof)
  144: {
  145:     int i, cnt;
  146:     for (i=0; i<prof->currentSample; i++) {
  147:         ScmHashEntry *e = Scm_HashTableGet(prof->statHash,
  148:                                            prof->samples[i].func);
  149:         if (e == NULL) {
  150:             /* NB: just for now */
  151:             Scm_Warn("profiler: uncounted object appeared in a sample: %p (%S)\n",
  152:                      prof->samples[i].func, prof->samples[i].func);
  153:         } else {
  154:             SCM_ASSERT(SCM_PAIRP(e->value));
  155:             cnt = SCM_INT_VALUE(SCM_CDR(e->value)) + 1;
  156:             SCM_SET_CDR(e->value, SCM_MAKE_INT(cnt));
  157:         }
  158:     }
  159: }
  160: 
  161: /*=============================================================
  162:  * Call Counter
  163:  */
  164: 
  165: /* Inserting data into array is done in a macro (prof.h).  It calls
  166:    this flush routine when the array gets full. */
  167: 
  168: void Scm_ProfilerCountBufferFlush(ScmVM *vm)
  169: {
  170:     int i, ncounts;
  171:     ScmObj func;
  172:     sigset_t set;
  173: 
  174:     if (vm->prof == NULL) return; /* for safety */
  175:     if (vm->prof->currentCount == 0) return;
  176: 
  177:     /* suspend itimer during hash table operation */
  178:     sigemptyset(&set);
  179:     sigaddset(&set, SIGPROF);
  180:     SIGPROCMASK(SIG_BLOCK, &set, NULL);
  181: 
  182:     ncounts = vm->prof->currentCount;
  183:     for (i=0; i<ncounts; i++) {
  184:         ScmHashEntry *e;
  185:         int cnt;
  186:         
  187:         func = vm->prof->counts[i].func;
  188:         if (SCM_METHODP(func) && SCM_METHOD(func)->func == NULL) {
  189:             /* func is Scheme-defined method.  Record the code of
  190:                method body, so that we can match it with sampling
  191:                profiler later. */
  192:             func = SCM_OBJ(SCM_METHOD(func)->data);
  193:         }
  194:         
  195:         e = Scm_HashTableAdd(vm->prof->statHash,
  196:                              vm->prof->counts[i].func,
  197:                              SCM_FALSE);
  198:         if (SCM_FALSEP(e->value)) {
  199:             e->value = Scm_Cons(SCM_MAKE_INT(0), SCM_MAKE_INT(0));
  200:         }
  201: 
  202:         SCM_ASSERT(SCM_PAIRP(e->value));
  203:         cnt = SCM_INT_VALUE(SCM_CAR(e->value)) + 1;
  204:         SCM_SET_CAR(e->value, SCM_MAKE_INT(cnt));
  205:     }
  206:     vm->prof->currentCount = 0;
  207: 
  208:     /* resume itimer */
  209:     SIGPROCMASK(SIG_UNBLOCK, &set, NULL);
  210: }
  211: 
  212: /*=============================================================
  213:  * External API
  214:  */
  215: void Scm_ProfilerStart(void)
  216: {
  217:     struct sigaction act;
  218:     ScmVM *vm = Scm_VM();
  219:     char templat[] = "/tmp/gauche-profXXXXXX";
  220: 
  221:     if (!vm->prof) {
  222:         vm->prof = SCM_NEW(ScmVMProfiler);
  223:         vm->prof->state = SCM_PROFILER_INACTIVE;
  224:         vm->prof->samplerFd = Scm_Mkstemp(templat);
  225:         vm->prof->currentSample = 0;
  226:         vm->prof->totalSamples = 0;
  227:         vm->prof->errorOccurred = 0;
  228:         vm->prof->currentCount = 0;
  229:         vm->prof->statHash =
  230:             SCM_HASH_TABLE(Scm_MakeHashTableSimple(SCM_HASH_EQ, 0));
  231:         unlink(templat);       /* keep anonymous tmpfile */
  232:     } else if (vm->prof->samplerFd < 0) {
  233:         vm->prof->samplerFd = Scm_Mkstemp(templat);
  234:         unlink(templat);
  235:     }
  236:     
  237:     if (vm->prof->state == SCM_PROFILER_RUNNING) return;
  238:     vm->prof->state = SCM_PROFILER_RUNNING;
  239:     vm->profilerRunning = TRUE;
  240: 
  241:     /* NB: this should be done globally!!! */
  242:     act.sa_handler = sampler_sample;
  243:     sigfillset(&act.sa_mask);
  244:     act.sa_flags = SA_RESTART;
  245:     if (sigaction(SIGPROF, &act, NULL) < 0) {
  246:         Scm_SysError("sigaction failed");
  247:     }
  248: 
  249:     ITIMER_START();
  250: }
  251: 
  252: int Scm_ProfilerStop(void)
  253: {
  254:     ScmVM *vm = Scm_VM();
  255:     if (vm->prof == NULL) return 0;
  256:     if (vm->prof->state != SCM_PROFILER_RUNNING) return 0;
  257:     ITIMER_STOP();
  258:     vm->prof->state = SCM_PROFILER_PAUSING;
  259:     vm->profilerRunning = FALSE;
  260:     return vm->prof->totalSamples;
  261: }
  262: 
  263: void Scm_ProfilerReset(void)
  264: {
  265:     ScmVM *vm = Scm_VM();
  266:     
  267:     if (vm->prof == NULL) return;
  268:     if (vm->prof->state == SCM_PROFILER_INACTIVE) return;
  269:     if (vm->prof->state == SCM_PROFILER_RUNNING) Scm_ProfilerStop();
  270: 
  271:     if (vm->prof->samplerFd >= 0) {
  272:         close(vm->prof->samplerFd);
  273:         vm->prof->samplerFd = -1;
  274:     }
  275:     vm->prof->totalSamples = 0;
  276:     vm->prof->currentSample = 0;
  277:     vm->prof->errorOccurred = 0;
  278:     vm->prof->currentCount = 0;
  279:     vm->prof->statHash =
  280:         SCM_HASH_TABLE(Scm_MakeHashTableSimple(SCM_HASH_EQ, 0));
  281:     vm->prof->state = SCM_PROFILER_INACTIVE;
  282: }
  283: 
  284: /* Returns the statHash */
  285: ScmObj Scm_ProfilerRawResult(void)
  286: {
  287:     off_t off;
  288:     ssize_t r;
  289:     ScmObj sampler_port;
  290:     ScmVM *vm = Scm_VM();
  291: 
  292:     if (vm->prof == NULL) return SCM_FALSE;
  293:     if (vm->prof->state == SCM_PROFILER_INACTIVE) return SCM_FALSE;
  294:     if (vm->prof->state == SCM_PROFILER_RUNNING) Scm_ProfilerStop();
  295: 
  296:     if (vm->prof->errorOccurred > 0) {
  297:         Scm_Warn("profiler: An error has been occurred during saving profiling samples.  The result may not be accurate");
  298:     }
  299: 
  300:     Scm_ProfilerCountBufferFlush(vm);
  301: 
  302:     /* collect samples in the current buffer */
  303:     collect_samples(vm->prof);
  304: 
  305:     /* collect samples in the saved file */
  306:     SCM_SYSCALL(off, lseek(vm->prof->samplerFd, 0, SEEK_SET));
  307:     if (off == (off_t)-1) {
  308:         Scm_ProfilerReset();
  309:         Scm_Error("profiler: seek failed in retrieving sample data");
  310:     }
  311:     sampler_port =
  312:         Scm_MakePortWithFd(SCM_FALSE, SCM_PORT_INPUT, vm->prof->samplerFd,
  313:                            SCM_PORT_BUFFER_FULL, FALSE);
  314: 
  315:     for (;;) {
  316:         r = read(vm->prof->samplerFd, vm->prof->samples,
  317:                  sizeof(ScmProfSample[1]) * SCM_PROF_SAMPLES_IN_BUFFER);
  318:         if (r <= 0) break;
  319:         vm->prof->currentSample = r / sizeof(ScmProfSample[1]);
  320:         collect_samples(vm->prof);
  321:     }
  322:     vm->prof->currentSample = 0;
  323:     if (ftruncate(vm->prof->samplerFd, 0) < 0) {
  324:         Scm_SysError("profiler: failed to truncate temporary file");
  325:     }
  326:     
  327:     return SCM_OBJ(vm->prof->statHash);
  328: }
  329: 
  330: #else  /* !GAUCHE_PROFILE */
  331: void Scm_ProfilerStart(void)
  332: {
  333:     Scm_Error("profiler is not supported.");
  334: }
  335: 
  336: int  Scm_ProfilerStop(void)
  337: {
  338:     Scm_Error("profiler is not supported.");
  339:     return 0;
  340: }
  341: 
  342: void Scm_ProfilerReset(void)
  343: {
  344:     Scm_Error("profiler is not supported.");
  345: }
  346: 
  347: ScmObj Scm_ProfilerRawResult(void)
  348: {
  349:     Scm_Error("profiler is not supported.");
  350:     return SCM_FALSE;
  351: }
  352: #endif /* !GAUCHE_PROFILE */