File: gcl_stack-problem.lsp

package info (click to toggle)
gcl 2.6.14-19
  • links: PTS
  • area: main
  • in suites: forky, sid, trixie
  • size: 60,804 kB
  • sloc: ansic: 177,407; lisp: 151,508; asm: 128,169; sh: 22,510; cpp: 11,923; tcl: 3,181; perl: 2,930; makefile: 2,360; sed: 334; yacc: 226; lex: 95; awk: 30; fortran: 24; csh: 23
file content (29 lines) | stat: -rwxr-xr-x 756 bytes parent folder | download | duplicates (6) 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
 
(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)