(in-package 'si)

(defvar *old-handler* #'si::universal-error-handler)

(defentry ihs_function_name (object) (object "ihs_function_name"))


(defun new-universal-error-handler
  (a b c d e &rest l &aux (i 0) (top (si::ihs-top)))
  (declare (fixnum  i top))
  (if (search "stack overflow" e)
      (progn (format t "~a in ~a" e d)
	     (format t "invocation stack:")
	     (loop (cond ((or (> i 20)
			      (< top 10))
			  (return nil)))
		   (setq i (+ i 1))
		   (setq top (- top 1))
		   (format t "< ~s " (ihs_function_name (si::ihs-fun top))))
	     (format t "Jumping to top")
	     (throw *quit-tag* nil)
	     )
    (apply *old-handler* a b c d e l)))


(setf (symbol-function 'si::universal-error-handler)
      #'new-universal-error-handler)