mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-29 16:30:19 +02:00
Code Activity

fix ,stat

Browse source 
* module/system/repl/command.scm (statistics): Fix for BDW-GC.
  Unfortunately we still don't have mallocation or time taken.
This commit is contained in:
Andy Wingo 2011-03-04 10:33:51 +01:00
parent 65fa60ca7a
commit c7d6f8b279
1 changed files with 9 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

27
module/system/repl/command.scm
View file

@ -1,6 +1,6 @@
;;; Repl commands
;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc.
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
@ -858,30 +858,21 @@ Display statistics."
(display-diff-stat "GC times:" #t this-times last-times "times")
(newline))
;; Memory size
(let ((this-cells (assq-ref this-gcs 'cells-allocated))
(this-heap (assq-ref this-gcs 'cell-heap-size))
(this-bytes (assq-ref this-gcs 'bytes-malloced))
(this-malloc (assq-ref this-gcs 'gc-malloc-threshold)))
(let ((this-heap (assq-ref this-gcs 'heap-size))
(this-free (assq-ref this-gcs 'heap-free-size)))
(display-stat-title "Memory size:" "current" "limit")
(display-stat "heap" #f this-cells this-heap "cells")
(display-stat "malloc" #f this-bytes this-malloc "bytes")
(display-stat "heap" #f (- this-heap this-free) this-heap "bytes")
(newline))
;; Cells collected
(let ((this-marked (assq-ref this-gcs 'cells-marked))
(last-marked (assq-ref last-gcs 'cells-marked))
(this-swept (assq-ref this-gcs 'cells-swept))
(last-swept (assq-ref last-gcs 'cells-swept)))
(display-stat-title "Cells collected:" "diff" "total")
(display-diff-stat "marked" #f this-marked last-marked "cells")
(display-diff-stat "swept" #f this-swept last-swept "cells")
(let ((this-alloc (assq-ref this-gcs 'heap-total-allocated))
(last-alloc (assq-ref last-gcs 'heap-total-allocated)))
(display-stat-title "Bytes allocated:" "diff" "total")
(display-diff-stat "allocated" #f this-alloc last-alloc "bytes")
(newline))
;; GC time taken
(let ((this-mark (assq-ref this-gcs 'gc-mark-time-taken))
(last-mark (assq-ref last-gcs 'gc-mark-time-taken))
(this-total (assq-ref this-gcs 'gc-time-taken))
(let ((this-total (assq-ref this-gcs 'gc-time-taken))
(last-total (assq-ref last-gcs 'gc-time-taken)))
(display-stat-title "GC time taken:" "diff" "total")
(display-time-stat "mark" this-mark last-mark)
(display-time-stat "total" this-total last-total)
(newline))
;; Process time spent