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

Diff of /slime/swank-backend.lisp

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

revision 1.9 by lgorrie, Mon Dec 15 05:27:55 2003 UTC revision 1.94 by heller, Sun Nov 20 23:25:38 2005 UTC
# Line 1  Line 1 
1  ;;;; -*- Mode: lisp; indent-tabs-mode: nil; outline-regexp: ";;;;;*" -*-  ;;; -*- Mode: lisp; indent-tabs-mode: nil; outline-regexp: ";;;;;*" -*-
2  ;;;  ;;;
3  ;;; slime-impl.lisp --- Slime interface reference implementation.  ;;; slime-backend.lisp --- SLIME backend interface.
4  ;;;  ;;;
5  ;;; Copyright (C) 2003, James Bielman  <jamesjb@jamesjb.com>  ;;; Created by James Bielman in 2003. Released into the public domain.
 ;;; Released into the public domain.  
6  ;;;  ;;;
7  ;;;   $Id$  ;;;; Frontmatter
8  ;;;  ;;;
9    ;;; This file defines the functions that must be implemented
10    ;;; separately for each Lisp. Each is declared as a generic function
11    ;;; for which swank-<implementation>.lisp provides methods.
12    
13  ;; This is a skeletal implementation of the Slime internals interface.  (defpackage :swank-backend
 ;;  
 ;; The idea is to create a de-facto standard interface that can be  
 ;; used by editor <-> CL integration software, such as Slime.  Vendors  
 ;; are encouraged to comment on this interface.  
   
 (defpackage :swank  
14    (:use :common-lisp)    (:use :common-lisp)
15    (:nicknames #:swank-backend)    (:export #:sldb-condition
16    (:export #:*sldb-pprint-frames*             #:original-condition
17             #:apropos-list-for-emacs             #:compiler-condition
18             #:arglist-string             #:message
19             #:backtrace             #:short-message
20             #:call-with-I/O-lock             #:condition
21             #:call-with-conversation-lock             #:severity
22             #:compiler-notes-for-emacs             #:location
23             #:completions             #:location-p
24             #:create-swank-server             #:location-buffer
25             #:describe-alien-enum             #:location-position
26             #:describe-alien-struct             #:position-p
27             #:describe-alien-type             #:position-pos
28             #:describe-alien-union             #:print-output-to-string
29             #:describe-class             #:quit-lisp
30             #:describe-function             #:references
31             #:describe-inspectee             #:unbound-slot-filler
32             #:describe-setf-function             ;; inspector related symbols
33             #:describe-symbol             #:inspector
34             #:describe-type             #:inspect-for-emacs
35             #:disassemble-symbol             #:raw-inspection
36             #:documentation-symbol             #:fancy-inspection
37             #:eval-in-frame             #:label-value-line
38             #:eval-string             #:label-value-line*
            #:eval-string-in-frame  
            #:find-function-locations  
            #:frame-catch-tags  
            #:frame-locals  
            #:frame-source-location-for-emacs  
            #:frame-source-position  
            #:getpid  
            #:give-goahead  
            #:give-gohead  
            #:init-inspector  
            #:inspect-in-frame  
            #:inspect-nth-part  
            #:inspector-next  
            #:inspector-pop  
            #:interactive-eval  
            #:interactive-eval-region  
            #:invoke-nth-restart  
            #:list-all-package-names  
            #:list-callees  
            #:list-callers  
            #:listener-eval  
            #:load-file  
            #:pprint-eval  
            #:pprint-eval-string-in-frame  
            #:quit-inspector  
            #:re-evaluate-defvar  
            #:set-default-directory  
            #:set-package  
            #:sldb-abort  
            #:sldb-continue  
            #:slime-debugger-function  
            #:start-server  
            #:startup-multiprocessing  
            #:startup-multiprocessing-for-emacs  
            #:swank-compile-file  
            #:swank-compile-string  
            #:swank-macroexpand  
            #:swank-macroexpand-1  
            #:swank-macroexpand-all  
            #:take-input  
            #:thread-id  
            #:thread-name  
            #:throw-to-toplevel  
            #:toggle-trace-fdefinition  
            #:untrace-all  
            #:wait-goahead  
            #:who-binds  
            #:who-calls  
            #:who-macroexpands  
            #:who-references  
            #:who-sets  
39             ))             ))
40    
41  (in-package :swank)  (defpackage :swank-mop
42      (:use)
43      (:export
44       ;; classes
45       #:standard-generic-function
46       #:standard-slot-definition
47       #:standard-method
48       #:standard-class
49       #:eql-specializer
50       #:eql-specializer-object
51       ;; standard-class readers
52       #:class-default-initargs
53       #:class-direct-default-initargs
54       #:class-direct-slots
55       #:class-direct-subclasses
56       #:class-direct-superclasses
57       #:class-finalized-p
58       #:class-name
59       #:class-precedence-list
60       #:class-prototype
61       #:class-slots
62       #:specializer-direct-methods
63       ;; generic function readers
64       #:generic-function-argument-precedence-order
65       #:generic-function-declarations
66       #:generic-function-lambda-list
67       #:generic-function-methods
68       #:generic-function-method-class
69       #:generic-function-method-combination
70       #:generic-function-name
71       ;; method readers
72       #:method-generic-function
73       #:method-function
74       #:method-lambda-list
75       #:method-specializers
76       #:method-qualifiers
77       ;; slot readers
78       #:slot-definition-allocation
79       #:slot-definition-documentation
80       #:slot-definition-initargs
81       #:slot-definition-initform
82       #:slot-definition-initfunction
83       #:slot-definition-name
84       #:slot-definition-type
85       #:slot-definition-readers
86       #:slot-definition-writers
87       ;; generic function protocol
88       #:compute-applicable-methods-using-classes
89       #:finalize-inheritance))
90    
91    (in-package :swank-backend)
92    
93    
94  ;;;; Conditions and Error Handling  ;;;; Metacode
95    
96  ;; XXX need to specify restart behavior for errors/warnings?  (defparameter *interface-functions* '()
97      "The names of all interface functions.")
98    
99  (define-condition not-implemented-error (error)  (defparameter *unimplemented-interfaces* '()
100    ())    "List of interface functions that are not implemented.
101    DEFINTERFACE adds to this list and DEFIMPLEMENTATION removes.")
102    
103    (defmacro definterface (name args documentation &rest default-body)
104      "Define an interface function for the backend to implement.
105    A generic function is defined with NAME, ARGS, and DOCUMENTATION.
106    
107    If a DEFAULT-BODY is supplied then NO-APPLICABLE-METHOD is specialized
108    to execute the body if the backend doesn't provide a specific
109    implementation.
110    
111    Backends implement these functions using DEFIMPLEMENTATION."
112      (check-type documentation string "a documentation string")
113      (flet ((gen-default-impl ()
114               `(defmethod ,name ,args ,@default-body)))
115        `(progn (defgeneric ,name ,args (:documentation ,documentation))
116                (pushnew ',name *interface-functions*)
117                ,(if (null default-body)
118                     `(pushnew ',name *unimplemented-interfaces*)
119                     (gen-default-impl))
120                ;; see <http://www.franz.com/support/documentation/6.2/doc/pages/variables/compiler/s_cltl1-compile-file-toplevel-compatibility-p_s.htm>
121                (eval-when (:compile-toplevel :load-toplevel :execute)
122                  (export ',name :swank-backend))
123                ',name)))
124    
125    (defmacro defimplementation (name args &body body)
126      `(progn (defmethod ,name ,args ,@body)
127              (if (member ',name *interface-functions*)
128                  (setq *unimplemented-interfaces*
129                        (remove ',name *unimplemented-interfaces*))
130                  (warn "DEFIMPLEMENTATION of undefined interface (~S)" ',name))
131              ',name))
132    
133    (defun warn-unimplemented-interfaces ()
134      "Warn the user about unimplemented backend features.
135    The portable code calls this function at startup."
136      (warn "These Swank interfaces are unimplemented:~% ~A"
137            (sort (copy-list *unimplemented-interfaces*) #'string<)))
138    
139    (defun import-to-swank-mop (symbol-list)
140      (dolist (sym symbol-list)
141        (let* ((swank-mop-sym (find-symbol (symbol-name sym) :swank-mop)))
142          (when swank-mop-sym
143            (unintern swank-mop-sym :swank-mop))
144          (import sym :swank-mop)
145          (export sym :swank-mop))))
146    
147    (defun import-swank-mop-symbols (package except)
148      "Import the mop symbols from PACKAGE to SWANK-MOP.
149    EXCEPT is a list of symbol names which should be ignored."
150      (do-symbols (s :swank-mop)
151        (unless (member s except :test #'string=)
152          (let ((real-symbol (find-symbol (string s) package)))
153            (assert real-symbol () "Symbol ~A not found in package ~A" s package)
154            (unintern s :swank-mop)
155            (import real-symbol :swank-mop)
156            (export real-symbol :swank-mop)))))
157    
158    (defvar *gray-stream-symbols*
159      '(:fundamental-character-output-stream
160        :stream-write-char
161        :stream-fresh-line
162        :stream-force-output
163        :stream-finish-output
164        :fundamental-character-input-stream
165        :stream-read-char
166        :stream-listen
167        :stream-unread-char
168        :stream-clear-input
169        :stream-line-column
170        :stream-read-char-no-hang
171        ;; STREAM-LINE-LENGTH is an extension to gray streams that's apparently
172        ;; supported by CMUCL, OpenMCL, SBCL and SCL.
173        #+(or cmu openmcl sbcl scl)
174        :stream-line-length))
175    
176    (defun import-from (package symbol-names &optional (to-package *package*))
177      "Import the list of SYMBOL-NAMES found in the package PACKAGE."
178      (dolist (name symbol-names)
179        (multiple-value-bind (symbol found) (find-symbol (string name) package)
180          (assert found () "Symbol ~A not found in package ~A" name package)
181          (import symbol to-package))))
182    
183  (deftype severity () '(member :error :warning :style-warning :note))  
184    ;;;; Utilities
185    
186  ;; Base condition type for compiler errors, warnings and notes.  (defmacro with-struct ((conc-name &rest names) obj &body body)
187  (define-condition compiler-condition (condition)    "Like with-slots but works only for structs."
188    ((original-condition    (flet ((reader (slot) (intern (concatenate 'string
189      ;; The original condition thrown by the compiler if appropriate.                                               (symbol-name conc-name)
190      ;; May be NIL if a compiler does not report using conditions.                                               (symbol-name slot))
191      :initarg :original-condition                                  (symbol-package conc-name))))
192      :accessor original-condition)      (let ((tmp (gensym "OO-")))
193        ` (let ((,tmp ,obj))
194            (symbol-macrolet
195                ,(loop for name in names collect
196                       (typecase name
197                         (symbol `(,name (,(reader name) ,tmp)))
198                         (cons `(,(first name) (,(reader (second name)) ,tmp)))
199                         (t (error "Malformed syntax in WITH-STRUCT: ~A" name))))
200              ,@body)))))
201    
202    
203    ;;;; TCP server
204    
205    (definterface create-socket (host port)
206      "Create a listening TCP socket on interface HOST and port PORT .")
207    
208    (definterface local-port (socket)
209      "Return the local port number of SOCKET.")
210    
211    (definterface close-socket (socket)
212      "Close the socket SOCKET.")
213    
214    (definterface accept-connection (socket &key external-format
215                                            buffering)
216       "Accept a client connection on the listening socket SOCKET.
217    Return a stream for the new connection.")
218    
219    (definterface add-sigio-handler (socket fn)
220      "Call FN whenever SOCKET is readable.")
221    
222    (definterface remove-sigio-handlers (socket)
223      "Remove all sigio handlers for SOCKET.")
224    
225    (definterface add-fd-handler (socket fn)
226      "Call FN when Lisp is waiting for input and SOCKET is readable.")
227    
228    (definterface remove-fd-handlers (socket)
229      "Remove all fd-handlers for SOCKET.")
230    
231    (definterface preferred-communication-style ()
232      "Return one of the symbols :spawn, :sigio, :fd-handler, or NIL."
233      nil)
234    
235    ;;; Base condition for networking errors.
236    (define-condition network-error (simple-error) ())
237    
238    (definterface emacs-connected ()
239       "Hook called when the first connection from Emacs is established.
240    Called from the INIT-FN of the socket server that accepts the
241    connection.
242    
243    This is intended for setting up extra context, e.g. to discover
244    that the calling thread is the one that interacts with Emacs."
245       nil)
246    
247    
248    ;;;; Unix signals
249    
250    (defconstant +sigint+ 2)
251    
252    (definterface call-without-interrupts (fn)
253      "Call FN in a context where interrupts are disabled."
254      (funcall fn))
255    
256     (severity  (definterface getpid ()
257      :type severity    "Return the (Unix) process ID of this superior Lisp.")
258      :initarg :severity  
259      :accessor severity)  (definterface lisp-implementation-type-name ()
260      "Return a short name for the Lisp implementation."
261     (message    (lisp-implementation-type))
262      :initarg :message  
263      :accessor message)  (definterface default-directory ()
264      "Return the default directory."
265     (location    (directory-namestring (truename *default-pathname-defaults*)))
266      :initarg :location  
267      :accessor location)))  (definterface set-default-directory (directory)
268      "Set the default directory.
269    This is used to resolve filenames without directory component."
270      (setf *default-pathname-defaults* (truename (merge-pathnames directory)))
271      (default-directory))
272    
273    (definterface call-with-syntax-hooks (fn)
274      "Call FN with hooks to handle special syntax."
275      (funcall fn))
276    
277    (definterface default-readtable-alist ()
278      "Return a suitable initial value for SWANK:*READTABLE-ALIST*."
279      '())
280    
281    (definterface quit-lisp ()
282      "Exit the current lisp image.")
283    
284    
285  ;;;; Compilation  ;;;; Compilation
286    
287  (defgeneric call-with-compilation-hooks (func)  (definterface call-with-compilation-hooks (func)
288    (:documentation    "Call FUNC with hooks to record compiler conditions.")
289     "Call FUNC with hooks to trigger SLDB on compiler errors."))  
290  (defmacro with-compilation-hooks (() &body body)  (defmacro with-compilation-hooks ((&rest ignore) &body body)
291      "Execute BODY as in CALL-WITH-COMPILATION-HOOKS."
292      (declare (ignore ignore))
293    `(call-with-compilation-hooks (lambda () (progn ,@body))))    `(call-with-compilation-hooks (lambda () (progn ,@body))))
294    
295  (defgeneric compile-string-for-emacs (string &key buffer position)  (definterface swank-compile-string (string &key buffer position directory)
296    (:documentation    "Compile source from STRING.  During compilation, compiler
    "Compile source from STRING.  During compilation, compiler  
297  conditions must be trapped and resignalled as COMPILER-CONDITIONs.  conditions must be trapped and resignalled as COMPILER-CONDITIONs.
298    
299  If supplied, BUFFER and POSITION specify the source location in Emacs.  If supplied, BUFFER and POSITION specify the source location in Emacs.
300    
301  Additionally, if POSITION is supplied, it must be added to source  Additionally, if POSITION is supplied, it must be added to source
302  positions reported in compiler conditions."))  positions reported in compiler conditions.
303    
304  (defgeneric compile-file-for-emacs (filename load-p)  If DIRECTORY is specified it may be used by certain implementations to
305    (:documentation  rebind *DEFAULT-PATHNAME-DEFAULTS* which may improve the recording of
306    source information.")
307    
308    (definterface operate-on-system (system-name operation-name &rest keyword-args)
309      "Perform OPERATION-NAME on SYSTEM-NAME using ASDF.
310    The KEYWORD-ARGS are passed on to the operation.
311    Example:
312    \(operate-on-system \"SWANK\" \"COMPILE-OP\" :force t)"
313      (unless (member :asdf *features*)
314        (error "ASDF is not loaded."))
315      (with-compilation-hooks ()
316        (let ((operate (find-symbol "OPERATE" :asdf))
317              (operation (find-symbol operation-name :asdf)))
318          (when (null operation)
319            (error "Couldn't find ASDF operation ~S" operation-name))
320          (apply operate operation system-name keyword-args))))
321    
322    (definterface swank-compile-file (filename load-p &optional external-format)
323     "Compile FILENAME signalling COMPILE-CONDITIONs.     "Compile FILENAME signalling COMPILE-CONDITIONs.
324  If LOAD-P is true, load the file after compilation."))  If LOAD-P is true, load the file after compilation.")
325    
326    (deftype severity ()
327      '(member :error :read-error :warning :style-warning :note))
328    
329    ;; Base condition type for compiler errors, warnings and notes.
330    (define-condition compiler-condition (condition)
331      ((original-condition
332        ;; The original condition thrown by the compiler if appropriate.
333        ;; May be NIL if a compiler does not report using conditions.
334        :type (or null condition)
335        :initarg :original-condition
336        :accessor original-condition)
337    
338       (severity :type severity
339                 :initarg :severity
340                 :accessor severity)
341    
342       (message :initarg :message
343                :accessor message)
344    
345       (short-message :initarg :short-message
346                      :initform nil
347                      :accessor short-message)
348    
349       (references :initarg :references
350                   :initform nil
351                   :accessor references)
352    
353       (location :initarg :location
354                 :accessor location)))
355    
356    
357    ;;;; Streams
358    
359    (definterface make-fn-streams (input-fn output-fn)
360       "Return character input and output streams backended by functions.
361    When input is needed, INPUT-FN is called with no arguments to
362    return a string.
363    When output is ready, OUTPUT-FN is called with the output as its
364    argument.
365    
366    Output should be forced to OUTPUT-FN before calling INPUT-FN.
367    
368    The streams are returned as two values.")
369    
370    (definterface make-stream-interactive (stream)
371      "Do any necessary setup to make STREAM work interactively.
372    This is called for each stream used for interaction with the user
373    \(e.g. *standard-output*). An implementation could setup some
374    implementation-specific functions to control output flushing at the
375    like."
376      (declare (ignore stream))
377      nil)
378    
379    
380  ;;;; Documentation  ;;;; Documentation
381    
382  (defgeneric arglist-string (function-name)  (definterface arglist (name)
383    (:documentation     "Return the lambda list for the symbol NAME. NAME can also be
384     "Return the argument for FUNCTION-NAME as a string.  a lisp function object, on lisps which support this.
385  The result should begin and end with parenthesis."))  
386    The result can be a list or the :not-available if the arglist
387    cannot be determined."
388       (declare (ignore name))
389       :not-available)
390    
391  (defgeneric macroexpand-all (form)  (definterface function-name (function)
392    (:documentation    "Return the name of the function object FUNCTION.
393    
394    The result is either a symbol, a list, or NIL if no function name is available."
395      (declare (ignore function))
396      nil)
397    
398    (definterface macroexpand-all (form)
399     "Recursively expand all macros in FORM.     "Recursively expand all macros in FORM.
400  Return the resulting form."))  Return the resulting form.")
401    
402  (defgeneric describe-symbol-for-emacs (symbol)  (definterface compiler-macroexpand-1 (form &optional env)
403    (:documentation    "Call the compiler-macro for form.
404    If FORM is a function call for which a compiler-macro has been
405    defined, invoke the expander function using *macroexpand-hook* and
406    return the results and T.  Otherwise, return the original form and
407    NIL."
408      (let ((fun (and (consp form) (compiler-macro-function (car form)))))
409        (if fun
410            (let ((result (funcall *macroexpand-hook* fun form env)))
411              (values result (not (eq result form))))
412            (values form nil))))
413    
414    (definterface compiler-macroexpand (form &optional env)
415      "Repetitively call `compiler-macroexpand-1'."
416      (labels ((frob (form expanded)
417                 (multiple-value-bind (new-form newly-expanded)
418                     (compiler-macroexpand-1 form env)
419                   (if newly-expanded
420                       (frob new-form t)
421                       (values new-form expanded)))))
422        (frob form env)))
423    
424    (definterface describe-symbol-for-emacs (symbol)
425     "Return a property list describing SYMBOL.     "Return a property list describing SYMBOL.
426    
427  The property list has an entry for each interesting aspect of the  The property list has an entry for each interesting aspect of the
428  symbol. The recognised keys are:  symbol. The recognised keys are:
429    
430    :VARIABLE :FUNCTION :SETF :TYPE :CLASS :MACRO :COMPILER-MACRO    :VARIABLE :FUNCTION :SETF :SPECIAL-OPERATOR :MACRO :COMPILER-MACRO
431    :ALIEN-TYPE :ALIEN-STRUCT :ALIEN-UNION :ALIEN-ENUM    :TYPE :CLASS :ALIEN-TYPE :ALIEN-STRUCT :ALIEN-UNION :ALIEN-ENUM
432    
433  The value of each property is the corresponding documentation string,  The value of each property is the corresponding documentation string,
434  or :NOT-DOCUMENTED. It is legal to include keys not listed here.  or :NOT-DOCUMENTED. It is legal to include keys not listed here (but
435    slime-print-apropos in Emacs must know about them).
436    
437  Properties should be included if and only if they are applicable to  Properties should be included if and only if they are applicable to
438  the symbol. For example, only (and all) fbound symbols should include  the symbol. For example, only (and all) fbound symbols should include
# Line 184  Example: Line 442  Example:
442  \(describe-symbol-for-emacs 'vector)  \(describe-symbol-for-emacs 'vector)
443    => (:CLASS :NOT-DOCUMENTED    => (:CLASS :NOT-DOCUMENTED
444        :TYPE :NOT-DOCUMENTED        :TYPE :NOT-DOCUMENTED
445        :FUNCTION \"Constructs a simple-vector from the given objects.\")"))        :FUNCTION \"Constructs a simple-vector from the given objects.\")")
446    
447    (definterface describe-definition (name type)
448      "Describe the definition NAME of TYPE.
449    TYPE can be any value returned by DESCRIBE-SYMBOL-FOR-EMACS.
450    
451    Return a documentation string, or NIL if none is available.")
452    
453    
454  ;;;; Debugging  ;;;; Debugging
455    
456  (defgeneric call-with-debugging-environment (debugger-loop-fn)  (definterface install-debugger-globally (function)
457    (:documentation    "Install FUNCTION as the debugger for all threads/processes. This
458    usually involves setting *DEBUGGER-HOOK* and, if the implementation
459    permits, hooking into BREAK as well."
460      (setq *debugger-hook* function))
461    
462    (definterface call-with-debugging-environment (debugger-loop-fn)
463     "Call DEBUGGER-LOOP-FN in a suitable debugging environment.     "Call DEBUGGER-LOOP-FN in a suitable debugging environment.
464    
465  This function is called recursively at each debug level to invoke the  This function is called recursively at each debug level to invoke the
# Line 198  debugger loop. The purpose is to setup a Line 467  debugger loop. The purpose is to setup a
467  other debugger callbacks that will be called within the debugger loop.  other debugger callbacks that will be called within the debugger loop.
468    
469  For example, this is a reasonable place to compute a backtrace, switch  For example, this is a reasonable place to compute a backtrace, switch
470  to safe reader/printer settings, and so on."))  to safe reader/printer settings, and so on.")
471    
472    (definterface call-with-debugger-hook (hook fun)
473      "Call FUN and use HOOK as debugger hook.
474    
475    HOOK should be called for both BREAK and INVOKE-DEBUGGER."
476      (let ((*debugger-hook* hook))
477        (funcall fun)))
478    
479  (define-condition sldb-condition (condition)  (define-condition sldb-condition (condition)
480    ((original-condition    ((original-condition
481      :initarg :original-condition      :initarg :original-condition
482      :accessor original-condition))      :accessor original-condition))
483      (:report (lambda (condition stream)
484                 (format stream "Condition in debugger code~@[: ~A~]"
485                         (original-condition condition))))
486    (:documentation    (:documentation
487     "Wrapper for conditions that should not be debugged.     "Wrapper for conditions that should not be debugged.
488    
# Line 213  debug the debugger! Instead, such condit Line 492  debug the debugger! Instead, such condit
492  user without (re)entering the debugger by wrapping them as  user without (re)entering the debugger by wrapping them as
493  `sldb-condition's."))  `sldb-condition's."))
494    
495  (defgeneric debugger-info-for-emacs (start end)  (definterface compute-backtrace (start end)
   (:documentation  
    "Return debugger state, with stack frames from START to END.  
 The result is a list:  
   (condition-description ({restart}*) ({stack-frame}*)  
 where  
   restart     ::= (name description)  
   stack-frame ::= (number description)  
   
 condition-description---a string describing the condition that  
 triggered the debugger.  
   
 restart---a pair of strings: restart name, and description.  
   
 stack-frame---a number from zero (the top), and a printed  
 representation of the frame's call.  
   
 Below is an example return value. In this case the condition was a  
 division by zero (multi-line description), and only one frame is being  
 fetched (start=0, end=1).  
   
  (\"Arithmetic error DIVISION-BY-ZERO signalled.  
 Operation was KERNEL::DIVISION, operands (1 0).  
    [Condition of type DIVISION-BY-ZERO]\"  
   ((\"ABORT\" \"Return to Slime toplevel.\")  
    (\"ABORT\" \"Return to Top-Level.\"))  
   ((0 \"0: (KERNEL::INTEGER-/-INTEGER 1 0)\")))"))  
   
 (defgeneric backtrace (start end)  
   (:documentation  
496     "Return a list containing a backtrace of the condition current     "Return a list containing a backtrace of the condition current
497  being debugged.  The results are unspecified if this function is  being debugged.  The results are unspecified if this function is
498  called outside the dynamic contour of a debugger hook defined by  called outside the dynamic contour CALL-WITH-DEBUGGING-ENVIRONMENT.
 DEFINE-DEBUGGER-HOOK.  
499    
500  START and END are zero-based indices constraining the number of  START and END are zero-based indices constraining the number of frames
501  frames returned.  Frame zero is defined as the frame which invoked  returned.  Frame zero is defined as the frame which invoked the
502  the debugger.  debugger.  If END is nil, return the frames from START to the end of
503    the stack.")
 The backtrace is returned as a list of tuples of the form  
 \(FRAME-NUMBER FRAME-DESCRIPTION), where FRAME-NUMBER is the  
 index of the frame, defined like START/END, and FRAME-DESCRIPTION  
 is a string containing text to display in the debugger for this  
 frame.  
   
 An example return value:  
   
    ((0 \"(HELLO \"world\")\")  
     (1 \"(RUN-EXCITING-LISP-DEMO)\")  
     (2 \"(SYS::%TOPLEVEL #<SYS::ENVIRONMENT #x394834>)\"))"))  
504    
505  (defgeneric frame-source-location-for-emacs (frame-number)  (definterface print-frame (frame stream)
506    (:documentation    "Print frame to stream.")
   "Return the source location for FRAME-NUMBER."))  
507    
508  (defgeneric frame-catch-tags (frame-number)  (definterface frame-source-location-for-emacs (frame-number)
509    (:documentation    "Return the source location for FRAME-NUMBER.")
510    
511    (definterface frame-catch-tags (frame-number)
512    "Return a list of XXX list of what? catch tags for a debugger    "Return a list of XXX list of what? catch tags for a debugger
513  stack frame.  The results are undefined unless this is called  stack frame.  The results are undefined unless this is called
514  within the dynamic contour of a function defined by  within the dynamic contour of a function defined by
515  DEFINE-DEBUGGER-HOOK."))  DEFINE-DEBUGGER-HOOK.")
516    
517  (defgeneric frame-locals (frame-number)  (definterface frame-locals (frame-number)
518    (:documentation    "Return a list of XXX local variable designators define me
    "Return a list of XXX local variable designators define me  
519  for a debugger stack frame.  The results are undefined unless  for a debugger stack frame.  The results are undefined unless
520  this is called within the dynamic contour of a function defined  this is called within the dynamic contour of a function defined
521  by DEFINE-DEBUGGER-HOOK."))  by DEFINE-DEBUGGER-HOOK.")
522    
523  (defgeneric eval-in-frame (form frame-number)  (definterface frame-var-value (frame var)
524    (:documentation    "Return the value of VAR in FRAME.
525    FRAME is the number of the frame in the backtrace.
526    VAR is the number of the variable in the frame.")
527    
528    (definterface disassemble-frame (frame-number)
529      "Disassemble the code for the FRAME-NUMBER.
530    The output should be written to standard output.
531    FRAME-NUMBER is a non-negative integer.")
532    
533    (definterface eval-in-frame (form frame-number)
534     "Evaluate a Lisp form in the lexical context of a stack frame     "Evaluate a Lisp form in the lexical context of a stack frame
535  in the debugger.  The results are undefined unless called in the  in the debugger.  The results are undefined unless called in the
536  dynamic contour of a function defined by DEFINE-DEBUGGER-HOOK.  dynamic contour of a function defined by DEFINE-DEBUGGER-HOOK.
# Line 292  FRAME-NUMBER must be a positive integer Line 539  FRAME-NUMBER must be a positive integer
539  frame which invoked the debugger.  frame which invoked the debugger.
540    
541  The return value is the result of evaulating FORM in the  The return value is the result of evaulating FORM in the
542  appropriate context."))  appropriate context.")
543    
544    (definterface return-from-frame (frame-number form)
545      "Unwind the stack to the frame FRAME-NUMBER and return the value(s)
546    produced by evaluating FORM in the frame context to its caller.
547    
548    Execute any clean-up code from unwind-protect forms above the frame
549    during unwinding.
550    
551    Return a string describing the error if it's not possible to return
552    from the frame.")
553    
554    (definterface restart-frame (frame-number)
555      "Restart execution of the frame FRAME-NUMBER with the same arguments
556    as it was called originally.")
557    
558    (definterface format-sldb-condition (condition)
559      "Format a condition for display in SLDB."
560      (princ-to-string condition))
561    
562    (definterface condition-references (condition)
563      "Return a list of documentation references for a condition.
564    Each reference is one of:
565      (:ANSI-CL
566       {:FUNCTION | :SPECIAL-OPERATOR | :MACRO | :SECTION | :GLOSSARY }
567       symbol-or-name)
568      (:SBCL :NODE node-name)"
569      (declare (ignore condition))
570      '())
571    
572    (definterface condition-extras (condition)
573      "Return a list of extra for the debugger.
574    The allowed elements are of the form:
575      (:SHOW-FRAME-SOURCE frame-number)"
576      (declare (ignore condition))
577      '())
578    
579    (definterface activate-stepping (frame-number)
580      "Prepare the frame FRAME-NUMBER for stepping.")
581    
582    (definterface sldb-break-on-return (frame-number)
583      "Set a breakpoint in the frame FRAME-NUMBER.")
584    
585    (definterface sldb-break-at-start (symbol)
586      "Set a breakpoint on the beginning of the function for SYMBOL.")
587    
588    
589    
590  ;;;; Queries  ;;;; Definition finding
591    
592  #+(or)  (defstruct (:location (:type list) :named
593  ;;; This is probably a better interface than find-function-locations.                        (:constructor make-location
594  (defgeneric find-definitions (name)                                      (buffer position &optional hints)))
595    (:documentation    buffer position
596     "Return a list of (LABEL . LOCATION) pairs for NAME's definitions.    ;; Hints is a property list optionally containing:
597      ;;   :snippet SOURCE-TEXT
598      ;;     This is a snippet of the actual source text at the start of
599      ;;     the definition, which could be used in a text search.
600      hints)
601    
602    (defstruct (:error (:type list) :named (:constructor)) message)
603    (defstruct (:file (:type list) :named (:constructor)) name)
604    (defstruct (:buffer (:type list) :named (:constructor)) name)
605    (defstruct (:position (:type list) :named (:constructor)) pos)
606    
607    (definterface find-definitions (name)
608       "Return a list ((DSPEC LOCATION) ...) for NAME's definitions.
609    
610    NAME is a \"definition specifier\".
611    
612    DSPEC is a \"definition specifier\" describing the
613    definition, e.g., FOO or (METHOD FOO (STRING NUMBER)) or
614    \(DEFVAR FOO).
615    
616    LOCATION is the source location for the definition.")
617    
618    (definterface buffer-first-change (filename)
619      "Called for effect the first time FILENAME's buffer is modified."
620      (declare (ignore filename))
621      nil)
622    
623  NAME is string denoting a symbol or \"definition specifier\".  
624    ;;;; XREF
625    
626  LABEL is a string describing the definition, e.g., \"foo\" or  (definterface who-calls (function-name)
627  \"(method foo (string number))\" or \"(variable bar)\".    "Return the call sites of FUNCTION-NAME (a symbol).
628    The results is a list ((DSPEC LOCATION) ...).")
629    
630    (definterface calls-who (function-name)
631      "Return the call sites of FUNCTION-NAME (a symbol).
632    The results is a list ((DSPEC LOCATION) ...).")
633    
634    (definterface who-references (variable-name)
635      "Return the locations where VARIABLE-NAME (a symbol) is referenced.
636    See WHO-CALLS for a description of the return value.")
637    
638    (definterface who-binds (variable-name)
639      "Return the locations where VARIABLE-NAME (a symbol) is bound.
640    See WHO-CALLS for a description of the return value.")
641    
642    (definterface who-sets (variable-name)
643      "Return the locations where VARIABLE-NAME (a symbol) is set.
644    See WHO-CALLS for a description of the return value.")
645    
646    (definterface who-macroexpands (macro-name)
647      "Return the locations where MACRO-NAME (a symbol) is expanded.
648    See WHO-CALLS for a description of the return value.")
649    
650    (definterface who-specializes (class-name)
651      "Return the locations where CLASS-NAME (a symbol) is specialized.
652    See WHO-CALLS for a description of the return value.")
653    
654    ;;; Simpler variants.
655    
656    (definterface list-callers (function-name)
657      "List the callers of FUNCTION-NAME.
658    This function is like WHO-CALLS except that it is expected to use
659    lower-level means. Whereas WHO-CALLS is usually implemented with
660    special compiler support, LIST-CALLERS is usually implemented by
661    groveling for constants in function objects throughout the heap.
662    
663    The return value is as for WHO-CALLS.")
664    
665    (definterface list-callees (function-name)
666      "List the functions called by FUNCTION-NAME.
667    See LIST-CALLERS for a description of the return value.")
668    
669  LOCATION is a source location of the form:  
670    ;;;; Profiling
671    
672  <location> ::= (:location <buffer> <position>)  ;;; The following functions define a minimal profiling interface.
              | (:error <message>)  
673    
674  <buffer>   ::= (:file <filename>)  (definterface profile (fname)
675               | (:buffer <buffername>)    "Marks symbol FNAME for profiling.")
              | (:source-form <string>)  
676    
677  <position> ::= (:position <fixnum> [<align>]) ; 1 based  (definterface profiled-functions ()
678               | (:function-name <string>)    "Returns a list of profiled functions.")
 "))  
679    
680  (defgeneric find-function-locations (name)  (definterface unprofile (fname)
681    (:documentation    "Marks symbol FNAME as not profiled.")
    "Return a list (LOCATION LOCATION ...) for NAME's definitions.  
682    
683  LOCATION is a source location of the form:  (definterface unprofile-all ()
684      "Marks all currently profiled functions as not profiled."
685      (dolist (f (profiled-functions))
686        (unprofile f)))
687    
688  <location> ::= (:location <buffer> <position>)  (definterface profile-report ()
689               | (:error <message>)    "Prints profile report.")
690    
691  <buffer>   ::= (:file <filename>)  (definterface profile-reset ()
692               | (:buffer <buffername>)    "Resets profile counters.")
              | (:source-form <string>)  
693    
694  <position> ::= (:position <fixnum> [<align>]) ; 1 based  (definterface profile-package (package callers-p methods)
695               | (:function-name <string>)"))    "Wrap profiling code around all functions in PACKAGE.  If a function
696    is already profiled, then unprofile and reprofile (useful to notice
697    function redefinition.)
698    
699    If CALLERS-P is T names have counts of the most common calling
700    functions recorded.
701    
702    When called with arguments :METHODS T, profile all methods of all
703    generic functions having names in the given package.  Generic functions
704    themselves, that is, their dispatch functions, are left alone.")
705    
706    
707  ;;;; Multiprocessing  ;;;; Inspector
708    
709  (defgeneric startup-multiprocessing ()  (defclass inspector ()
710    (:documentation    ()
711     "Initialize multiprocessing, if necessary.    (:documentation "Super class of inspector objects.
712    
713  This function is called directly through the listener, not in an RPC  Implementations should sub class in order to dispatch off of the
714  from Emacs. This is to support interfaces such as CMUCL's  inspect-for-emacs method."))
 MP::STARTUP-IDLE-AND-TOP-LEVEL-LOOPS which does not return like a  
 normal function."))  
715    
716  (defgeneric thread-id ()  (definterface make-default-inspector ()
717    (:documentation    "Return an inspector object suitable for passing to inspect-for-emacs.")
    "Return a value that uniquely identifies the current thread.  
 Thread-IDs allow Emacs to refer to individual threads.  
718    
719  When called several times by the same thread, all return values are  (definterface inspect-for-emacs (object inspector)
720  EQUAL. The value has a READable printed representation that preserves     "Explain to Emacs how to inspect OBJECT.
 equality. The printed representation must be identical in Emacs Lisp  
 and Common Lisp, and short enough to include in the REPL prompt.  
721    
722  For example, a THREAD-ID could be an integer or a short ASCII string.  The argument INSPECTOR is an object representing how to get at
723    the internals of OBJECT, it is usually an implementation specific
724    class used simply for dispatching to the proper method.
725    
726  Systems that do not support multiprocessing return NIL."))  The orgument INSPECTION-MODE is an object specifying how, and
727    what, to show to the user.
728    
729  (defgeneric thread-name (thread-id)  Returns two values: a string which will be used as the title of
730    (:documentation  the inspector buffer and a list specifying how to render the
731     "Return the name of the thread identified by THREAD-ID.  object for inspection.
732    
733  Thread names are be single-line strings and are meaningful to the  Every element of the list must be either a string, which will be
734  user. They do not have to be unique."))  inserted into the buffer as is, or a list of the form:
735    
736  (defgeneric call-with-I/O-lock (function)   (:value object &optional format) - Render an inspectable
737    (:documentation   object. If format is provided it must be a string and will be
738     "Call FUNCTION with the \"I/O\" lock held.   rendered in place of the value, otherwise use princ-to-string.
 Only one thread can hold the I/O lock at a time -- others are blocked  
 until they acquire it. When called recursively (i.e. lock already  
 held), simply calls FUNCTION.  
739    
740  This is a low-level lock used for mutual exclusion on individual   (:newline) - Render a \\n
 messages read and written to the socket connecting Emacs.  
741    
742  Systems that do not support multiprocessing simply call FUNCTION."))   (:action label lambda) - Render LABEL (a text string) which when
743     clicked will call LAMBDA.
744    
745  (defgeneric call-with-conversation-lock (function)   NIL - do nothing.")
   (:documentation  
    "Call FUNCTION with the \"conversation\" lock held.  
 The semantics are analogous to CALL-WITH-I/O-HOOK.  
746    
747  This is a high-level lock used for mutual exclusion in conversations  (defmethod inspect-for-emacs ((object t) (inspector t))
748  with Emacs that can span multiple messages. The I/O lock must    "Generic method for inspecting any kind of object.
 separately be held when reading and writing individual messages."))  
749    
750  ;;; Functions for attracting the Emacs user's attention.  Since we don't know how to deal with OBJECT we simply dump the
751    output of CL:DESCRIBE."
752      (declare (ignore inspector))
753      (values
754       "A value."
755       `("Type: " (:value ,(type-of object)) (:newline)
756         "Don't know how to inspect the object, dumping output of CL:DESCRIBE:"
757         (:newline) (:newline)
758         ,(with-output-to-string (desc) (describe object desc)))))
759    
760  (defgeneric wait-goahead ()  ;;; Utilities for inspector methods.
761    (:documentation  ;;;
762     "Block until told to continue by `give-gohead'.  (defun label-value-line (label value)
763      "Create a control list which prints \"LABEL: VALUE\" in the inspector."
764      (list (princ-to-string label) ": " `(:value ,value) '(:newline)))
765    
766  Systems that do not support multiprocessing return immediately."))  (defmacro label-value-line* (&rest label-values)
767      ` (append ,@(loop for (label value) in label-values
768                        collect `(label-value-line ,label ,value))))
769    
770  (defgeneric give-goahead (thread-id)  (definterface describe-primitive-type (object)
771    (:documentation    "Return a string describing the primitive type of object."
772     "Permit THREAD-ID to continue from WAIT-GOAHEAD.    (declare (ignore object))
773  It is an error to call (GIVE-GOAHEAD ID) unless ID is blocking in    "N/A")
 WAIT-GOAHEAD.  
774    
775  Systems that do not support multiprocessing always signal an error."))  
776    ;;;; Multithreading
777    ;;;
778    ;;; The default implementations are sufficient for non-multiprocessing
779    ;;; implementations.
780    
781  ;;;;; Default implementation for non-MP systems  (definterface initialize-multiprocessing ()
782       "Initialize multiprocessing, if necessary."
783       nil)
784    
785  ;;; Using NO-APPLICABLE-METHOD to supply a default implementation that  (definterface startup-idle-and-top-level-loops ()
786  ;;; works in systems that don't have multiprocessing.    "This function is called directly through the listener, not in an RPC
787  ;;; (Good or bad idea? -luke)  from Emacs. This is to support interfaces such as CMUCL's
788    MP::STARTUP-IDLE-AND-TOP-LEVEL-LOOPS which does not return like a
789    normal function."
790       nil)
791    
792  (defvar _ nil                           ; Good or bad idea? -luke  (definterface spawn (fn &key name)
793    "Null variable -- can be used for ignored arguments.    "Create a new thread to call FN.")
 Declared special, so no IGNORE declarations are necessary.")  
794    
795  (defmethod no-applicable-method ((m (eql #'startup-multiprocessing)) &rest _)  (definterface thread-id (thread)
796    nil)    "Return an Emacs-parsable object to identify THREAD.
797  (defmethod no-applicable-method ((m (eql #'thread-id)) &rest _)  
798    Ids should be comparable with equal, i.e.:
799     (equal (thread-id <t1>) (thread-id <t2>)) <==> (eq <t1> <t2>)")
800    
801    (definterface find-thread (id)
802      "Return the thread for ID.
803    ID should be an id previously obtained with THREAD-ID.
804    Can return nil if the thread no longer exists.")
805    
806    (definterface thread-name (thread)
807       "Return the name of THREAD.
808    
809    Thread names are be single-line strings and are meaningful to the
810    user. They do not have to be unique."
811       (declare (ignore thread))
812       "The One True Thread")
813    
814    (definterface thread-status (thread)
815       "Return a string describing THREAD's state."
816       (declare (ignore thread))
817       "")
818    
819    (definterface make-lock (&key name)
820       "Make a lock for thread synchronization.
821    Only one thread may hold the lock (via CALL-WITH-LOCK-HELD) at a time."
822       (declare (ignore name))
823       :null-lock)
824    
825    (definterface call-with-lock-held (lock function)
826       "Call FUNCTION with LOCK held, queueing if necessary."
827       (declare (ignore lock)
828                (type function function))
829       (funcall function))
830    
831    (definterface current-thread ()
832      "Return the currently executing thread."
833      0)
834    
835    (definterface all-threads ()
836      "Return a list of all threads.")
837    
838    (definterface thread-alive-p (thread)
839      "Test if THREAD is termintated."
840      (member thread (all-threads)))
841    
842    (definterface interrupt-thread (thread fn)
843      "Cause THREAD to execute FN.")
844    
845    (definterface kill-thread (thread)
846      "Kill THREAD."
847      (declare (ignore thread))
848    nil)    nil)
 (defmethod no-applicable-method ((m (eql #'thread-name)) &rest _)  
   "The One True Thread")  
 (defmethod no-applicable-method ((m (eql #'call-with-I/O-lock))  
                                  &rest args)  
   (funcall (first args)))  
 (defmethod no-applicable-method ((m (eql #'call-with-conversation-lock))  
                                  &rest args)  
   (funcall (first args)))  
 (defmethod no-applicable-method ((m (eql #'wait-goahead)) &rest _)  
   t)  
 (defmethod no-applicable-method ((m (eql #'give-goahead)) &rest _)  
   (error "SLIME multiprocessing not available"))  
849    
850    (definterface send (thread object)
851      "Send OBJECT to thread THREAD.")
852    
853    (definterface receive ()
854      "Return the next message from current thread's mailbox.")
855    
856    (definterface toggle-trace (spec)
857      "Toggle tracing of the function(s) given with SPEC.
858    SPEC can be:
859     (setf NAME)                            ; a setf function
860     (:defmethod NAME QUALIFIER... (SPECIALIZER...)) ; a specific method
861     (:defgeneric NAME)                     ; a generic function with all methods
862     (:call CALLER CALLEE)                  ; trace calls from CALLER to CALLEE.
863     (:labels TOPLEVEL LOCAL)
864     (:flet TOPLEVEL LOCAL) ")
865    
866    
867    ;;;; Weak datastructures
868    
869    (definterface make-weak-key-hash-table (&rest args)
870      "Like MAKE-HASH-TABLE, but weak w.r.t. the keys."
871      (apply #'make-hash-table args))
872    
873    (definterface make-weak-value-hash-table (&rest args)
874      "Like MAKE-HASH-TABLE, but weak w.r.t. the values."
875      (apply #'make-hash-table args))

Legend:
Removed from v.1.9  
changed lines
  Added in v.1.94

  ViewVC Help
Powered by ViewVC 1.1.5