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

Contents of /slime/swank-backend.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.80 - (hide annotations)
Thu Feb 24 18:09:33 2005 UTC (9 years, 1 month ago) by heller
Branch: MAIN
Changes since 1.79: +13 -3 lines
(call-with-debugger-hook): New function. Useful if the backend needs
special incantations for BREAK.

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

  ViewVC Help
Powered by ViewVC 1.1.5