diff --git a/module/ice-9/debug.scm b/module/ice-9/debug.scm index 2f728e78f..380b04595 100644 --- a/module/ice-9/debug.scm +++ b/module/ice-9/debug.scm @@ -19,117 +19,7 @@ ;;;; -(define-module (ice-9 debug) - #:use-module (ice-9 save-stack) - #:export (frame-number->index trace untrace trace-stack untrace-stack)) +(define-module (ice-9 debug)) - -;;; {Misc} -;;; -(define (frame-number->index n . stack) - (let ((stack (if (null? stack) - (fluid-ref the-last-stack) - (car stack)))) - (if (memq 'backwards (debug-options)) - n - (- (stack-length stack) n 1)))) - - -;;; {Trace} -;;; -;;; This code is just an experimental prototype (e. g., it is not -;;; thread safe), but since it's at the same time useful, it's -;;; included anyway. -;;; -(define traced-procedures '()) - -(define (trace . args) - (if (null? args) - (nameify traced-procedures) - (begin - (for-each (lambda (proc) - (if (not (procedure? proc)) - (error "trace: Wrong type argument:" proc)) - (set-procedure-property! proc 'trace #t) - (if (not (memq proc traced-procedures)) - (set! traced-procedures - (cons proc traced-procedures)))) - args) - (trap-set! apply-frame-handler trace-entry) - (trap-set! exit-frame-handler trace-exit) - ;; We used to reset `trace-level' here to 0, but this is wrong - ;; if `trace' itself is being traced, since `trace-exit' will - ;; then decrement `trace-level' to -1! It shouldn't actually - ;; be necessary to set `trace-level' here at all. - (debug-enable 'trace) - (nameify args)))) - -(define (untrace . args) - (if (and (null? args) - (not (null? traced-procedures))) - (apply untrace traced-procedures) - (begin - (for-each (lambda (proc) - (set-procedure-property! proc 'trace #f) - (set! traced-procedures (delq! proc traced-procedures))) - args) - (if (null? traced-procedures) - (debug-disable 'trace)) - (nameify args)))) - -(define (nameify ls) - (map (lambda (proc) - (let ((name (procedure-name proc))) - (or name proc))) - ls)) - -(define trace-level 0) -(add-hook! abort-hook (lambda () (set! trace-level 0))) - -(define traced-stack-ids (list 'repl-stack)) -(define trace-all-stacks? #f) - -(define (trace-stack id) - "Add ID to the set of stack ids for which tracing is active. -If `#t' is in this set, tracing is active regardless of stack context. -To remove ID again, use `untrace-stack'. If you add the same ID twice -using `trace-stack', you will need to remove it twice." - (set! traced-stack-ids (cons id traced-stack-ids)) - (set! trace-all-stacks? (memq #t traced-stack-ids))) - -(define (untrace-stack id) - "Remove ID from the set of stack ids for which tracing is active." - (set! traced-stack-ids (delq1! id traced-stack-ids)) - (set! trace-all-stacks? (memq #t traced-stack-ids))) - -(define (trace-entry key cont tail) - (if (or trace-all-stacks? - (memq (stack-id cont) traced-stack-ids)) - (let ((cep (current-error-port)) - (frame (last-stack-frame cont))) - (if (not tail) - (set! trace-level (+ trace-level 1))) - (let indent ((n trace-level)) - (cond ((> n 1) (display "| " cep) (indent (- n 1))))) - (display-application frame cep) - (newline cep))) - ;; It's not necessary to call the continuation since - ;; execution will continue if the handler returns - ;(cont #f) - ) - -(define (trace-exit key cont retval) - (if (or trace-all-stacks? - (memq (stack-id cont) traced-stack-ids)) - (let ((cep (current-error-port))) - (set! trace-level (- trace-level 1)) - (let indent ((n trace-level)) - (cond ((> n 0) (display "| " cep) (indent (- n 1))))) - (write retval cep) - (newline cep)))) - - -;;; A fix to get the error handling working together with the module system. -;;; -;;; XXX - Still needed? -(module-set! the-root-module 'debug-options debug-options) +(issue-deprecation-warning + "(ice-9 debug) is deprecated. Use (system vm trace) for tracing.") diff --git a/module/ice-9/debugger/commands.scm b/module/ice-9/debugger/commands.scm index 56f166257..eece990fb 100644 --- a/module/ice-9/debugger/commands.scm +++ b/module/ice-9/debugger/commands.scm @@ -17,7 +17,6 @@ ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA (define-module (ice-9 debugger commands) - #:use-module (ice-9 debug) #:use-module ((ice-9 scm-style-repl) #:select (bad-throw)) #:use-module (ice-9 debugger) #:use-module (ice-9 debugger state) diff --git a/module/ice-9/debugging/trace.scm b/module/ice-9/debugging/trace.scm index 76160e177..c8d24d09e 100644 --- a/module/ice-9/debugging/trace.scm +++ b/module/ice-9/debugging/trace.scm @@ -1,6 +1,6 @@ ;;;; (ice-9 debugging trace) -- breakpoint trace behaviour -;;; Copyright (C) 2002 Free Software Foundation, Inc. +;;; Copyright (C) 2002, 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 @@ -17,7 +17,6 @@ ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA (define-module (ice-9 debugging trace) - #:use-module (ice-9 debug) #:use-module (ice-9 debugger) #:use-module (ice-9 debugger utils) #:use-module (ice-9 debugging steps) diff --git a/module/ice-9/emacs.scm b/module/ice-9/emacs.scm index 341870a55..2eb7a7f9e 100644 --- a/module/ice-9/emacs.scm +++ b/module/ice-9/emacs.scm @@ -29,7 +29,6 @@ ;;; (define-module (ice-9 emacs) - :use-module (ice-9 debug) :use-module (ice-9 threads) :use-module (ice-9 session) :use-module (ice-9 save-stack) diff --git a/module/ice-9/top-repl.scm b/module/ice-9/top-repl.scm index e41da4e7c..c5039f534 100644 --- a/module/ice-9/top-repl.scm +++ b/module/ice-9/top-repl.scm @@ -54,16 +54,13 @@ (process-use-modules (append '(((ice-9 r5rs)) - ((ice-9 session)) - ((ice-9 debug))) + ((ice-9 session))) (if (provided? 'regex) '(((ice-9 regex))) '()) (if (provided? 'threads) '(((ice-9 threads))) '()))) - ;; load debugger on demand - (module-autoload! guile-user-module '(system vm debug) '(debug)) (call-with-sigint (lambda ()