diff options
author | Andy Wingo <wingo@pobox.com> | 2010-06-19 12:57:31 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2010-06-19 12:57:31 +0200 |
commit | d8158b837ed950c37cf33bddcd87464d4495d058 (patch) | |
tree | b1b2f77d25ee1701524dd9c64ef82ffcaa9581c1 | |
parent | bfccdcd53006c1e74676e48d338349e4119b0af9 (diff) | |
download | guile-d8158b837ed950c37cf33bddcd87464d4495d058.tar.gz |
deprecate save-stack, stack-saved?
* module/Makefile.am:
* module/ice-9/boot-9.scm:
* module/ice-9/save-stack.scm (stack-saved?, save-stack): Move these
bindings to their own module.
* module/oop/goops.scm (goops-error):
* module/ice-9/boot-9.scm (error, top-repl): Remove calls to save-stack.
* module/ice-9/deprecated.scm (stack-saved?, save-stack): Add deprecated
shims.
* module/ice-9/emacs.scm:
* module/ice-9/stack-catch.scm:
* module/ice-9/debugger/command-loop.scm:
* module/ice-9/scm-style-repl.scm: Import (ice-9 save-stack).
-rw-r--r-- | module/Makefile.am | 1 | ||||
-rw-r--r-- | module/ice-9/boot-9.scm | 22 | ||||
-rw-r--r-- | module/ice-9/debugger/command-loop.scm | 1 | ||||
-rw-r--r-- | module/ice-9/deprecated.scm | 24 | ||||
-rw-r--r-- | module/ice-9/emacs.scm | 3 | ||||
-rw-r--r-- | module/ice-9/save-stack.scm | 55 | ||||
-rw-r--r-- | module/ice-9/scm-style-repl.scm | 2 | ||||
-rw-r--r-- | module/ice-9/stack-catch.scm | 1 | ||||
-rw-r--r-- | module/oop/goops.scm | 3 |
9 files changed, 86 insertions, 26 deletions
diff --git a/module/Makefile.am b/module/Makefile.am index e0f1abd9b..08367c4ff 100644 --- a/module/Makefile.am +++ b/module/Makefile.am @@ -210,6 +210,7 @@ ICE_9_SOURCES = \ ice-9/rw.scm \ ice-9/safe-r5rs.scm \ ice-9/safe.scm \ + ice-9/save-stack.scm \ ice-9/scm-style-repl.scm \ ice-9/session.scm \ ice-9/slib.scm \ diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index e09bb9690..9947446a5 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -856,10 +856,8 @@ If there is no handler at all, Guile prints an error and then exits." (define error (case-lambda (() - (save-stack) (scm-error 'misc-error #f "?" #f #f)) ((message . args) - (save-stack) (let ((msg (string-join (cons "~A" (make-list (length args) "~S"))))) (scm-error 'misc-error #f msg (cons message args) #f))))) @@ -2690,25 +2688,6 @@ module '(ice-9 q) '(make-q q-length))}." (restore-signals)) ;;(define the-last-stack (make-fluid)) Defined by scm_init_backtrace () -;; FIXME: stack-saved? is broken in the presence of threads. -(define stack-saved? #f) - -(define (save-stack . narrowing) - (if (not stack-saved?) - (begin - (let ((stacks (fluid-ref %stacks))) - (fluid-set! the-last-stack - ;; (make-stack obj inner outer inner outer ...) - ;; - ;; In this case, cut away the make-stack frame, the - ;; save-stack frame, and then narrow as specified by the - ;; user, delimited by the nearest start-stack invocation, - ;; if any. - (apply make-stack #t - 2 - (if (pair? stacks) (cdar stacks) 0) - narrowing))) - (set! stack-saved? #t)))) (define (quit . args) (apply throw 'quit args)) @@ -3438,7 +3417,6 @@ module '(ice-9 q) '(make-q q-length))}." (lambda () (let ((make-handler (lambda (msg) (lambda (sig) - (save-stack 2) (scm-error 'signal #f msg diff --git a/module/ice-9/debugger/command-loop.scm b/module/ice-9/debugger/command-loop.scm index 5b38255db..b58952dcd 100644 --- a/module/ice-9/debugger/command-loop.scm +++ b/module/ice-9/debugger/command-loop.scm @@ -21,6 +21,7 @@ #:use-module (ice-9 debugger) #:use-module (ice-9 debugger state) #:use-module (ice-9 debugging traps) + #:use-module (ice-9 save-stack) #:export (debugger-command-loop debugger-command-loop-error debugger-command-loop-quit) diff --git a/module/ice-9/deprecated.scm b/module/ice-9/deprecated.scm index 1df674156..7bce63793 100644 --- a/module/ice-9/deprecated.scm +++ b/module/ice-9/deprecated.scm @@ -59,7 +59,9 @@ repl pre-unwind-handler-dispatch default-pre-unwind-handler - handle-system-error) + handle-system-error + stack-saved? + save-stack) #:replace (module-ref-submodule module-define-submodule!)) @@ -637,3 +639,23 @@ the `(system repl common)' module.") "`handle-system-error' is deprecated. Use it from `(ice-9 scm-style-repl)' if you need it.") (apply (@ (ice-9 scm-style-repl) handle-system-error) key args)) + +(define-syntax stack-saved? + (make-variable-transformer + (lambda (x) + (issue-deprecation-warning + "`stack-saved?' is deprecated. Use it from +`(ice-9 save-stack)' if you need it.") + (syntax-case x (set!) + ((set! id val) + (identifier? #'id) + #'(set! (@ (ice-9 save-stack) stack-saved?) val)) + (id + (identifier? #'id) + #'(@ (ice-9 save-stack) stack-saved?)))))) + +(define (save-stack . args) + (issue-deprecation-warning + "`save-stack' is deprecated. Use it from `(ice-9 save-stack)' if you need +it.") + (apply (@ (ice-9 save-stack) save-stack) args)) diff --git a/module/ice-9/emacs.scm b/module/ice-9/emacs.scm index 5bd52823c..341870a55 100644 --- a/module/ice-9/emacs.scm +++ b/module/ice-9/emacs.scm @@ -1,4 +1,4 @@ -;;;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2006, 2009 Free Software Foundation, Inc. +;;;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2006, 2009, 2010 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 @@ -32,6 +32,7 @@ :use-module (ice-9 debug) :use-module (ice-9 threads) :use-module (ice-9 session) + :use-module (ice-9 save-stack) :no-backtrace) (define emacs-escape-character #\sub) diff --git a/module/ice-9/save-stack.scm b/module/ice-9/save-stack.scm new file mode 100644 index 000000000..31eb8215e --- /dev/null +++ b/module/ice-9/save-stack.scm @@ -0,0 +1,55 @@ +;;; -*- mode: scheme; coding: utf-8; -*- + +;;;; Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010 +;;;; 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 +;;;; License as published by the Free Software Foundation; either +;;;; version 3 of the License, or (at your option) any later version. +;;;; +;;;; This library is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;;; Lesser General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU Lesser General Public +;;;; License along with this library; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA +;;;; + + + +;;; Commentary: + +;;; An older approack to debugging, in which the user installs a pre-unwind +;;; handler that saves the stack at the time of the error. The last stack can +;;; then be debugged later. +;;; + +;;; Code: + +(define-module (ice-9 save-stack) + ;; Replace deprecated root-module bindings, if present. + #:replace (stack-saved? + save-stack)) + +;; FIXME: stack-saved? is broken in the presence of threads. +(define stack-saved? #f) + +(define (save-stack . narrowing) + (if (not stack-saved?) + (begin + (let ((stacks (fluid-ref %stacks))) + (fluid-set! the-last-stack + ;; (make-stack obj inner outer inner outer ...) + ;; + ;; In this case, cut away the make-stack frame, the + ;; save-stack frame, and then narrow as specified by the + ;; user, delimited by the nearest start-stack invocation, + ;; if any. + (apply make-stack #t + 2 + (if (pair? stacks) (cdar stacks) 0) + narrowing))) + (set! stack-saved? #t)))) diff --git a/module/ice-9/scm-style-repl.scm b/module/ice-9/scm-style-repl.scm index d873b1007..947d0f036 100644 --- a/module/ice-9/scm-style-repl.scm +++ b/module/ice-9/scm-style-repl.scm @@ -17,6 +17,8 @@ ;;;; (define-module (ice-9 scm-style-repl) + #:use-module (ice-9 save-stack) + #:export (scm-repl-silent scm-repl-print-unspecified scm-repl-verbose diff --git a/module/ice-9/stack-catch.scm b/module/ice-9/stack-catch.scm index a8912da06..5087ad713 100644 --- a/module/ice-9/stack-catch.scm +++ b/module/ice-9/stack-catch.scm @@ -18,6 +18,7 @@ ;;;; (define-module (ice-9 stack-catch) + #:use-module (ice-9 save-stack) #:export (stack-catch)) (define (stack-catch key thunk handler) diff --git a/module/oop/goops.scm b/module/oop/goops.scm index 50d982895..d0d65fa08 100644 --- a/module/oop/goops.scm +++ b/module/oop/goops.scm @@ -1,6 +1,6 @@ ;;; installed-scm-file -;;;; Copyright (C) 1998,1999,2000,2001,2002, 2003, 2006, 2009 Free Software Foundation, Inc. +;;;; Copyright (C) 1998,1999,2000,2001,2002, 2003, 2006, 2009, 2010 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 @@ -105,7 +105,6 @@ ;; goops-error ;; (define (goops-error format-string . args) - (save-stack) (scm-error 'goops-error #f format-string args '())) ;; |