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

Contents of /slime/swank-backend.lisp

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.5