lib/gdb/init.scm

23 (define %orig-input-port #f)
24 (define %orig-output-port #f)
25 (define %orig-error-port #f)
38 (define (%exception-printer port key args default-printer)
42 	       (format port "In procedure ~a: " subr))
43 	   (apply format port msg (or args '())))
52 (define (%with-stack-exception-printer port key args default-printer)
55     (%exception-printer port real-key real-args default-printer)))
60 (define (%print-exception-message-worker port key args)
62     (format port "Throw to key `~a' with args `~s'." key args))
63   (format port "ERROR: ")
67 	   (%exception-printer port key args default-printer))
69 	   (format port "Error while printing gdb exception: ~a ~s."
71   (newline port)
72   (force-output port))
78 (define (%print-exception-message port frame key args)
80 	 (%print-exception-message-worker port key args))
82 	 (print-exception port frame key args)))
88 ;; If PORT is #f, use the standard error port.
96 (define (%print-exception-with-stack port stack key args)
99 	(let ((error-port (current-error-port))
101 	  (if (not port)
102 	      (set! port error-port))
103 	  (if (eq? port error-port)
105 		(force-output (current-output-port))
106 		;; In case the current output port is not gdb's output port.
107 		(force-output (output-port))))
132 		(display "Guile Backtrace:\n" port)
133 		(display-backtrace stack port #f #f '())
134 		(newline port)))
136 	  (%print-exception-message port frame key args)))))
147   (set! %orig-input-port (set-current-input-port (input-port)))
148   (set! %orig-output-port (set-current-output-port (output-port)))
149   (set! %orig-error-port (set-current-error-port (error-port))))
160 (define-public (orig-input-port) %orig-input-port)
161 (define-public (orig-output-port) %orig-output-port)
162 (define-public (orig-error-port) %orig-error-port)