/[slime]/slime/swank-allegro.lisp
ViewVC logotype

Diff of /slime/swank-allegro.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.138 by heller, Tue Mar 9 08:15:05 2010 UTC revision 1.139 by heller, Tue Mar 9 09:20:13 2010 UTC
# Line 213  Line 213 
213      (cond ((not debug-info)      (cond ((not debug-info)
214             (function-source-location fun))             (function-source-location fun))
215            (t            (t
216             (let* ((return-loc (find pc debug-info :key #'excl::ldb-code-pc))             (let* ((code-loc (find-if (lambda (c)
217                    (prev (and return-loc (excl::ldb-code-prev-rec return-loc)))                                         (<= (- pc (sys::natural-width))
218                    (call-loc (if (integerp prev)                                             (excl::ldb-code-pc c)
219                                  (aref debug-info prev)                                             pc))
220                                  return-loc)))                                       debug-info)))
221               (cond ((not call-loc)               (cond ((not code-loc)
222                      (ldb-code-to-src-loc (aref debug-info 0)))                      (ldb-code-to-src-loc (aref debug-info 0)))
223                     (t                     (t
224                      (ldb-code-to-src-loc call-loc))))))))                      (ldb-code-to-src-loc code-loc))))))))
225    
226  #+(version>= 8 2)  #+(version>= 8 2)
227  (defun ldb-code-to-src-loc (code)  (defun ldb-code-to-src-loc (code)

Legend:
Removed from v.1.138  
changed lines
  Added in v.1.139

  ViewVC Help
Powered by ViewVC 1.1.5