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

Contents of /slime/swank-backend.lisp

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.5