[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-779-g4b3d7a2
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-779-g4b3d7a2 |
|
Date: |
Tue, 25 Feb 2014 20:42:47 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=4b3d7a2b7c4ded342af4e485c65a4b34121a3a89
The branch, master has been updated
via 4b3d7a2b7c4ded342af4e485c65a4b34121a3a89 (commit)
via 546efe25144b1d17400a432162288e0961dbbb89 (commit)
via 3476a3692e52748f207ec55ef7624d85a70f0f6a (commit)
via fcd3c8ccd3ea8f8e052c8e1957cb21004c32d912 (commit)
via 90c8094aec494df062b383d439874b380cf03925 (commit)
via e4a8775ddb357c63b91ef4bcfc9e582107b8d832 (commit)
via e70a42d4c9401f645cfd4554c27c8b0b1cbee405 (commit)
via cad444e31a816776785941972e84d30efd6ab643 (commit)
from d20dd74ecab6d5be216c97d28cb654d4446dfba5 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 4b3d7a2b7c4ded342af4e485c65a4b34121a3a89
Author: Andy Wingo <address@hidden>
Date: Tue Feb 25 21:32:36 2014 +0100
Simplification pass prunes all unreachable continuations
* module/language/cps/simplify.scm (prune-continuations): Prune
continuations as a post-pass with a fresh DFG. Using a
pre-eta-conversion DFG as we were doing before missed some cases.
commit 546efe25144b1d17400a432162288e0961dbbb89
Author: Andy Wingo <address@hidden>
Date: Sat Feb 22 17:02:53 2014 +0100
simplify profile-signal-handler
* module/statprof.scm (profile-signal-handler): Don't bother detecting
if we were in a count-call call or not; it doesn't matter, and we
should accumulate time in any case.
commit 3476a3692e52748f207ec55ef7624d85a70f0f6a
Author: Andy Wingo <address@hidden>
Date: Sat Feb 22 16:31:31 2014 +0100
statprof: accumulated-time is in jiffies
* module/statprof.scm (fresh-profiler-state): accumulated-time and
gc-time-taken are in jiffies, not seconds, so they are exact.
(statprof-accumulated-time): Divide by 1.0 so that we get a flonum.
Also refactor use of assq to get the gc-time-taken.
commit fcd3c8ccd3ea8f8e052c8e1957cb21004c32d912
Author: Andy Wingo <address@hidden>
Date: Sat Feb 22 15:39:29 2014 +0100
Zero-offset branches are backward branches; fix "br" backward branches
* libguile/vm-engine.c (BR_UNARY, BR_BINARY, BR_ARITHMETIC): A jump with
a zero offset is also a backward branch, in the sense that it's not a
forward branch.
("br"): We forgot to VM_HANDLE_INTERRUPTS here on backwards branches.
Oops!
commit 90c8094aec494df062b383d439874b380cf03925
Author: Andy Wingo <address@hidden>
Date: Sat Feb 22 15:34:46 2014 +0100
Avoid attempting to eta-reduce self-loops.
* module/language/cps/simplify.scm (compute-eta-reductions): Avoid
trying to eta-reduce a jump-to-self, as in (let lp () (lp)). This
caused the compiler to hang.
commit e4a8775ddb357c63b91ef4bcfc9e582107b8d832
Author: Andy Wingo <address@hidden>
Date: Sat Feb 22 15:09:54 2014 +0100
Pass state around statprof in more places
* module/statprof.scm (get-call-data, sample-stack-procs): Take the
state as an argument.
(profile-signal-handler, count-call, statprof-proc-call-data)
(gcprof): Adapt.
commit e70a42d4c9401f645cfd4554c27c8b0b1cbee405
Author: Andy Wingo <address@hidden>
Date: Sat Feb 22 14:59:21 2014 +0100
statprof: call-data is a record type
* module/statprof.scm (call-data): Reimplement as a record type.
commit cad444e31a816776785941972e84d30efd6ab643
Author: Andy Wingo <address@hidden>
Date: Sat Feb 22 14:54:17 2014 +0100
statprof: when/unless instead of if.
* module/statprof.scm: Use when or unless instead of if, where
appropriate.
-----------------------------------------------------------------------
Summary of changes:
libguile/vm-engine.c | 10 +-
module/language/cps/simplify.scm | 84 +++++++-------
module/statprof.scm | 246 +++++++++++++++++--------------------
3 files changed, 162 insertions(+), 178 deletions(-)
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 541e11c..331f45c 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -305,7 +305,7 @@
{ \
scm_t_int32 offset = ip[1]; \
offset >>= 8; /* Sign-extending shift. */ \
- if (offset < 0) \
+ if (offset <= 0) \
VM_HANDLE_INTERRUPTS; \
NEXT (offset); \
} \
@@ -321,7 +321,7 @@
{ \
scm_t_int32 offset = ip[1]; \
offset >>= 8; /* Sign-extending shift. */ \
- if (offset < 0) \
+ if (offset <= 0) \
VM_HANDLE_INTERRUPTS; \
NEXT (offset); \
} \
@@ -342,7 +342,7 @@
{ \
scm_t_int32 offset = ip[1]; \
offset >>= 8; /* Sign-extending shift. */ \
- if (offset < 0) \
+ if (offset <= 0) \
VM_HANDLE_INTERRUPTS; \
NEXT (offset); \
} \
@@ -358,7 +358,7 @@
{ \
scm_t_int32 offset = ip[1]; \
offset >>= 8; /* Sign-extending shift. */ \
- if (offset < 0) \
+ if (offset <= 0) \
VM_HANDLE_INTERRUPTS; \
NEXT (offset); \
} \
@@ -1347,6 +1347,8 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
{
scm_t_int32 offset = op;
offset >>= 8; /* Sign-extending shift. */
+ if (offset <= 0)
+ VM_HANDLE_INTERRUPTS;
NEXT (offset);
}
diff --git a/module/language/cps/simplify.scm b/module/language/cps/simplify.scm
index bd79098..98788b7 100644
--- a/module/language/cps/simplify.scm
+++ b/module/language/cps/simplify.scm
@@ -40,40 +40,7 @@
;; aren't used), making it useful for this pass to include its own
;; little pruner.
-(define (compute-eta-reductions fun)
- (let ((table (make-hash-table)))
- (define (visit-cont cont)
- (match cont
- (($ $cont sym ($ $kargs names syms body))
- (visit-term body sym syms))
- (($ $cont sym ($ $kentry self tail clauses))
- (for-each visit-cont clauses))
- (($ $cont sym ($ $kclause arity body))
- (visit-cont body))
- (($ $cont sym _) #f)))
- (define (visit-term term term-k term-args)
- (match term
- (($ $letk conts body)
- (for-each visit-cont conts)
- (visit-term body term-k term-args))
- (($ $letrec names syms funs body)
- (for-each visit-fun funs)
- (visit-term body term-k term-args))
- (($ $continue k src ($ $values args))
- (when (equal? term-args args)
- (hashq-set! table term-k k)))
- (($ $continue k src (and fun ($ $fun)))
- (visit-fun fun))
- (($ $continue k src _)
- #f)))
- (define (visit-fun fun)
- (match fun
- (($ $fun src meta free body)
- (visit-cont body))))
- (visit-fun fun)
- table))
-
-(define (locally-prune-continuations fun dfg)
+(define* (prune-continuations fun #:optional (dfg (compute-dfg fun)))
(let ((cfa (analyze-control-flow fun dfg)))
(define (must-visit-cont cont)
(or (visit-cont cont)
@@ -102,13 +69,50 @@
(conts (build-cps-term ($letk ,conts ,body))))))
(($ $letrec names syms funs body)
(build-cps-term
- ($letrec names syms funs ,(visit-term body))))
+ ($letrec names syms (map (cut prune-continuations <> dfg) funs)
+ ,(visit-term body))))
+ (($ $continue k src (and fun ($ $fun)))
+ (build-cps-term
+ ($continue k src ,(prune-continuations fun dfg))))
(($ $continue k src exp)
term)))
(rewrite-cps-exp fun
(($ $fun src meta free body)
($fun src meta free ,(must-visit-cont body))))))
+(define (compute-eta-reductions fun)
+ (let ((table (make-hash-table)))
+ (define (visit-cont cont)
+ (match cont
+ (($ $cont sym ($ $kargs names syms body))
+ (visit-term body sym syms))
+ (($ $cont sym ($ $kentry self tail clauses))
+ (for-each visit-cont clauses))
+ (($ $cont sym ($ $kclause arity body))
+ (visit-cont body))
+ (($ $cont sym _) #f)))
+ (define (visit-term term term-k term-args)
+ (match term
+ (($ $letk conts body)
+ (for-each visit-cont conts)
+ (visit-term body term-k term-args))
+ (($ $letrec names syms funs body)
+ (for-each visit-fun funs)
+ (visit-term body term-k term-args))
+ (($ $continue k src ($ $values args))
+ (when (and (equal? term-args args) (not (eq? k term-k)))
+ (hashq-set! table term-k k)))
+ (($ $continue k src (and fun ($ $fun)))
+ (visit-fun fun))
+ (($ $continue k src _)
+ #f)))
+ (define (visit-fun fun)
+ (match fun
+ (($ $fun src meta free body)
+ (visit-cont body))))
+ (visit-fun fun)
+ table))
+
(define (eta-reduce fun)
(let ((table (compute-eta-reductions fun))
(dfg (compute-dfg fun)))
@@ -154,11 +158,9 @@
(($ $continue k src exp)
($continue (reduce k scope) src ,exp))))
(define (visit-fun fun)
- (locally-prune-continuations
- (rewrite-cps-exp fun
- (($ $fun src meta free body)
- ($fun src meta free ,(visit-cont body #f))))
- dfg))
+ (rewrite-cps-exp fun
+ (($ $fun src meta free body)
+ ($fun src meta free ,(visit-cont body #f)))))
(visit-fun fun)))
(define (compute-beta-reductions fun)
@@ -273,4 +275,4 @@
(visit-fun fun)))
(define (simplify fun)
- (eta-reduce (beta-reduce fun)))
+ (prune-continuations (eta-reduce (beta-reduce fun))))
diff --git a/module/statprof.scm b/module/statprof.scm
index 85665f0..6cc9857 100644
--- a/module/statprof.scm
+++ b/module/statprof.scm
@@ -111,6 +111,7 @@
(define-module (statprof)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-9 gnu)
#:autoload (ice-9 format) (format)
#:use-module (system vm vm)
#:use-module (system vm frame)
@@ -197,7 +198,7 @@
(define* (fresh-profiler-state #:key (count-calls? #f)
(sampling-frequency '(0 . 10000))
(full-stacks? #f))
- (make-state 0.0 #f 0 sampling-frequency #f 0 count-calls? 0.0 #f '()
+ (make-state 0 #f 0 sampling-frequency #f 0 count-calls? 0 #f '()
(make-hash-table) #f))
(define (ensure-profiler-state)
@@ -210,33 +211,32 @@
(or (profiler-state)
(error "expected there to be a profiler state")))
-;; If you change the call-data data structure, you need to also change
-;; sample-uncount-frame.
-(define (make-call-data proc call-count cum-sample-count self-sample-count)
- (vector proc call-count cum-sample-count self-sample-count))
-(define (call-data-proc cd) (vector-ref cd 0))
+(define-record-type call-data
+ (make-call-data proc call-count cum-sample-count self-sample-count)
+ call-data?
+ (proc call-data-proc)
+ (call-count call-data-call-count set-call-data-call-count!)
+ (cum-sample-count call-data-cum-sample-count set-call-data-cum-sample-count!)
+ (self-sample-count call-data-self-sample-count
set-call-data-self-sample-count!))
+
(define (call-data-name cd) (procedure-name (call-data-proc cd)))
(define (call-data-printable cd)
(or (call-data-name cd)
(with-output-to-string (lambda () (write (call-data-proc cd))))))
-(define (call-data-call-count cd) (vector-ref cd 1))
-(define (call-data-cum-sample-count cd) (vector-ref cd 2))
-(define (call-data-self-sample-count cd) (vector-ref cd 3))
(define (inc-call-data-call-count! cd)
- (vector-set! cd 1 (1+ (vector-ref cd 1))))
+ (set-call-data-call-count! cd (1+ (call-data-call-count cd))))
(define (inc-call-data-cum-sample-count! cd)
- (vector-set! cd 2 (1+ (vector-ref cd 2))))
+ (set-call-data-cum-sample-count! cd (1+ (call-data-cum-sample-count cd))))
(define (inc-call-data-self-sample-count! cd)
- (vector-set! cd 3 (1+ (vector-ref cd 3))))
+ (set-call-data-self-sample-count! cd (1+ (call-data-self-sample-count cd))))
(define (accumulate-time state stop-time)
(set-accumulated-time! state
(+ (accumulated-time state)
(- stop-time (last-start-time state)))))
-(define (get-call-data proc)
- (define state (ensure-profiler-state))
+(define (get-call-data state proc)
(let ((k (cond
((program? proc) (program-code proc))
(else proc))))
@@ -253,13 +253,12 @@
;; growable vector, and resolve them to procedures when analyzing
;; instead of at collection time.
;;
-(define (sample-stack-procs stack)
+(define (sample-stack-procs state stack)
(let ((stacklen (stack-length stack))
- (hit-count-call? #f)
- (state (existing-profiler-state)))
+ (hit-count-call? #f))
- (if (record-full-stacks? state)
- (set-stacks! state (cons stack (stacks state))))
+ (when (record-full-stacks? state)
+ (set-stacks! state (cons stack (stacks state))))
(set-sample-count! state (+ (sample-count state) 1))
;; Now accumulate stats for the whole stack.
@@ -271,10 +270,11 @@
(hash-fold
(lambda (proc val accum)
(inc-call-data-cum-sample-count!
- (get-call-data proc)))
+ (get-call-data state proc)))
#f
procs-seen)
- (and=> (and=> self get-call-data)
+ (and=> (and=> self (lambda (proc)
+ (get-call-data state proc)))
inc-call-data-self-sample-count!))
((frame-procedure frame)
=> (lambda (proc)
@@ -301,40 +301,25 @@
;; FIXME: with-statprof should be able to set an outer frame for the
;; stack cut
- (if (positive? (profile-level state))
- (let* ((stop-time (get-internal-run-time))
- ;; cut down to the signal handler. note that this will only
- ;; work if statprof.scm is compiled; otherwise we get
- ;; `eval' on the stack instead, because if it's not
- ;; compiled, profile-signal-handler is a thunk that
- ;; tail-calls eval. perhaps we should always compile the
- ;; signal handler instead...
- (stack (or (make-stack #t profile-signal-handler)
- (pk 'what! (make-stack #t))))
- (inside-apply-trap? (sample-stack-procs stack)))
-
- (if (not inside-apply-trap?)
- (begin
- ;; disabling here is just a little more efficient, but
- ;; not necessary given inside-profiler?. We can't just
- ;; disable unconditionally at the top of this function
- ;; and eliminate inside-profiler? because it seems to
- ;; confuse guile wrt re-enabling the trap when
- ;; count-call finishes.
- (if (count-calls? state)
- (set-vm-trace-level! (1- (vm-trace-level))))
- (accumulate-time state stop-time)))
-
- (setitimer ITIMER_PROF
- 0 0
- (car (sampling-frequency state))
- (cdr (sampling-frequency state)))
-
- (if (not inside-apply-trap?)
- (begin
- (set-last-start-time! state (get-internal-run-time))
- (if (count-calls? state)
- (set-vm-trace-level! (1+ (vm-trace-level))))))))
+ (when (positive? (profile-level state))
+ (let* ((stop-time (get-internal-run-time))
+ ;; cut down to the signal handler. note that this will only
+ ;; work if statprof.scm is compiled; otherwise we get
+ ;; `eval' on the stack instead, because if it's not
+ ;; compiled, profile-signal-handler is a thunk that
+ ;; tail-calls eval. perhaps we should always compile the
+ ;; signal handler instead...
+ (stack (or (make-stack #t profile-signal-handler)
+ (pk 'what! (make-stack #t)))))
+
+ (sample-stack-procs state stack)
+ (accumulate-time state stop-time)
+ (set-last-start-time! state (get-internal-run-time))
+
+ (setitimer ITIMER_PROF
+ 0 0
+ (car (sampling-frequency state))
+ (cdr (sampling-frequency state)))))
(set-inside-profiler?! state #f))
@@ -344,16 +329,15 @@
(define (count-call frame)
(define state (existing-profiler-state))
- (if (not (inside-profiler? state))
- (begin
- (accumulate-time state (get-internal-run-time))
+ (unless (inside-profiler? state)
+ (accumulate-time state (get-internal-run-time))
- (and=> (frame-procedure frame)
- (lambda (proc)
- (inc-call-data-call-count!
- (get-call-data proc))))
+ (and=> (frame-procedure frame)
+ (lambda (proc)
+ (inc-call-data-call-count!
+ (get-call-data state proc))))
- (set-last-start-time! state (get-internal-run-time)))))
+ (set-last-start-time! state (get-internal-run-time))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -370,25 +354,25 @@ than @code{statprof-stop}, @code{#f} otherwise."
;; signals here, but if I'm wrong, please let me know.
(define state (ensure-profiler-state))
(set-profile-level! state (+ (profile-level state) 1))
- (if (= (profile-level state) 1)
- (let* ((rpt (remaining-prof-time state))
- (use-rpt? (and rpt
- (or (positive? (car rpt))
- (positive? (cdr rpt))))))
- (set-remaining-prof-time! state #f)
- (set-last-start-time! state (get-internal-run-time))
- (set-gc-time-taken! state
- (cdr (assq 'gc-time-taken (gc-stats))))
- (if use-rpt?
- (setitimer ITIMER_PROF 0 0 (car rpt) (cdr rpt))
- (setitimer ITIMER_PROF
- 0 0
- (car (sampling-frequency state))
- (cdr (sampling-frequency state))))
- (if (count-calls? state)
- (add-hook! (vm-apply-hook) count-call))
- (set-vm-trace-level! (1+ (vm-trace-level)))
- #t)))
+ (when (= (profile-level state) 1)
+ (let* ((rpt (remaining-prof-time state))
+ (use-rpt? (and rpt
+ (or (positive? (car rpt))
+ (positive? (cdr rpt))))))
+ (set-remaining-prof-time! state #f)
+ ;; FIXME: Use per-thread run time.
+ (set-last-start-time! state (get-internal-run-time))
+ (set-gc-time-taken! state (assq-ref (gc-stats) 'gc-time-taken))
+ (if use-rpt?
+ (setitimer ITIMER_PROF 0 0 (car rpt) (cdr rpt))
+ (setitimer ITIMER_PROF
+ 0 0
+ (car (sampling-frequency state))
+ (cdr (sampling-frequency state))))
+ (when (count-calls? state)
+ (add-hook! (vm-apply-hook) count-call))
+ (set-vm-trace-level! (1+ (vm-trace-level)))
+ #t)))
;; Do not call this from statprof internal functions -- user only.
(define (statprof-stop)
@@ -397,19 +381,18 @@ than @code{statprof-stop}, @code{#f} otherwise."
;; signals here, but if I'm wrong, please let me know.
(define state (ensure-profiler-state))
(set-profile-level! state (- (profile-level state) 1))
- (if (zero? (profile-level state))
- (begin
- (set-gc-time-taken! state
- (- (cdr (assq 'gc-time-taken (gc-stats)))
- (gc-time-taken state)))
- (set-vm-trace-level! (1- (vm-trace-level)))
- (if (count-calls? state)
- (remove-hook! (vm-apply-hook) count-call))
- ;; I believe that we need to do this before getting the time
- ;; (unless we want to make things even more complicated).
- (set-remaining-prof-time! state (setitimer ITIMER_PROF 0 0 0 0))
- (accumulate-time state (get-internal-run-time))
- (set-last-start-time! state #f))))
+ (when (zero? (profile-level state))
+ (set-gc-time-taken! state
+ (- (assq-ref (gc-stats) 'gc-time-taken)
+ (gc-time-taken state)))
+ (set-vm-trace-level! (1- (vm-trace-level)))
+ (when (count-calls? state)
+ (remove-hook! (vm-apply-hook) count-call))
+ ;; I believe that we need to do this before getting the time
+ ;; (unless we want to make things even more complicated).
+ (set-remaining-prof-time! state (setitimer ITIMER_PROF 0 0 0 0))
+ (accumulate-time state (get-internal-run-time))
+ (set-last-start-time! state #f)))
(define* (statprof-reset sample-seconds sample-microseconds count-calls?
#:optional full-stacks?)
@@ -450,7 +433,7 @@ it represents different functions with the same name."
none is available."
(when (statprof-active?)
(error "Can't call statprof-proc-call-data while profiler is running."))
- (get-call-data proc))
+ (get-call-data (existing-profiler-state) proc))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Stats
@@ -559,7 +542,8 @@ optional @var{port} argument is passed, uses the current
output port."
(simple-format #t "Sample count: ~A\n" (statprof-sample-count))
(simple-format #t "Total time: ~A seconds (~A seconds in GC)\n"
(statprof-accumulated-time)
- (/ (gc-time-taken state) 1.0
internal-time-units-per-second))))))
+ (/ (gc-time-taken state)
+ 1.0 internal-time-units-per-second))))))
(define (statprof-display-anomolies)
"A sanity check that attempts to detect anomolies in statprof's
@@ -568,14 +552,14 @@ address@hidden"
(statprof-fold-call-data
(lambda (data prior-value)
- (if (and (count-calls? state)
- (zero? (call-data-call-count data))
- (positive? (call-data-cum-sample-count data)))
- (simple-format #t
- "==[~A ~A ~A]\n"
- (call-data-name data)
- (call-data-call-count data)
- (call-data-cum-sample-count data))))
+ (when (and (count-calls? state)
+ (zero? (call-data-call-count data))
+ (positive? (call-data-cum-sample-count data)))
+ (simple-format #t
+ "==[~A ~A ~A]\n"
+ (call-data-name data)
+ (call-data-call-count data)
+ (call-data-cum-sample-count data))))
#f)
(simple-format #t "Total time: ~A\n" (statprof-accumulated-time))
(simple-format #t "Sample count: ~A\n" (statprof-sample-count)))
@@ -584,7 +568,7 @@ address@hidden"
"Returns the time accumulated during the last statprof address@hidden"
(when (statprof-active?)
(error "Can't get accumulated time while profiler is running."))
- (/ (accumulated-time (existing-profiler-state))
internal-time-units-per-second))
+ (/ (accumulated-time (existing-profiler-state)) 1.0
internal-time-units-per-second))
(define (statprof-sample-count)
"Returns the number of samples taken during the last statprof address@hidden"
@@ -686,10 +670,9 @@ whole call tree, for later analysis. Use
@code{statprof-fetch-stacks} or
(statprof-start))
(lambda ()
(let lp ((i loop))
- (if (not (zero? i))
- (begin
- (thunk)
- (lp (1- i))))))
+ (unless (zero? i)
+ (thunk)
+ (lp (1- i)))))
(lambda ()
(statprof-stop)
(statprof-display)
@@ -752,8 +735,8 @@ whole call tree, for later analysis. Use
@code{statprof-fetch-stacks} or
(define state (ensure-profiler-state))
(define (reset)
- (if (positive? (profile-level state))
- (error "Can't reset profiler while profiler is running."))
+ (when (positive? (profile-level state))
+ (error "Can't reset profiler while profiler is running."))
(set-accumulated-time! state 0)
(set-last-start-time! state #f)
(set-sample-count! state 0)
@@ -775,7 +758,7 @@ whole call tree, for later analysis. Use
@code{statprof-fetch-stacks} or
;; also.
(stack (or (make-stack #t gc-callback 0 1)
(pk 'what! (make-stack #t)))))
- (sample-stack-procs stack)
+ (sample-stack-procs state stack)
(accumulate-time state stop-time)
(set-last-start-time! state (get-internal-run-time)))
@@ -783,25 +766,23 @@ whole call tree, for later analysis. Use
@code{statprof-fetch-stacks} or
(define (start)
(set-profile-level! state (+ (profile-level state) 1))
- (if (= (profile-level state) 1)
- (begin
- (set-remaining-prof-time! state #f)
- (set-last-start-time! state (get-internal-run-time))
- (set-gc-time-taken! state (cdr (assq 'gc-time-taken (gc-stats))))
- (add-hook! after-gc-hook gc-callback)
- (set-vm-trace-level! (1+ (vm-trace-level)))
- #t)))
+ (when (= (profile-level state) 1)
+ (set-remaining-prof-time! state #f)
+ (set-last-start-time! state (get-internal-run-time))
+ (set-gc-time-taken! state (assq-ref (gc-stats) 'gc-time-taken))
+ (add-hook! after-gc-hook gc-callback)
+ (set-vm-trace-level! (1+ (vm-trace-level)))
+ #t))
(define (stop)
(set-profile-level! state (- (profile-level state) 1))
- (if (zero? (profile-level state))
- (begin
- (set-gc-time-taken! state
- (- (cdr (assq 'gc-time-taken (gc-stats)))
- (gc-time-taken state)))
- (remove-hook! after-gc-hook gc-callback)
- (accumulate-time state (get-internal-run-time))
- (set-last-start-time! state #f))))
+ (when (zero? (profile-level state))
+ (set-gc-time-taken! state
+ (- (assq-ref (gc-stats) 'gc-time-taken)
+ (gc-time-taken state)))
+ (remove-hook! after-gc-hook gc-callback)
+ (accumulate-time state (get-internal-run-time))
+ (set-last-start-time! state #f)))
(dynamic-wind
(lambda ()
@@ -809,10 +790,9 @@ whole call tree, for later analysis. Use
@code{statprof-fetch-stacks} or
(start))
(lambda ()
(let lp ((i loop))
- (if (not (zero? i))
- (begin
- (thunk)
- (lp (1- i))))))
+ (unless (zero? i)
+ (thunk)
+ (lp (1- i)))))
(lambda ()
(stop)
(statprof-display)
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. v2.1.0-779-g4b3d7a2,
Andy Wingo <=