summaryrefslogtreecommitdiff
path: root/module/system/repl/command.scm
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2011-04-11 23:30:52 +0200
committerAndy Wingo <wingo@pobox.com>2011-04-11 23:30:52 +0200
commit21c05db45b69f8a62b84c36abc86cb935fa967d7 (patch)
tree743df01da540e7fd628f54894e7d5fbe94b03996 /module/system/repl/command.scm
parent4db853d747ac115f799c93e2de93f5159ad84109 (diff)
parentc89b45299329d034875429804f18768c1ea96713 (diff)
downloadguile-21c05db45b69f8a62b84c36abc86cb935fa967d7.tar.gz
Merge remote branch 'origin/stable-2.0'
Conflicts: GUILE-VERSION test-suite/tests/srfi-4.test
Diffstat (limited to 'module/system/repl/command.scm')
-rw-r--r--module/system/repl/command.scm48
1 files changed, 26 insertions, 22 deletions
diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index d4b3e4a77..109b533f8 100644
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -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
@@ -465,7 +465,11 @@ Compile a file."
(define-meta-command (disassemble repl (form))
"disassemble EXP
Disassemble a compiled procedure."
- (guile:disassemble (repl-eval repl (repl-parse repl form))))
+ (let ((obj (repl-eval repl (repl-parse repl form))))
+ (if (or (program? obj) (objcode? obj))
+ (guile:disassemble obj)
+ (format #t "Argument to ,disassemble not a procedure or objcode: ~a~%"
+ obj))))
(define-meta-command (disassemble-file repl file)
"disassemble-file FILE
@@ -546,7 +550,7 @@ Trace execution."
(format #t "Nothing to debug.~%"))))))))
(define-stack-command (backtrace repl #:optional count
- #:key (width 72) full?)
+ #:key (width (terminal-width)) full?)
"backtrace [COUNT] [#:width W] [#:full? F]
Print a backtrace.
@@ -626,12 +630,12 @@ With an argument, select a frame by index, then show it."
Print the procedure for the selected frame."
(repl-print repl (frame-procedure cur)))
-(define-stack-command (locals repl)
+(define-stack-command (locals repl #:key (width (terminal-width)))
"locals
Show local variables.
Show locally-bound variables in the selected frame."
- (print-locals cur))
+ (print-locals cur #:width width))
(define-stack-command (error-message repl)
"error-message
@@ -811,6 +815,15 @@ Print registers.
Print the registers of the current frame."
(print-registers cur))
+(define-meta-command (width repl #:optional x)
+ "width [X]
+Set debug output width.
+
+Set the number of screen columns in the output from `backtrace' and
+`locals'."
+ (terminal-width x)
+ (format #t "Set screen width to ~a columns.~%" (terminal-width)))
+
;;;
@@ -858,30 +871,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