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

Contents of /slime/swank-backend.lisp

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.5