Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-21 14:49:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

adding simple VM-level profiler

Browse source
This commit is contained in:
Alex Shinn 2011-07-03 21:00:11 +09:00
parent eae82d1f27
commit bacc7d9399
4 changed files with 48 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
eval.c
View file

@ -1467,6 +1467,11 @@ sexp sexp_make_setter_op (sexp ctx sexp_api_params(self, n), sexp name, sexp typ
#endif
#if SEXP_USE_PROFILE_VM
static sexp sexp_reset_vm_profile (sexp ctx sexp_api_params(self, n));
static sexp sexp_print_vm_profile (sexp ctx sexp_api_params(self, n));
#endif
#include "opcodes.c"
static sexp sexp_copy_core (sexp ctx, struct sexp_core_form_struct *core) {

4
include/chibi/features.h
View file

@ -414,6 +414,10 @@
#define SEXP_USE_DEBUG_VM 0
#endif
#ifndef SEXP_USE_PROFILE_VM
#define SEXP_USE_PROFILE_VM 0
#endif
#ifndef SEXP_USE_UTF8_STRINGS
#define SEXP_USE_UTF8_STRINGS ! SEXP_USE_NO_FEATURES
#endif

4
opcodes.c
View file

@ -183,6 +183,10 @@ _FN2(SEXP_VOID, _I(SEXP_STRING), _I(SEXP_BOOLEAN), "add-module-directory", 0, se
#if SEXP_USE_GREEN_THREADS
_OP(SEXP_OPC_GENERIC, SEXP_OP_YIELD, 0, 0, SEXP_VOID, SEXP_FALSE, SEXP_FALSE, SEXP_FALSE, 0, "yield!", 0, NULL),
#endif
#if SEXP_USE_PROFILE_VM
_FN0(SEXP_VOID, "reset-vm-profile", 0, sexp_reset_vm_profile),
_FN0(SEXP_VOID, "print-vm-profile", 0, sexp_print_vm_profile),
#endif
#if SEXP_USE_AUTO_FORCE
_FN1(_I(SEXP_PROMISE), _I(SEXP_PROCEDURE), "make-promise", 0, sexp_make_promise),
#endif

37
vm.c
View file

@ -621,7 +621,7 @@ static int sexp_check_type(sexp ctx, sexp a, sexp b) {
top -= i; _ARG1 = x; ip += sizeof(sexp); sexp_check_exception();
#endif
#if SEXP_USE_DEBUG_VM
#if SEXP_USE_DEBUG_VM || SEXP_USE_PROFILE_VM
#include "opt/opcode_names.h"
#endif
@ -629,6 +629,31 @@ static int sexp_check_type(sexp ctx, sexp a, sexp b) {
#include "opt/fcall.c"
#endif
#if SEXP_USE_PROFILE_VM
sexp_uint_t profile1[SEXP_OP_NUM_OPCODES];
sexp_uint_t profile2[SEXP_OP_NUM_OPCODES][SEXP_OP_NUM_OPCODES];
static sexp sexp_reset_vm_profile (sexp ctx sexp_api_params(self, n)) {
int i, j;
for (i=0; i<SEXP_OP_NUM_OPCODES; i++) {
profile1[i] = 0;
for (j=0; j<SEXP_OP_NUM_OPCODES; j++) profile2[i][j] = 0;
}
return SEXP_VOID;
}
static sexp sexp_print_vm_profile (sexp ctx sexp_api_params(self, n)) {
int i, j;
for (i=0; i<SEXP_OP_NUM_OPCODES; i++)
fprintf(stderr, "%s %lu\n", reverse_opcode_names[i], profile1[i]);
for (i=0; i<SEXP_OP_NUM_OPCODES; i++)
for (j=0; j<SEXP_OP_NUM_OPCODES; j++)
fprintf(stderr, "%s %s %lu\n", reverse_opcode_names[i],
reverse_opcode_names[j], profile2[i][j]);
return SEXP_VOID;
}
#endif
sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
unsigned char *ip;
sexp bc, cp, *stack = sexp_stack_data(sexp_context_stack(ctx));
@ -637,6 +662,9 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
sexp root_thread = ctx;
sexp_sint_t fuel = sexp_context_refuel(ctx);
#endif
#if SEXP_USE_PROFILE_VM
unsigned char last_op = SEXP_OP_NOOP;
#endif
#if SEXP_USE_BIGNUMS
sexp_lsint_t prod;
#endif
@ -684,6 +712,11 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
? sexp_opcode_name(((sexp*)(ip+1))[0]) : ""),
ip, stack, top, fp, (fp<1024 ? sexp_unbox_fixnum(stack[fp+3]) : -1));
}
#endif
#if SEXP_USE_PROFILE_VM
profile1[*ip]++;
profile2[last_op][*ip]++;
last_op = *ip;
#endif
switch (*ip++) {
case SEXP_OP_NOOP:
@ -1606,7 +1639,7 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
sexp sexp_apply1 (sexp ctx, sexp f, sexp x) {
sexp res;
sexp_gc_var1(args);
if (sexp_opcodep(f)) {
if (sexp_opcodep(f) && sexp_opcode_func(f)) {
res = ((sexp_proc2)sexp_opcode_func(f))(ctx sexp_api_pass(f, 1), x);
} else {
sexp_gc_preserve1(ctx, args);