mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
vm no longer measures bogoclock or times, relies on os for that
* libguile/vm.h (struct scm_vm): Remove "time" and "clock" members. The time was bogusly measured, and the "clock" measured instructions retired, which is not a very useful measurement, and it was causing lots of memory accesses. Not that I have done a proper profile, though... (scm_vm_stats): Remove this procedure, which provided access to "time" and "clock". * libguile/vm.c: * libguile/vm-engine.h: * libguile/vm-engine.c: * libguile/vm-i-system.c: Adapt to scm_vm changes and scm_vm_stats removal. * module/system/repl/command.scm: * module/system/vm/vm.scm: Adapt to vm-stats removal by removing vm-stats from <repl>.
This commit is contained in:
parent
349d5c4428
commit
6c20a0b34b
8 changed files with 4 additions and 55 deletions
|
@ -20,12 +20,10 @@
|
||||||
|
|
||||||
#if (VM_ENGINE == SCM_VM_REGULAR_ENGINE)
|
#if (VM_ENGINE == SCM_VM_REGULAR_ENGINE)
|
||||||
#define VM_USE_HOOKS 0 /* Various hooks */
|
#define VM_USE_HOOKS 0 /* Various hooks */
|
||||||
#define VM_USE_CLOCK 0 /* Bogoclock */
|
|
||||||
#define VM_CHECK_OBJECT 1 /* Check object table */
|
#define VM_CHECK_OBJECT 1 /* Check object table */
|
||||||
#define VM_CHECK_FREE_VARIABLES 1 /* Check free variable access */
|
#define VM_CHECK_FREE_VARIABLES 1 /* Check free variable access */
|
||||||
#elif (VM_ENGINE == SCM_VM_DEBUG_ENGINE)
|
#elif (VM_ENGINE == SCM_VM_DEBUG_ENGINE)
|
||||||
#define VM_USE_HOOKS 1
|
#define VM_USE_HOOKS 1
|
||||||
#define VM_USE_CLOCK 1
|
|
||||||
#define VM_CHECK_OBJECT 1
|
#define VM_CHECK_OBJECT 1
|
||||||
#define VM_CHECK_FREE_VARIABLES 1
|
#define VM_CHECK_FREE_VARIABLES 1
|
||||||
#else
|
#else
|
||||||
|
@ -53,7 +51,6 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
|
||||||
|
|
||||||
/* Internal variables */
|
/* Internal variables */
|
||||||
int nvalues = 0;
|
int nvalues = 0;
|
||||||
long start_time = scm_c_get_internal_run_time ();
|
|
||||||
SCM finish_args; /* used both for returns: both in error
|
SCM finish_args; /* used both for returns: both in error
|
||||||
and normal situations */
|
and normal situations */
|
||||||
#if VM_USE_HOOKS
|
#if VM_USE_HOOKS
|
||||||
|
@ -255,7 +252,6 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
|
||||||
}
|
}
|
||||||
|
|
||||||
#undef VM_USE_HOOKS
|
#undef VM_USE_HOOKS
|
||||||
#undef VM_USE_CLOCK
|
|
||||||
#undef VM_CHECK_OBJECT
|
#undef VM_CHECK_OBJECT
|
||||||
#undef VM_CHECK_FREE_VARIABLE
|
#undef VM_CHECK_FREE_VARIABLE
|
||||||
|
|
||||||
|
|
|
@ -339,13 +339,6 @@ do { \
|
||||||
#define FETCH() (*ip++)
|
#define FETCH() (*ip++)
|
||||||
#define FETCH_LENGTH(len) do { len=*ip++; len<<=8; len+=*ip++; len<<=8; len+=*ip++; } while (0)
|
#define FETCH_LENGTH(len) do { len=*ip++; len<<=8; len+=*ip++; len<<=8; len+=*ip++; } while (0)
|
||||||
|
|
||||||
#undef CLOCK
|
|
||||||
#if VM_USE_CLOCK
|
|
||||||
#define CLOCK(n) vp->clock += n
|
|
||||||
#else
|
|
||||||
#define CLOCK(n)
|
|
||||||
#endif
|
|
||||||
|
|
||||||
#undef NEXT_JUMP
|
#undef NEXT_JUMP
|
||||||
#ifdef HAVE_LABELS_AS_VALUES
|
#ifdef HAVE_LABELS_AS_VALUES
|
||||||
#define NEXT_JUMP() goto *jump_table[FETCH () & SCM_VM_INSTRUCTION_MASK]
|
#define NEXT_JUMP() goto *jump_table[FETCH () & SCM_VM_INSTRUCTION_MASK]
|
||||||
|
@ -355,7 +348,6 @@ do { \
|
||||||
|
|
||||||
#define NEXT \
|
#define NEXT \
|
||||||
{ \
|
{ \
|
||||||
CLOCK (1); \
|
|
||||||
NEXT_HOOK (); \
|
NEXT_HOOK (); \
|
||||||
CHECK_STACK_LEAK (); \
|
CHECK_STACK_LEAK (); \
|
||||||
NEXT_JUMP (); \
|
NEXT_JUMP (); \
|
||||||
|
|
|
@ -31,7 +31,6 @@ VM_DEFINE_INSTRUCTION (0, nop, "nop", 0, 0, 0)
|
||||||
|
|
||||||
VM_DEFINE_INSTRUCTION (1, halt, "halt", 0, 0, 0)
|
VM_DEFINE_INSTRUCTION (1, halt, "halt", 0, 0, 0)
|
||||||
{
|
{
|
||||||
vp->time += scm_c_get_internal_run_time () - start_time;
|
|
||||||
HALT_HOOK ();
|
HALT_HOOK ();
|
||||||
nvalues = SCM_I_INUM (*sp--);
|
nvalues = SCM_I_INUM (*sp--);
|
||||||
NULLSTACK (1);
|
NULLSTACK (1);
|
||||||
|
|
|
@ -363,8 +363,6 @@ make_vm (void)
|
||||||
vp->sp = vp->stack_base - 1;
|
vp->sp = vp->stack_base - 1;
|
||||||
vp->fp = NULL;
|
vp->fp = NULL;
|
||||||
vp->engine = SCM_VM_DEBUG_ENGINE;
|
vp->engine = SCM_VM_DEBUG_ENGINE;
|
||||||
vp->time = 0;
|
|
||||||
vp->clock = 0;
|
|
||||||
vp->options = SCM_EOL;
|
vp->options = SCM_EOL;
|
||||||
for (i = 0; i < SCM_VM_NUM_HOOKS; i++)
|
for (i = 0; i < SCM_VM_NUM_HOOKS; i++)
|
||||||
vp->hooks[i] = SCM_BOOL_F;
|
vp->hooks[i] = SCM_BOOL_F;
|
||||||
|
@ -621,25 +619,6 @@ SCM_DEFINE (scm_set_vm_option_x, "set-vm-option!", 3, 0, 0,
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
SCM_DEFINE (scm_vm_stats, "vm-stats", 1, 0, 0,
|
|
||||||
(SCM vm),
|
|
||||||
"")
|
|
||||||
#define FUNC_NAME s_scm_vm_stats
|
|
||||||
{
|
|
||||||
SCM stats;
|
|
||||||
|
|
||||||
SCM_VALIDATE_VM (1, vm);
|
|
||||||
|
|
||||||
stats = scm_make_vector (SCM_I_MAKINUM (2), SCM_UNSPECIFIED);
|
|
||||||
scm_vector_set_x (stats, SCM_I_MAKINUM (0),
|
|
||||||
scm_from_ulong (SCM_VM_DATA (vm)->time));
|
|
||||||
scm_vector_set_x (stats, SCM_I_MAKINUM (1),
|
|
||||||
scm_from_ulong (SCM_VM_DATA (vm)->clock));
|
|
||||||
|
|
||||||
return stats;
|
|
||||||
}
|
|
||||||
#undef FUNC_NAME
|
|
||||||
|
|
||||||
SCM_DEFINE (scm_vm_trace_frame, "vm-trace-frame", 1, 0, 0,
|
SCM_DEFINE (scm_vm_trace_frame, "vm-trace-frame", 1, 0, 0,
|
||||||
(SCM vm),
|
(SCM vm),
|
||||||
"")
|
"")
|
||||||
|
|
|
@ -50,8 +50,6 @@ struct scm_vm {
|
||||||
int engine; /* which vm engine we're using */
|
int engine; /* which vm engine we're using */
|
||||||
SCM hooks[SCM_VM_NUM_HOOKS]; /* hooks */
|
SCM hooks[SCM_VM_NUM_HOOKS]; /* hooks */
|
||||||
SCM options; /* options */
|
SCM options; /* options */
|
||||||
unsigned long time; /* time spent */
|
|
||||||
unsigned long clock; /* bogos clock */
|
|
||||||
SCM trace_frame; /* a frame being traced */
|
SCM trace_frame; /* a frame being traced */
|
||||||
};
|
};
|
||||||
|
|
||||||
|
@ -85,7 +83,6 @@ SCM_API SCM scm_vm_exit_hook (SCM vm);
|
||||||
SCM_API SCM scm_vm_return_hook (SCM vm);
|
SCM_API SCM scm_vm_return_hook (SCM vm);
|
||||||
SCM_API SCM scm_vm_option (SCM vm, SCM key);
|
SCM_API SCM scm_vm_option (SCM vm, SCM key);
|
||||||
SCM_API SCM scm_set_vm_option_x (SCM vm, SCM key, SCM val);
|
SCM_API SCM scm_set_vm_option_x (SCM vm, SCM key, SCM val);
|
||||||
SCM_API SCM scm_vm_stats (SCM vm);
|
|
||||||
SCM_API SCM scm_vm_trace_frame (SCM vm);
|
SCM_API SCM scm_vm_trace_frame (SCM vm);
|
||||||
|
|
||||||
struct scm_vm_cont {
|
struct scm_vm_cont {
|
||||||
|
|
|
@ -413,10 +413,8 @@ Garbage collection."
|
||||||
"statistics
|
"statistics
|
||||||
Display statistics."
|
Display statistics."
|
||||||
(let ((this-tms (times))
|
(let ((this-tms (times))
|
||||||
(this-vms (vm-stats (repl-vm repl)))
|
|
||||||
(this-gcs (gc-stats))
|
(this-gcs (gc-stats))
|
||||||
(last-tms (repl-tm-stats repl))
|
(last-tms (repl-tm-stats repl))
|
||||||
(last-vms (repl-vm-stats repl))
|
|
||||||
(last-gcs (repl-gc-stats repl)))
|
(last-gcs (repl-gc-stats repl)))
|
||||||
;; GC times
|
;; GC times
|
||||||
(let ((this-times (assq-ref this-gcs 'gc-times))
|
(let ((this-times (assq-ref this-gcs 'gc-times))
|
||||||
|
@ -465,20 +463,9 @@ Display statistics."
|
||||||
(display-time-stat "child user" this-cutime last-cutime)
|
(display-time-stat "child user" this-cutime last-cutime)
|
||||||
(display-time-stat "child system" this-cstime last-cstime)
|
(display-time-stat "child system" this-cstime last-cstime)
|
||||||
(newline))
|
(newline))
|
||||||
;; VM statistics
|
|
||||||
(let ((this-time (vms:time this-vms))
|
|
||||||
(last-time (vms:time last-vms))
|
|
||||||
(this-clock (vms:clock this-vms))
|
|
||||||
(last-clock (vms:clock last-vms)))
|
|
||||||
(display-stat-title "VM statistics:" "diff" "total")
|
|
||||||
(display-time-stat "time spent" this-time last-time)
|
|
||||||
(display-diff-stat "bogoclock" #f this-clock last-clock "clock")
|
|
||||||
(display-mips-stat "bogomips" this-time this-clock last-time last-clock)
|
|
||||||
(newline))
|
|
||||||
;; Save statistics
|
;; Save statistics
|
||||||
;; Save statistics
|
;; Save statistics
|
||||||
(set! (repl-tm-stats repl) this-tms)
|
(set! (repl-tm-stats repl) this-tms)
|
||||||
(set! (repl-vm-stats repl) this-vms)
|
|
||||||
(set! (repl-gc-stats repl) this-gcs)))
|
(set! (repl-gc-stats repl) this-gcs)))
|
||||||
|
|
||||||
(define (display-stat title flag field1 field2 unit)
|
(define (display-stat title flag field1 field2 unit)
|
||||||
|
|
|
@ -24,7 +24,7 @@
|
||||||
#:use-module (system base language)
|
#:use-module (system base language)
|
||||||
#:use-module (system vm vm)
|
#:use-module (system vm vm)
|
||||||
#:export (<repl> make-repl repl-vm repl-language repl-options
|
#:export (<repl> make-repl repl-vm repl-language repl-options
|
||||||
repl-tm-stats repl-gc-stats repl-vm-stats
|
repl-tm-stats repl-gc-stats
|
||||||
repl-welcome repl-prompt repl-read repl-compile repl-eval
|
repl-welcome repl-prompt repl-read repl-compile repl-eval
|
||||||
repl-parse repl-print repl-option-ref repl-option-set!
|
repl-parse repl-print repl-option-ref repl-option-set!
|
||||||
puts ->string user-error))
|
puts ->string user-error))
|
||||||
|
@ -34,7 +34,7 @@
|
||||||
;;; Repl type
|
;;; Repl type
|
||||||
;;;
|
;;;
|
||||||
|
|
||||||
(define-record/keywords <repl> vm language options tm-stats gc-stats vm-stats)
|
(define-record/keywords <repl> vm language options tm-stats gc-stats)
|
||||||
|
|
||||||
(define repl-default-options
|
(define repl-default-options
|
||||||
'((trace . #f)
|
'((trace . #f)
|
||||||
|
@ -46,8 +46,7 @@
|
||||||
#:language (lookup-language lang)
|
#:language (lookup-language lang)
|
||||||
#:options repl-default-options
|
#:options repl-default-options
|
||||||
#:tm-stats (times)
|
#:tm-stats (times)
|
||||||
#:gc-stats (gc-stats)
|
#:gc-stats (gc-stats)))
|
||||||
#:vm-stats (vm-stats (the-vm))))
|
|
||||||
|
|
||||||
(define (repl-welcome repl)
|
(define (repl-welcome repl)
|
||||||
(let ((language (repl-language repl)))
|
(let ((language (repl-language repl)))
|
||||||
|
|
|
@ -24,7 +24,7 @@
|
||||||
#:export (vm? the-vm make-vm vm-version
|
#:export (vm? the-vm make-vm vm-version
|
||||||
vm:ip vm:sp vm:fp vm:last-ip
|
vm:ip vm:sp vm:fp vm:last-ip
|
||||||
|
|
||||||
vm-load vm-option set-vm-option! vm-version vm-stats
|
vm-load vm-option set-vm-option! vm-version
|
||||||
vms:time vms:clock
|
vms:time vms:clock
|
||||||
|
|
||||||
vm-trace-frame
|
vm-trace-frame
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue