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

Contents of /slime/swank-backend.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.40 - (show annotations)
Mon Mar 22 13:57:11 2004 UTC (10 years ago) by lgorrie
Branch: MAIN
Changes since 1.39: +0 -1 lines
*** empty log message ***
1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil; outline-regexp: ";;;;;*" -*-
2 ;;;
3 ;;; slime-backend.lisp --- SLIME backend interface.
4 ;;;
5 ;;; Created by James Bielman in 2003. Released into the public domain.
6 ;;;
7 ;;; 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
11 (defpackage :swank-backend
12 (:use :common-lisp)
13 (: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 ))
28
29 (in-package :swank-backend)
30
31
32 ;;;; Metacode
33
34 (defparameter *interface-functions* '()
35 "The names of all interface functions.")
36
37 (defparameter *unimplemented-interfaces* '()
38 "List of interface functions that are not implemented.
39 DEFINTERFACE adds to this list and DEFIMPLEMENTATION removes.")
40
41 (defmacro definterface (name args documentation &body default-body)
42 "Define an interface function for the backend to implement.
43 A generic function is defined with NAME, ARGS, and DOCUMENTATION.
44
45 If a DEFAULT-BODY is supplied then NO-APPLICABLE-METHOD is specialized
46 to execute the body if the backend doesn't provide a specific
47 implementation.
48
49 Backends implement these functions using DEFIMPLEMENTATION."
50 (flet ((gen-default-impl ()
51 (let ((received-args (gensym "ARGS-")))
52 `(defmethod no-applicable-method ((#:method
53 (eql (function ,name)))
54 &rest ,received-args)
55 (destructuring-bind ,args ,received-args
56 ,@default-body)))))
57 ` (progn (defgeneric ,name ,args (:documentation ,documentation))
58 (pushnew ',name *interface-functions*)
59 ,(if (null default-body)
60 `(pushnew ',name *unimplemented-interfaces*)
61 (gen-default-impl))
62 (export ',name :swank-backend)
63 ',name)))
64
65 (defmacro defimplementation (name args &body body)
66 `(progn (defmethod ,name ,args ,@body)
67 (if (member ',name *interface-functions*)
68 (setq *unimplemented-interfaces*
69 (remove ',name *unimplemented-interfaces*))
70 (warn "DEFIMPLEMENTATION of undefined interface (~S)" ',name))
71 ',name))
72
73 (defun warn-unimplemented-interfaces ()
74 "Warn the user about unimplemented backend features.
75 The portable code calls this function at startup."
76 (warn "These Swank interfaces are unimplemented:~% ~A"
77 (sort (copy-list *unimplemented-interfaces*) #'string<)))
78
79
80 ;;;; TCP server
81
82 (definterface create-socket (host port)
83 "Create a listening TCP socket on interface HOST and port PORT .")
84
85 (definterface local-port (socket)
86 "Return the local port number of SOCKET.")
87
88 (definterface close-socket (socket)
89 "Close the socket SOCKET.")
90
91 (definterface accept-connection (socket)
92 "Accept a client connection on the listening socket SOCKET. Return
93 a stream for the new connection.")
94
95 (definterface add-sigio-handler (socket fn)
96 "Call FN whenever SOCKET is readable.")
97
98 (definterface remove-sigio-handlers (socket)
99 "Remove all sigio handlers for SOCKET.")
100
101 (definterface add-fd-handler (socket fn)
102 "Call FN when Lisp is waiting for input and SOCKET is readable.")
103
104 (definterface remove-fd-handlers (socket)
105 "Remove all fd-handlers for SOCKET.")
106
107 (definterface preferred-communication-style ()
108 "Return one of the symbols :spawn, :sigio, :fd-handler, or NIL."
109 nil)
110
111 ;;; Base condition for networking errors.
112 (define-condition network-error (error) ())
113
114 (definterface emacs-connected ()
115 "Hook called when the first connection from Emacs is established.
116 Called from the INIT-FN of the socket server that accepts the
117 connection.
118
119 This is intended for setting up extra context, e.g. to discover
120 that the calling thread is the one that interacts with Emacs."
121 nil)
122
123
124 ;;;; Unix signals
125
126 (defconstant +sigint+ 2)
127
128 (definterface call-without-interrupts (fn)
129 "Call FN in a context where interrupts are disabled."
130 (funcall fn))
131
132 (definterface getpid ()
133 "Return the (Unix) process ID of this superior Lisp.")
134
135 (definterface lisp-implementation-type-name ()
136 "Return a short name for the Lisp implementation."
137 (lisp-implementation-type))
138
139 (definterface set-default-directory (directory)
140 "Set the default directory.
141 This is used to resolve filenames without directory component."
142 (setf *default-pathname-defaults* (truename (merge-pathnames directory)))
143 (namestring *default-pathname-defaults*))
144
145
146 ;;;; Compilation
147
148 (definterface call-with-compilation-hooks (func)
149 "Call FUNC with hooks to trigger SLDB on compiler errors.")
150
151 (defmacro with-compilation-hooks ((&rest ignore) &body body)
152 (declare (ignore ignore))
153 `(call-with-compilation-hooks (lambda () (progn ,@body))))
154
155 (definterface swank-compile-string (string &key buffer position)
156 "Compile source from STRING. During compilation, compiler
157 conditions must be trapped and resignalled as COMPILER-CONDITIONs.
158
159 If supplied, BUFFER and POSITION specify the source location in Emacs.
160
161 Additionally, if POSITION is supplied, it must be added to source
162 positions reported in compiler conditions.")
163
164 (definterface swank-compile-system (system-name)
165 "Compile and load SYSTEM-NAME, During compilation compiler
166 conditions must be trapped and resignalled as
167 COMPILER-CONDITION ala compile-string-for-emacs."
168 (with-compilation-hooks ()
169 (cond ((member :asdf *features*)
170 (let ((operate (find-symbol (string :operate) :asdf))
171 (load-op (find-symbol (string :load-op) :asdf)))
172 (funcall operate load-op system-name)))
173 (t (error "ASDF not loaded")))))
174
175 (definterface swank-compile-file (filename load-p)
176 "Compile FILENAME signalling COMPILE-CONDITIONs.
177 If LOAD-P is true, load the file after compilation.")
178
179 (deftype severity () '(member :error :warning :style-warning :note))
180
181 ;; Base condition type for compiler errors, warnings and notes.
182 (define-condition compiler-condition (condition)
183 ((original-condition
184 ;; The original condition thrown by the compiler if appropriate.
185 ;; May be NIL if a compiler does not report using conditions.
186 :type (or null condition)
187 :initarg :original-condition
188 :accessor original-condition)
189
190 (severity :type severity
191 :initarg :severity
192 :accessor severity)
193
194 (message :initarg :message
195 :accessor message)
196
197 (short-message :initarg :short-message
198 :initform nil
199 :accessor short-message)
200
201 (location :initarg :location
202 :accessor location)))
203
204
205
206
207 ;;;; Streams
208
209 (definterface make-fn-streams (input-fn output-fn)
210 "Return character input and output streams backended by functions.
211 When input is needed, INPUT-FN is called with no arguments to
212 return a string.
213 When output is ready, OUTPUT-FN is called with the output as its
214 argument.
215
216 Output should be forced to OUTPUT-FN before calling INPUT-FN.
217
218 The streams are returned as two values.")
219
220
221 ;;;; Documentation
222
223 (definterface arglist (name)
224 "Return the lambda list for the symbol NAME.
225
226 The result can be a list or a string.
227
228 An error should be signaled if the lambda-list cannot be found.")
229
230 (definterface macroexpand-all (form)
231 "Recursively expand all macros in FORM.
232 Return the resulting form.")
233
234 (definterface describe-symbol-for-emacs (symbol)
235 "Return a property list describing SYMBOL.
236
237 The property list has an entry for each interesting aspect of the
238 symbol. The recognised keys are:
239
240 :VARIABLE :FUNCTION :SETF :TYPE :CLASS :MACRO :COMPILER-MACRO
241 :ALIEN-TYPE :ALIEN-STRUCT :ALIEN-UNION :ALIEN-ENUM
242
243 The value of each property is the corresponding documentation string,
244 or :NOT-DOCUMENTED. It is legal to include keys not listed here.
245
246 Properties should be included if and only if they are applicable to
247 the symbol. For example, only (and all) fbound symbols should include
248 the :FUNCTION property.
249
250 Example:
251 \(describe-symbol-for-emacs 'vector)
252 => (:CLASS :NOT-DOCUMENTED
253 :TYPE :NOT-DOCUMENTED
254 :FUNCTION \"Constructs a simple-vector from the given objects.\")")
255
256 (definterface describe-definition (name type)
257 "Describe the definition NAME of TYPE.
258 TYPE can be any value returned by DESCRIBE-SYMBOL-FOR-EMACS.
259
260 Return a documentation string, or NIL if none is available.")
261
262
263 ;;;; Debugging
264
265 (definterface call-with-debugging-environment (debugger-loop-fn)
266 "Call DEBUGGER-LOOP-FN in a suitable debugging environment.
267
268 This function is called recursively at each debug level to invoke the
269 debugger loop. The purpose is to setup any necessary environment for
270 other debugger callbacks that will be called within the debugger loop.
271
272 For example, this is a reasonable place to compute a backtrace, switch
273 to safe reader/printer settings, and so on.")
274
275 (define-condition sldb-condition (condition)
276 ((original-condition
277 :initarg :original-condition
278 :accessor original-condition))
279 (:documentation
280 "Wrapper for conditions that should not be debugged.
281
282 When a condition arises from the internals of the debugger, it is not
283 desirable to debug it -- we'd risk entering an endless loop trying to
284 debug the debugger! Instead, such conditions can be reported to the
285 user without (re)entering the debugger by wrapping them as
286 `sldb-condition's."))
287
288 (definterface compute-backtrace (start end)
289 "Return a list containing a backtrace of the condition current
290 being debugged. The results are unspecified if this function is
291 called outside the dynamic contour CALL-WITH-DEBUGGING-ENVIRONMENT.
292
293 START and END are zero-based indices constraining the number of frames
294 returned. Frame zero is defined as the frame which invoked the
295 debugger. If END is nil, return the frames from START to the end of
296 the stack.")
297
298 (definterface print-frame (frame stream)
299 "Print frame to stream.")
300
301 (definterface frame-source-location-for-emacs (frame-number)
302 "Return the source location for FRAME-NUMBER.")
303
304 (definterface frame-catch-tags (frame-number)
305 "Return a list of XXX list of what? catch tags for a debugger
306 stack frame. The results are undefined unless this is called
307 within the dynamic contour of a function defined by
308 DEFINE-DEBUGGER-HOOK.")
309
310 (definterface frame-locals (frame-number)
311 "Return a list of XXX local variable designators define me
312 for a debugger stack frame. The results are undefined unless
313 this is called within the dynamic contour of a function defined
314 by DEFINE-DEBUGGER-HOOK.")
315
316 (definterface disassemble-frame (frame-number)
317 "Disassemble the code for the FRAME-NUMBER.
318 The output should be written to standard output.
319 FRAME-NUMBER is a non-negative interger.")
320
321 (definterface eval-in-frame (form frame-number)
322 "Evaluate a Lisp form in the lexical context of a stack frame
323 in the debugger. The results are undefined unless called in the
324 dynamic contour of a function defined by DEFINE-DEBUGGER-HOOK.
325
326 FRAME-NUMBER must be a positive integer with 0 indicating the
327 frame which invoked the debugger.
328
329 The return value is the result of evaulating FORM in the
330 appropriate context.")
331
332 (definterface return-from-frame (frame-number form)
333 "Unwind the stack to the frame FRAME-NUMBER and return the value(s)
334 produced by evaluating FORM in the frame context to its caller.
335
336 Execute any clean-up code from unwind-protect forms above the frame
337 during unwinding.
338
339 Return a string describing the error if it's not possible to return
340 from the frame.")
341
342 (definterface restart-frame (frame-number)
343 "Restart execution of the frame FRAME-NUMBER with the same arguments
344 as it was called originally.")
345
346
347 ;;;; Definition finding
348
349 (defstruct (:location (:type list) :named
350 (:constructor make-location (buffer position)))
351 buffer position)
352
353 (defstruct (:error (:type list) :named (:constructor)) message)
354 (defstruct (:file (:type list) :named (:constructor)) name)
355 (defstruct (:buffer (:type list) :named (:constructor)) name)
356 (defstruct (:position (:type list) :named (:constructor)) pos)
357
358 (definterface find-definitions (name)
359 "Return a list ((DSPEC LOCATION) ...) for NAME's definitions.
360
361 NAME is a \"definition specifier\".
362
363 DSPEC is a \"definition specifier\" describing the
364 definition, e.g., FOO or (METHOD FOO (STRING NUMBER)) or
365 \(DEFVAR FOO).
366
367 LOCATION is the source location for the definition.")
368
369
370 ;;;; XREF
371
372 (definterface who-calls (function-name)
373 "Return the call sites of FUNCTION-NAME (a symbol).
374 The results is a list ((DSPEC LOCATION) ...).")
375
376 (definterface who-references (variable-name)
377 "Return the locations where VARIABLE-NAME (a symbol) is referenced.
378 See WHO-CALLS for a description of the return value.")
379
380 (definterface who-binds (variable-name)
381 "Return the locations where VARIABLE-NAME (a symbol) is bound.
382 See WHO-CALLS for a description of the return value.")
383
384 (definterface who-sets (variable-name)
385 "Return the locations where VARIABLE-NAME (a symbol) is set.
386 See WHO-CALLS for a description of the return value.")
387
388 (definterface who-macroexpands (macro-name)
389 "Return the locations where MACRO-NAME (a symbol) is expanded.
390 See WHO-CALLS for a description of the return value.")
391
392 (definterface who-specializes (class-name)
393 "Return the locations where CLASS-NAME (a symbol) is specialized.
394 See WHO-CALLS for a description of the return value.")
395
396 ;;; Simpler variants.
397
398 (definterface list-callers (function-name)
399 "List the callers of FUNCTION-NAME.
400 This function is like WHO-CALLS except that it is expected to use
401 lower-level means. Whereas WHO-CALLS is usually implemented with
402 special compiler support, LIST-CALLERS is usually implemented by
403 groveling for constants in function objects throughout the heap.
404
405 The return value is as for WHO-CALLS.")
406
407 (definterface list-callees (function-name)
408 "List the functions called by FUNCTION-NAME.
409 See LIST-CALLERS for a description of the return value.")
410
411
412 ;;;; Profiling
413
414 ;;; The following functions define a minimal profiling interface.
415
416 (definterface profile (fname)
417 "Marks symbol FNAME for profiling.")
418
419 (definterface profiled-functions ()
420 "Returns a list of profiled functions.")
421
422 (definterface unprofile (fname)
423 "Marks symbol FNAME as not profiled.")
424
425 (definterface unprofile-all ()
426 "Marks all currently profiled functions as not profiled."
427 (dolist (f (profiled-functions))
428 (unprofile f)))
429
430 (definterface profile-report ()
431 "Prints profile report.")
432
433 (definterface profile-reset ()
434 "Resets profile counters.")
435
436 (definterface profile-package (package callers-p methods)
437 "Wrap profiling code around all functions in PACKAGE. If a function
438 is already profiled, then unprofile and reprofile (useful to notice
439 function redefinition.)
440
441 If CALLERS-P is T names have counts of the most common calling
442 functions recorded.
443
444 When called with arguments :METHODS T, profile all methods of all
445 generic functions having names in the given package. Generic functions
446 themselves, that is, their dispatch functions, are left alone.")
447
448
449 ;;;; Inspector
450
451 (definterface inspected-parts (object)
452 "Return a short description and a list of (LABEL . VALUE) pairs."
453 (values (format nil "~S is an atom." object) '()))
454
455 (definterface describe-primitive-type (object)
456 "Return a string describing the primitive type of object."
457 (declare (ignore object))
458 "N/A")
459
460
461 ;;;; Multithreading
462 ;;;
463 ;;; The default implementations are sufficient for non-multiprocessing
464 ;;; implementations.
465
466 (definterface startup-multiprocessing ()
467 "Initialize multiprocessing, if necessary.
468
469 This function is called directly through the listener, not in an RPC
470 from Emacs. This is to support interfaces such as CMUCL's
471 MP::STARTUP-IDLE-AND-TOP-LEVEL-LOOPS which does not return like a
472 normal function."
473 nil)
474
475 (definterface spawn (fn &key name)
476 "Create a new thread to call FN.")
477
478 (definterface thread-name (thread)
479 "Return the name of THREAD.
480
481 Thread names are be single-line strings and are meaningful to the
482 user. They do not have to be unique."
483 (declare (ignore thread))
484 "The One True Thread")
485
486 (definterface thread-status (thread)
487 "Return a string describing THREAD's state."
488 (declare (ignore thread))
489 "")
490
491 (definterface make-lock (&key name)
492 "Make a lock for thread synchronization.
493 Only one thread may hold the lock (via CALL-WITH-LOCK-HELD) at a time."
494 (declare (ignore name))
495 :null-lock)
496
497 (definterface call-with-lock-held (lock function)
498 "Call FUNCTION with LOCK held, queueing if necessary."
499 (declare (ignore lock)
500 (type function function))
501 (funcall function))
502
503 (definterface current-thread ()
504 "Return the currently executing thread."
505 0)
506
507 (definterface all-threads ()
508 "Return a list of all threads.")
509
510 (definterface thread-alive-p (thread)
511 "Test if THREAD is termintated."
512 (member thread (all-threads)))
513
514 (definterface interrupt-thread (thread fn)
515 "Cause THREAD to execute FN.")
516
517 (definterface kill-thread (thread)
518 "Kill THREAD."
519 (declare (ignore thread))
520 nil)
521
522 (definterface send (thread object)
523 "Send OBJECT to thread THREAD.")
524
525 (definterface receive ()
526 "Return the next message from current thread's mailbox.")

  ViewVC Help
Powered by ViewVC 1.1.5