[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.0-63-gfd029c3

[Andy Wingo]

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=fd029c35de681efe530ba1e054e918c69d3602ef

The branch, stable-2.0 has been updated
       via  fd029c35de681efe530ba1e054e918c69d3602ef (commit)
       via  2dea6a4d33561e1403b1c330f2b8ed3d87f0d1c6 (commit)
       via  090f14b890ec31844bca6b93256a39d3bd80aba3 (commit)
       via  47b86dbf4dc3da2f4d6d41a018cd221fbf0823ee (commit)
       via  c7d6f8b27949e12b6e358e4c9580affddb339af6 (commit)
      from  65fa60ca7a7bbfd712371f7b2471efe7b056839c (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 fd029c35de681efe530ba1e054e918c69d3602ef
Author: BT Templeton <address@hidden>
Date:   Tue Feb 22 13:15:31 2011 -0500

    guile-snarf: allow multiple init actions on one line
    
    * libguile/guile-snarf.in (modern_snarf): Allow programs to specify
      multiple initialization actions on a single line. This makes it
      possible for C programs to define multiple subrs with a single macro
      invocation.
    
    * test-suite/standalone/test-guile-snarf: Enable more tests.

commit 2dea6a4d33561e1403b1c330f2b8ed3d87f0d1c6
Author: BT Templeton <address@hidden>
Date:   Tue Feb 22 15:15:33 2011 -0500

    add guile-snarf tests
    
    * test-suite/standalone/test-guile-snarf: New file.
    * test-suite/standalone/Makefile.am: Add `test-guile-snarf'.

commit 090f14b890ec31844bca6b93256a39d3bd80aba3
Author: Andy Wingo <address@hidden>
Date:   Fri Mar 4 11:16:15 2011 +0100

    repl: terminal-width by default
    
    * module/system/repl/command.scm (terminal-width): New parameter that
      will use the true terminal width if unset.
      (backtrace, locals): Default to (terminal-width).
      (width): Simplify.

commit 47b86dbf4dc3da2f4d6d41a018cd221fbf0823ee
Author: Michael Gran <address@hidden>
Date:   Sun Feb 20 21:53:46 2011 -0800

    Add ,width meta-command to set screen width in debug output
    
    This meta-command allows one to set the default number of columns
    that output from ,backtrace and ,locals shall occupy.
    
    * doc/ref/scheme-using.texi (Debug Commands): document ,width
    * module/system/repl/command.scm (*width*): new var
      (backtrace, locals): use *width* in optarg
      (width): new meta-command

commit c7d6f8b27949e12b6e358e4c9580affddb339af6
Author: Andy Wingo <address@hidden>
Date:   Fri Mar 4 10:33:51 2011 +0100

    fix ,stat
    
    * module/system/repl/command.scm (statistics): Fix for BDW-GC.
      Unfortunately we still don't have mallocation or time taken.

-----------------------------------------------------------------------

Summary of changes:
 doc/ref/scheme-using.texi              |    6 +++
 libguile/guile-snarf.in                |    2 +-
 module/system/repl/command.scm         |   56 ++++++++++++++++++++------------
 test-suite/standalone/Makefile.am      |    3 ++
 test-suite/standalone/test-guile-snarf |   20 +++++++++++
 5 files changed, 65 insertions(+), 22 deletions(-)
 create mode 100755 test-suite/standalone/test-guile-snarf

diff --git a/doc/ref/scheme-using.texi b/doc/ref/scheme-using.texi
index 126b845..a119d42 100644
--- a/doc/ref/scheme-using.texi
+++ b/doc/ref/scheme-using.texi
@@ -337,6 +337,12 @@ Show the VM registers associated with the current frame.
 @xref{Stack Layout}, for more information on VM stack frames.
 @end deffn
 
address@hidden {REPL Command} width [cols]
+Sets the number of display columns in the output of @code{,backtrace}
+and @code{,locals} to @var{cols}.  If @var{cols} is not given, the width
+of the terminal is used.
address@hidden deffn
+
 The next 3 commands work at any REPL.
 
 @deffn {REPL Command} break proc
diff --git a/libguile/guile-snarf.in b/libguile/guile-snarf.in
index 043b3ed..a1aeba5 100644
--- a/libguile/guile-snarf.in
+++ b/libguile/guile-snarf.in
@@ -51,7 +51,7 @@ modern_snarf ()                         # writes stdout
     ## empty file.
     echo "/* cpp arguments: $@ */" ;
     ${cpp} -DSCM_MAGIC_SNARF_INITS -DSCM_MAGIC_SNARFER "$@" > ${temp} && 
cpp_ok_p=true
-    grep "^ *\^ *\^" ${temp} | sed -e "s/ *\^ *\^//g" -e "s/\^ *: *\^/;/g"
+    sed -ne "s/ *\^ *: *\^/\n/;s/[^\n]*\^ *\^ *\([^\n]*\)/\1;/;tx;d;:x;P;D" 
${temp}
 }
 
 ## main
diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index d4b3e4a..685eebb 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
@@ -71,6 +71,20 @@
 (define *show-table*
   '((show (warranty w) (copying c) (version v))))
 
+(define terminal-width
+  (let ((set-width #f))
+    (case-lambda
+      (()
+       (or set-width
+           (let ((w (false-if-exception (string->number (getenv "COLUMNS")))))
+             (and (integer? w) (exact? w) (> w 0) w))
+           72))
+      ((w)
+       (if (or (not w) (and (integer? w) (exact? w) (> w 0)))
+           (set! set-width w)
+           (error "Expected a column number (a positive integer)" w))))))
+
+
 (define (group-name g) (car g))
 (define (group-commands g) (cdr g))
 
@@ -546,7 +560,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 +640,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 +825,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 +881,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
diff --git a/test-suite/standalone/Makefile.am 
b/test-suite/standalone/Makefile.am
index 3e32067..d839e23 100644
--- a/test-suite/standalone/Makefile.am
+++ b/test-suite/standalone/Makefile.am
@@ -72,6 +72,9 @@ TESTS += test-bad-identifiers
 check_SCRIPTS += test-require-extension
 TESTS += test-require-extension
 
+check_SCRIPTS += test-guile-snarf
+TESTS += test-guile-snarf
+
 # test-num2integral
 test_num2integral_SOURCES = test-num2integral.c
 test_num2integral_CFLAGS = ${test_cflags}
diff --git a/test-suite/standalone/test-guile-snarf 
b/test-suite/standalone/test-guile-snarf
new file mode 100755
index 0000000..78d35ea
--- /dev/null
+++ b/test-suite/standalone/test-guile-snarf
@@ -0,0 +1,20 @@
+#!/bin/sh
+snarf ()
+{
+    echo "$1" | guile-snarf - | tail -n +2 | tr -d ' \t\n'
+}
+
+snarf_test ()
+{
+    x=`snarf "$1"`
+    if [ x"$x" != x"$2" ]; then
+        echo "Incorrect output: expected \"$2\", but got \"$x\""
+        exit 1
+    fi
+}
+
+snarf_test "^^a^:^" "a;"
+snarf_test "  ^  ^  b  ^  :  ^  " "b;"
+snarf_test "c\n^^d^:^\ne" "d;"
+snarf_test "f^^g^:^h" "g;"
+snarf_test "^^i^:^j^^k^:^" "i;k;"


hooks/post-receive
-- 
GNU Guile