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

Contents of /slime/swank-backend.lisp

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.5