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

Diff of /slime/swank-clisp.lisp

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

revision 1.29 by mbaringer, Tue Apr 6 10:42:53 2004 UTC revision 1.30 by heller, Wed Apr 28 22:19:14 2004 UTC
# Line 90  Line 90 
90  ;;; Swank functions  ;;; Swank functions
91    
92  (defimplementation arglist (fname)  (defimplementation arglist (fname)
93    (ext:arglist fname))    (block nil
94        (or (ignore-errors (return (ext:arglist fname)))
95            :not-available)))
96    
97  (defimplementation macroexpand-all (form)  (defimplementation macroexpand-all (form)
98    (ext:expand-form form))    (ext:expand-form form))
# Line 148  Return NIL if the symbol is unbound." Line 150  Return NIL if the symbol is unbound."
150  (defvar *sldb-source*)  (defvar *sldb-source*)
151  (defvar *sldb-debugmode* 4)  (defvar *sldb-debugmode* 4)
152    
153    (defun frame-down (frame)
154      (sys::frame-down-1 frame sys::*debug-mode*))
155    
156    (defun frame-up (frame)
157      (sys::frame-up-1 frame sys::*debug-mode*))
158    
159  (defimplementation call-with-debugging-environment (debugger-loop-fn)  (defimplementation call-with-debugging-environment (debugger-loop-fn)
160    (let* ((sys::*break-count* (1+ sys::*break-count*))    (let* ((sys::*break-count* (1+ sys::*break-count*))
161           (sys::*driver* debugger-loop-fn)           (sys::*driver* debugger-loop-fn)
162           (sys::*fasoutput-stream* nil)           (sys::*fasoutput-stream* nil)
 ;;;      (sys::*frame-limit1* (sys::frame-limit1 43))  
163           (sys::*frame-limit1* (sys::frame-limit1 0))           (sys::*frame-limit1* (sys::frame-limit1 0))
164  ;;;      (sys::*frame-limit2* (sys::frame-limit2))           (sys::*frame-limit2* (sys::frame-limit2))
165           (sys::*debug-mode* *sldb-debugmode*)           (sys::*debug-mode* *sldb-debugmode*)
166           (*sldb-topframe*           (*sldb-topframe* sys::*frame-limit1*))
           (sys::frame-down-1  
            (sys::frame-up-1 sys::*frame-limit1* sys::*debug-mode*)  
            sys::*debug-mode*))  
          (*sldb-botframe* (sys::frame-up *sldb-topframe* sys::*debug-mode*)))  
167      (funcall debugger-loop-fn)))      (funcall debugger-loop-fn)))
168    
169  (defun nth-frame (index)  (defun nth-frame (index)
170    (loop for frame = *sldb-topframe* then (sys::frame-up-1 frame    (loop for frame = *sldb-topframe* then (frame-up frame)
                                                           sys::*debug-mode*)  
171          repeat index          repeat index
         never (eq frame *sldb-botframe*)  
172          finally (return frame)))          finally (return frame)))
173    
174  (defimplementation compute-backtrace (start end)  (defimplementation compute-backtrace (start end)
175    (let ((end (or end most-positive-fixnum)))    (let ((end (or end most-positive-fixnum)))
176      (loop for f = (nth-frame start)      (loop for last = nil then frame
177            then (sys::frame-up-1 f sys::*debug-mode*)            for frame = (nth-frame start) then (frame-up frame)
178            for i from start below end            for i from start below end
179            until (eq f *sldb-botframe*)            until (or (eq frame last) (system::driver-frame-p frame))
180            collect f)))            collect frame)))
181    
182  (defimplementation print-frame (frame stream)  (defimplementation print-frame (frame stream)
183    (write-string (string-left-trim '(#\Newline)    (write-string (string-left-trim '(#\Newline)

Legend:
Removed from v.1.29  
changed lines
  Added in v.1.30

  ViewVC Help
Powered by ViewVC 1.1.5