← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to lsp/gcl_stack-problem.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
lsp/gcl_stack-problem.lsp
 
1
(in-package 'si)
 
2
 
 
3
(defvar *old-handler* #'si::universal-error-handler)
 
4
 
 
5
(defentry ihs_function_name (object) (object "ihs_function_name"))
 
6
 
 
7
 
 
8
(defun new-universal-error-handler
 
9
  (a b c d e &rest l &aux (i 0) (top (si::ihs-top)))
 
10
  (declare (fixnum  i top))
 
11
  (if (search "stack overflow" e)
 
12
      (progn (format t "~a in ~a" e d)
 
13
             (format t "invocation stack:")
 
14
             (loop (cond ((or (> i 20)
 
15
                              (< top 10))
 
16
                          (return nil)))
 
17
                   (setq i (+ i 1))
 
18
                   (setq top (- top 1))
 
19
                   (format t "< ~s " (ihs_function_name (si::ihs-fun top))))
 
20
             (format t "Jumping to top")
 
21
             (throw *quit-tag* nil)
 
22
             )
 
23
    (apply *old-handler* a b c d e l)))
 
24
 
 
25
 
 
26
(setf (symbol-function 'si::universal-error-handler)
 
27
      #'new-universal-error-handler)
 
28
 
 
29