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

Contents of /slime/swank-backend.lisp

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.5