mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-20 02:30:23 +02:00
Code Activity

Fix statprof for optimizations

Browse source 
* module/statprof.scm (profile-signal-handler): Bind in a letrec.
  Otherwise the compiler may see the closure slot as dead, and the inner
  stack cut won't work.
This commit is contained in:
Andy Wingo 2014-04-16 19:12:43 +02:00
parent 6eae3141bf
commit 3f71590f20
1 changed files with 26 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

45
module/statprof.scm
View file

@ -337,29 +337,36 @@
(let ((prev (setitimer ITIMER_PROF 0 0 0 usecs))) (let ((prev (setitimer ITIMER_PROF 0 0 0 usecs)))
(+ (* (caadr prev) #e1e6) (cdadr prev)))) (+ (* (caadr prev) #e1e6) (cdadr prev))))
(define (profile-signal-handler sig) (define profile-signal-handler
(define state (existing-profiler-state)) (let ()
(define (profile-signal-handler sig)
(define state (existing-profiler-state))
(set-inside-profiler?! state #t) (set-inside-profiler?! state #t)
(when (positive? (profile-level state)) (when (positive? (profile-level state))
(let* ((stop-time (get-internal-run-time)) (let* ((stop-time (get-internal-run-time))
;; Cut down to the signal handler. Note that this will only ;; Cut down to the signal handler. Note that this will
;; work if statprof.scm is compiled; otherwise we get `eval' ;; only work if statprof.scm is compiled; otherwise we
;; on the stack instead, because if it's not compiled, ;; get `eval' on the stack instead, because if it's not
;; profile-signal-handler is a thunk that tail-calls eval. ;; compiled, profile-signal-handler is a thunk that
;; Perhaps we should always compile the signal handler ;; tail-calls eval. For the same reason we define the
;; instead. ;; handler in an inner letrec, so that the compiler sees
(stack (or (make-stack #t profile-signal-handler (outer-cut state)) ;; the inner reference to profile-signal-handler as the
(pk 'what! (make-stack #t))))) ;; same as the procedure, and therefore keeps slot 0
;; alive. Nastiness, that.
(stack
(or (make-stack #t profile-signal-handler (outer-cut state))
(pk 'what! (make-stack #t)))))
(sample-stack-procs state stack) (sample-stack-procs state stack)
(accumulate-time state stop-time) (accumulate-time state stop-time)
(set-last-start-time! state (get-internal-run-time)) (set-last-start-time! state (get-internal-run-time))
(reset-sigprof-timer (sampling-period state)))) (reset-sigprof-timer (sampling-period state))))
(set-inside-profiler?! state #f)) (set-inside-profiler?! state #f))
profile-signal-handler))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Count total calls. ;; Count total calls.