guile aborting during backtrace.

[Russ McManus <mcmanr@eq.gs.com>]

i have a sizeable application using guile, and i have been trying to
get guile to display a backtrace whenever an error was thrown during
the program's execution.

thanks to marius vollmer and the source in boot-9.scm, i came up with
a function called 'fancy-call-with-error-catching' that seems to do
the job.

this function seemed to work well, except in a single case.  i had a
large function with many internal defines that caused guile to abort
if an error was thrown while this function was on the stack.  when i
broke the function into smaller pieces (probably a good idea anyway
;^) ) guile was able to print the backtraces with no problems.

i suspect that my program tickled a subtle bug buried in guile's stack
handling.  it is of course possible that i've done something wrong, so
i've included my error handling functions.  please let me know if there
is something obviously wrong with the code below, or if you can think
of any techniques to help me track the bug to it's ultimate source.

the program is written in c++, and application level events are
converted into call-outs into the scheme world.  each call out
evaluates code wrapped in a function called
'call-with-error-catching'.  i have been trying to get this working
off and on for several months.

here is the code:


(define (fancy-call-with-error-catching thunk)
  "craps out on a large function with many internal defines."
  (define (handle-error key args)
    (let ((cep (current-error-port)))
      (if the-last-stack
	  (display-backtrace the-last-stack cep)
	  (display "no backtrace available.\n" cep))
      (apply display-error the-last-stack cep args)
      (force-output cep)
      (fte:set-status-message! (build-error-string key args))
      ;(throw 'abort key)
      ))

  (define (save-stack)
    (cond (stack-saved?)
	  ((not (memq 'debug (debug-options-interface)))
	   (set! the-last-stack #f)
	   (set! stack-saved? #t))
	  (else
	   (set! the-last-stack (make-stack #t lazy-dispatch 4))
	   (set! stack-saved? #t))))

  (define (lazy-dispatch key . args)
    (save-stack)
    (apply throw key args))

  (start-stack #t
	       (catch #t
		      (lambda ()
			(lazy-catch #t
				    thunk
				    lazy-dispatch))
		      (lambda (key . args)
			(if (= (length args) 4)
			    (handle-error key args)
			    (apply throw key args)
			    )))))

(define (simple-call-with-error-catching thunk)
  "never craps out."
  (catch #t 
	 thunk
	 (lambda (tag . args)
	   (for-each display (list "caught error, tag " tag " args " args "\n"))
	   (fte:set-status-message! (build-error-string tag args)))))

(define call-with-error-catching fancy-call-with-error-catching)
;(define call-with-error-catching simple-call-with-error-catching)

--
Idle RAM is the Devil's playground.