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

Contents of /slime/swank-backend.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.145 - (show annotations)
Tue Aug 12 17:54:43 2008 UTC (5 years, 8 months ago) by heller
Branch: MAIN
Changes since 1.144: +9 -0 lines
Add a dump-image function to the loader.

* swank-loader.lisp (dump-image): New.

* swank-backend.lisp (save-image): New interface.

* swank-cmucl.lisp, swank-clisp.lisp, swank-sbcl.lisp
(save-image): Implemented.
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 ;;;; Frontmatter
8 ;;;
9 ;;; This file defines the functions that must be implemented
10 ;;; separately for each Lisp. Each is declared as a generic function
11 ;;; for which swank-<implementation>.lisp provides methods.
12
13 (defpackage :swank-backend
14 (:use :common-lisp)
15 (:export #:sldb-condition
16 #:original-condition
17 #:compiler-condition
18 #:message
19 #:short-message
20 #:condition
21 #:severity
22 #:with-compilation-hooks
23 #:location
24 #:location-p
25 #:location-buffer
26 #:location-position
27 #:position-p
28 #:position-pos
29 #:print-output-to-string
30 #:quit-lisp
31 #:references
32 #:unbound-slot-filler
33 #:declaration-arglist
34 #:type-specifier-arglist
35 ;; interrupt macro for the backend
36 #:*pending-slime-interrupts*
37 #:check-slime-interrupts
38 ;; inspector related symbols
39 #:emacs-inspect
40 #:label-value-line
41 #:label-value-line*
42
43 #:with-struct
44 ))
45
46 (defpackage :swank-mop
47 (:use)
48 (:export
49 ;; classes
50 #:standard-generic-function
51 #:standard-slot-definition
52 #:standard-method
53 #:standard-class
54 #:eql-specializer
55 #:eql-specializer-object
56 ;; standard-class readers
57 #:class-default-initargs
58 #:class-direct-default-initargs
59 #:class-direct-slots
60 #:class-direct-subclasses
61 #:class-direct-superclasses
62 #:class-finalized-p
63 #:class-name
64 #:class-precedence-list
65 #:class-prototype
66 #:class-slots
67 #:specializer-direct-methods
68 ;; generic function readers
69 #:generic-function-argument-precedence-order
70 #:generic-function-declarations
71 #:generic-function-lambda-list
72 #:generic-function-methods
73 #:generic-function-method-class
74 #:generic-function-method-combination
75 #:generic-function-name
76 ;; method readers
77 #:method-generic-function
78 #:method-function
79 #:method-lambda-list
80 #:method-specializers
81 #:method-qualifiers
82 ;; slot readers
83 #:slot-definition-allocation
84 #:slot-definition-documentation
85 #:slot-definition-initargs
86 #:slot-definition-initform
87 #:slot-definition-initfunction
88 #:slot-definition-name
89 #:slot-definition-type
90 #:slot-definition-readers
91 #:slot-definition-writers
92 #:slot-boundp-using-class
93 #:slot-value-using-class
94 #:slot-makunbound-using-class
95 ;; generic function protocol
96 #:compute-applicable-methods-using-classes
97 #:finalize-inheritance))
98
99 (in-package :swank-backend)
100
101
102 ;;;; Metacode
103
104 (defparameter *interface-functions* '()
105 "The names of all interface functions.")
106
107 (defparameter *unimplemented-interfaces* '()
108 "List of interface functions that are not implemented.
109 DEFINTERFACE adds to this list and DEFIMPLEMENTATION removes.")
110
111 (defmacro definterface (name args documentation &rest default-body)
112 "Define an interface function for the backend to implement.
113 A function is defined with NAME, ARGS, and DOCUMENTATION. This
114 function first looks for a function to call in NAME's property list
115 that is indicated by 'IMPLEMENTATION; failing that, it looks for a
116 function indicated by 'DEFAULT. If neither is present, an error is
117 signaled.
118
119 If a DEFAULT-BODY is supplied, then a function with the same body and
120 ARGS will be added to NAME's property list as the property indicated
121 by 'DEFAULT.
122
123 Backends implement these functions using DEFIMPLEMENTATION."
124 (check-type documentation string "a documentation string")
125 (assert (every #'symbolp args) ()
126 "Complex lambda-list not supported: ~S ~S" name args)
127 (labels ((gen-default-impl ()
128 `(setf (get ',name 'default) (lambda ,args ,@default-body)))
129 (args-as-list (args)
130 (destructuring-bind (req opt key rest) (parse-lambda-list args)
131 `(,@req ,@opt
132 ,@(loop for k in key append `(,(kw k) ,k))
133 ,@(or rest '(())))))
134 (parse-lambda-list (args)
135 (parse args '(&optional &key &rest)
136 (make-array 4 :initial-element nil)))
137 (parse (args keywords vars)
138 (cond ((null args)
139 (reverse (map 'list #'reverse vars)))
140 ((member (car args) keywords)
141 (parse (cdr args) (cdr (member (car args) keywords)) vars))
142 (t (push (car args) (aref vars (length keywords)))
143 (parse (cdr args) keywords vars))))
144 (kw (s) (intern (string s) :keyword)))
145 `(progn
146 (defun ,name ,args
147 ,documentation
148 (let ((f (or (get ',name 'implementation)
149 (get ',name 'default))))
150 (cond (f (apply f ,@(args-as-list args)))
151 (t (error "~S not implementated" ',name)))))
152 (pushnew ',name *interface-functions*)
153 ,(if (null default-body)
154 `(pushnew ',name *unimplemented-interfaces*)
155 (gen-default-impl))
156 ;; see <http://www.franz.com/support/documentation/6.2/doc/pages/variables/compiler/s_cltl1-compile-file-toplevel-compatibility-p_s.htm>
157 (eval-when (:compile-toplevel :load-toplevel :execute)
158 (export ',name :swank-backend))
159 ',name)))
160
161 (defmacro defimplementation (name args &body body)
162 (assert (every #'symbolp args) ()
163 "Complex lambda-list not supported: ~S ~S" name args)
164 `(progn
165 (setf (get ',name 'implementation) (lambda ,args ,@body))
166 (if (member ',name *interface-functions*)
167 (setq *unimplemented-interfaces*
168 (remove ',name *unimplemented-interfaces*))
169 (warn "DEFIMPLEMENTATION of undefined interface (~S)" ',name))
170 ',name))
171
172 (defun warn-unimplemented-interfaces ()
173 "Warn the user about unimplemented backend features.
174 The portable code calls this function at startup."
175 (warn "These Swank interfaces are unimplemented:~% ~A"
176 (sort (copy-list *unimplemented-interfaces*) #'string<)))
177
178 (defun import-to-swank-mop (symbol-list)
179 (dolist (sym symbol-list)
180 (let* ((swank-mop-sym (find-symbol (symbol-name sym) :swank-mop)))
181 (when swank-mop-sym
182 (unintern swank-mop-sym :swank-mop))
183 (import sym :swank-mop)
184 (export sym :swank-mop))))
185
186 (defun import-swank-mop-symbols (package except)
187 "Import the mop symbols from PACKAGE to SWANK-MOP.
188 EXCEPT is a list of symbol names which should be ignored."
189 (do-symbols (s :swank-mop)
190 (unless (member s except :test #'string=)
191 (let ((real-symbol (find-symbol (string s) package)))
192 (assert real-symbol () "Symbol ~A not found in package ~A" s package)
193 (unintern s :swank-mop)
194 (import real-symbol :swank-mop)
195 (export real-symbol :swank-mop)))))
196
197 (defvar *gray-stream-symbols*
198 '(:fundamental-character-output-stream
199 :stream-write-char
200 :stream-write-string
201 :stream-fresh-line
202 :stream-force-output
203 :stream-finish-output
204 :fundamental-character-input-stream
205 :stream-read-char
206 :stream-listen
207 :stream-unread-char
208 :stream-clear-input
209 :stream-line-column
210 :stream-read-char-no-hang
211 ;; STREAM-LINE-LENGTH is an extension to gray streams that's apparently
212 ;; supported by CMUCL, OpenMCL, SBCL and SCL.
213 #+(or cmu openmcl sbcl scl)
214 :stream-line-length))
215
216 (defun import-from (package symbol-names &optional (to-package *package*))
217 "Import the list of SYMBOL-NAMES found in the package PACKAGE."
218 (dolist (name symbol-names)
219 (multiple-value-bind (symbol found) (find-symbol (string name) package)
220 (assert found () "Symbol ~A not found in package ~A" name package)
221 (import symbol to-package))))
222
223
224 ;;;; Utilities
225
226 (defmacro with-struct ((conc-name &rest names) obj &body body)
227 "Like with-slots but works only for structs."
228 (flet ((reader (slot) (intern (concatenate 'string
229 (symbol-name conc-name)
230 (symbol-name slot))
231 (symbol-package conc-name))))
232 (let ((tmp (gensym "OO-")))
233 ` (let ((,tmp ,obj))
234 (symbol-macrolet
235 ,(loop for name in names collect
236 (typecase name
237 (symbol `(,name (,(reader name) ,tmp)))
238 (cons `(,(first name) (,(reader (second name)) ,tmp)))
239 (t (error "Malformed syntax in WITH-STRUCT: ~A" name))))
240 ,@body)))))
241
242
243 ;;;; TCP server
244
245 (definterface create-socket (host port)
246 "Create a listening TCP socket on interface HOST and port PORT .")
247
248 (definterface local-port (socket)
249 "Return the local port number of SOCKET.")
250
251 (definterface close-socket (socket)
252 "Close the socket SOCKET.")
253
254 (definterface accept-connection (socket &key external-format
255 buffering timeout)
256 "Accept a client connection on the listening socket SOCKET.
257 Return a stream for the new connection.")
258
259 (definterface add-sigio-handler (socket fn)
260 "Call FN whenever SOCKET is readable.")
261
262 (definterface remove-sigio-handlers (socket)
263 "Remove all sigio handlers for SOCKET.")
264
265 (definterface add-fd-handler (socket fn)
266 "Call FN when Lisp is waiting for input and SOCKET is readable.")
267
268 (definterface remove-fd-handlers (socket)
269 "Remove all fd-handlers for SOCKET.")
270
271 (definterface preferred-communication-style ()
272 "Return one of the symbols :spawn, :sigio, :fd-handler, or NIL."
273 nil)
274
275 (definterface set-stream-timeout (stream timeout)
276 "Set the 'stream 'timeout. The timeout is either the real number
277 specifying the timeout in seconds or 'nil for no timeout."
278 (declare (ignore stream timeout))
279 nil)
280
281 ;;; Base condition for networking errors.
282 (define-condition network-error (simple-error) ())
283
284 (definterface emacs-connected ()
285 "Hook called when the first connection from Emacs is established.
286 Called from the INIT-FN of the socket server that accepts the
287 connection.
288
289 This is intended for setting up extra context, e.g. to discover
290 that the calling thread is the one that interacts with Emacs."
291 nil)
292
293
294 ;;;; Unix signals
295
296 (defconstant +sigint+ 2)
297
298 (definterface call-without-interrupts (fn)
299 "Call FN in a context where interrupts are disabled."
300 (funcall fn))
301
302 (definterface getpid ()
303 "Return the (Unix) process ID of this superior Lisp.")
304
305 (definterface install-sigint-handler (function)
306 "Call FUNCTION on SIGINT (instead of invoking the debugger).
307 Return old signal handler."
308 nil)
309
310 (definterface call-with-user-break-handler (handler function)
311 "Install the break handler HANDLER while executing FUNCTION."
312 (let ((old-handler (install-sigint-handler handler)))
313 (unwind-protect (funcall function)
314 (install-sigint-handler old-handler))))
315
316 (definterface lisp-implementation-type-name ()
317 "Return a short name for the Lisp implementation."
318 (lisp-implementation-type))
319
320 (definterface default-directory ()
321 "Return the default directory."
322 (directory-namestring (truename *default-pathname-defaults*)))
323
324 (definterface set-default-directory (directory)
325 "Set the default directory.
326 This is used to resolve filenames without directory component."
327 (setf *default-pathname-defaults* (truename (merge-pathnames directory)))
328 (default-directory))
329
330 (definterface call-with-syntax-hooks (fn)
331 "Call FN with hooks to handle special syntax."
332 (funcall fn))
333
334 (definterface default-readtable-alist ()
335 "Return a suitable initial value for SWANK:*READTABLE-ALIST*."
336 '())
337
338 (definterface quit-lisp ()
339 "Exit the current lisp image.")
340
341
342 ;;;; Compilation
343
344 (definterface call-with-compilation-hooks (func)
345 "Call FUNC with hooks to record compiler conditions.")
346
347 (defmacro with-compilation-hooks ((&rest ignore) &body body)
348 "Execute BODY as in CALL-WITH-COMPILATION-HOOKS."
349 (declare (ignore ignore))
350 `(call-with-compilation-hooks (lambda () (progn ,@body))))
351
352 (definterface swank-compile-string (string &key buffer position directory debug)
353 "Compile source from STRING. During compilation, compiler
354 conditions must be trapped and resignalled as COMPILER-CONDITIONs.
355
356 If supplied, BUFFER and POSITION specify the source location in Emacs.
357
358 Additionally, if POSITION is supplied, it must be added to source
359 positions reported in compiler conditions.
360
361 If DIRECTORY is specified it may be used by certain implementations to
362 rebind *DEFAULT-PATHNAME-DEFAULTS* which may improve the recording of
363 source information.
364
365 If DEBUG is supplied, and non-NIL, it may be used by certain
366 implementations to compile with a debug optimization quality of its
367 value.
368
369 Should return T on successfull compilation, NIL otherwise.
370 ")
371
372 (definterface swank-compile-file (filename load-p external-format)
373 "Compile FILENAME signalling COMPILE-CONDITIONs.
374 If LOAD-P is true, load the file after compilation.
375 EXTERNAL-FORMAT is a value returned by find-external-format or
376 :default.
377
378 Should return T on successfull compilation, NIL otherwise.")
379
380 (deftype severity ()
381 '(member :error :read-error :warning :style-warning :note))
382
383 ;; Base condition type for compiler errors, warnings and notes.
384 (define-condition compiler-condition (condition)
385 ((original-condition
386 ;; The original condition thrown by the compiler if appropriate.
387 ;; May be NIL if a compiler does not report using conditions.
388 :type (or null condition)
389 :initarg :original-condition
390 :accessor original-condition)
391
392 (severity :type severity
393 :initarg :severity
394 :accessor severity)
395
396 (message :initarg :message
397 :accessor message)
398
399 (short-message :initarg :short-message
400 :initform nil
401 :accessor short-message)
402
403 (references :initarg :references
404 :initform nil
405 :accessor references)
406
407 (location :initarg :location
408 :accessor location)))
409
410 (definterface find-external-format (coding-system)
411 "Return a \"external file format designator\" for CODING-SYSTEM.
412 CODING-SYSTEM is Emacs-style coding system name (a string),
413 e.g. \"latin-1-unix\"."
414 (if (equal coding-system "iso-latin-1-unix")
415 :default
416 nil))
417
418 (definterface guess-external-format (filename)
419 "Detect the external format for the file with name FILENAME.
420 Return nil if the file contains no special markers."
421 ;; Look for a Emacs-style -*- coding: ... -*- or Local Variable: section.
422 (with-open-file (s filename :if-does-not-exist nil
423 :external-format (or (find-external-format "latin-1-unix")
424 :default))
425 (if s
426 (or (let* ((line (read-line s nil))
427 (p (search "-*-" line)))
428 (when p
429 (let* ((start (+ p (length "-*-")))
430 (end (search "-*-" line :start2 start)))
431 (when end
432 (%search-coding line start end)))))
433 (let* ((len (file-length s))
434 (buf (make-string (min len 3000))))
435 (file-position s (- len (length buf)))
436 (read-sequence buf s)
437 (let ((start (search "Local Variables:" buf :from-end t))
438 (end (search "End:" buf :from-end t)))
439 (and start end (< start end)
440 (%search-coding buf start end))))))))
441
442 (defun %search-coding (str start end)
443 (let ((p (search "coding:" str :start2 start :end2 end)))
444 (when p
445 (incf p (length "coding:"))
446 (loop while (and (< p end)
447 (member (aref str p) '(#\space #\tab)))
448 do (incf p))
449 (let ((end (position-if (lambda (c) (find c '(#\space #\tab #\newline)))
450 str :start p)))
451 (find-external-format (subseq str p end))))))
452
453
454 ;;;; Streams
455
456 (definterface make-fn-streams (input-fn output-fn)
457 "Return character input and output streams backended by functions.
458 When input is needed, INPUT-FN is called with no arguments to
459 return a string.
460 When output is ready, OUTPUT-FN is called with the output as its
461 argument.
462
463 Output should be forced to OUTPUT-FN before calling INPUT-FN.
464
465 The streams are returned as two values.")
466
467
468 ;;;; Documentation
469
470 (definterface arglist (name)
471 "Return the lambda list for the symbol NAME. NAME can also be
472 a lisp function object, on lisps which support this.
473
474 The result can be a list or the :not-available keyword if the
475 arglist cannot be determined."
476 (declare (ignore name))
477 :not-available)
478
479 (defgeneric declaration-arglist (decl-identifier)
480 (:documentation
481 "Return the argument list of the declaration specifier belonging to the
482 declaration identifier DECL-IDENTIFIER. If the arglist cannot be determined,
483 the keyword :NOT-AVAILABLE is returned.
484
485 The different SWANK backends can specialize this generic function to
486 include implementation-dependend declaration specifiers, or to provide
487 additional information on the specifiers defined in ANSI Common Lisp.")
488 (:method (decl-identifier)
489 (case decl-identifier
490 (dynamic-extent '(&rest vars))
491 (ignore '(&rest vars))
492 (ignorable '(&rest vars))
493 (special '(&rest vars))
494 (inline '(&rest function-names))
495 (notinline '(&rest function-name))
496 (optimize '(&any compilation-speed debug safety space speed))
497 (type '(type-specifier &rest args))
498 (ftype '(type-specifier &rest function-names))
499 (otherwise
500 (flet ((typespec-p (symbol) (member :type (describe-symbol-for-emacs symbol))))
501 (cond ((and (symbolp decl-identifier) (typespec-p decl-identifier))
502 '(&rest vars))
503 ((and (listp decl-identifier) (typespec-p (first decl-identifier)))
504 '(&rest vars))
505 (t :not-available)))))))
506
507 (defgeneric type-specifier-arglist (typespec-operator)
508 (:documentation
509 "Return the argument list of the type specifier belonging to
510 TYPESPEC-OPERATOR.. If the arglist cannot be determined, the keyword
511 :NOT-AVAILABLE is returned.
512
513 The different SWANK backends can specialize this generic function to
514 include implementation-dependend declaration specifiers, or to provide
515 additional information on the specifiers defined in ANSI Common Lisp.")
516 (:method (typespec-operator)
517 (declare (special *type-specifier-arglists*)) ; defined at end of file.
518 (typecase typespec-operator
519 (symbol (or (cdr (assoc typespec-operator *type-specifier-arglists*))
520 :not-available))
521 (t :not-available))))
522
523 (definterface function-name (function)
524 "Return the name of the function object FUNCTION.
525
526 The result is either a symbol, a list, or NIL if no function name is available."
527 (declare (ignore function))
528 nil)
529
530 (definterface macroexpand-all (form)
531 "Recursively expand all macros in FORM.
532 Return the resulting form.")
533
534 (definterface compiler-macroexpand-1 (form &optional env)
535 "Call the compiler-macro for form.
536 If FORM is a function call for which a compiler-macro has been
537 defined, invoke the expander function using *macroexpand-hook* and
538 return the results and T. Otherwise, return the original form and
539 NIL."
540 (let ((fun (and (consp form) (compiler-macro-function (car form)))))
541 (if fun
542 (let ((result (funcall *macroexpand-hook* fun form env)))
543 (values result (not (eq result form))))
544 (values form nil))))
545
546 (definterface compiler-macroexpand (form &optional env)
547 "Repetitively call `compiler-macroexpand-1'."
548 (labels ((frob (form expanded)
549 (multiple-value-bind (new-form newly-expanded)
550 (compiler-macroexpand-1 form env)
551 (if newly-expanded
552 (frob new-form t)
553 (values new-form expanded)))))
554 (frob form env)))
555
556 (definterface describe-symbol-for-emacs (symbol)
557 "Return a property list describing SYMBOL.
558
559 The property list has an entry for each interesting aspect of the
560 symbol. The recognised keys are:
561
562 :VARIABLE :FUNCTION :SETF :SPECIAL-OPERATOR :MACRO :COMPILER-MACRO
563 :TYPE :CLASS :ALIEN-TYPE :ALIEN-STRUCT :ALIEN-UNION :ALIEN-ENUM
564
565 The value of each property is the corresponding documentation string,
566 or :NOT-DOCUMENTED. It is legal to include keys not listed here (but
567 slime-print-apropos in Emacs must know about them).
568
569 Properties should be included if and only if they are applicable to
570 the symbol. For example, only (and all) fbound symbols should include
571 the :FUNCTION property.
572
573 Example:
574 \(describe-symbol-for-emacs 'vector)
575 => (:CLASS :NOT-DOCUMENTED
576 :TYPE :NOT-DOCUMENTED
577 :FUNCTION \"Constructs a simple-vector from the given objects.\")")
578
579 (definterface describe-definition (name type)
580 "Describe the definition NAME of TYPE.
581 TYPE can be any value returned by DESCRIBE-SYMBOL-FOR-EMACS.
582
583 Return a documentation string, or NIL if none is available.")
584
585
586 ;;;; Debugging
587
588 (definterface install-debugger-globally (function)
589 "Install FUNCTION as the debugger for all threads/processes. This
590 usually involves setting *DEBUGGER-HOOK* and, if the implementation
591 permits, hooking into BREAK as well."
592 (setq *debugger-hook* function))
593
594 (definterface call-with-debugging-environment (debugger-loop-fn)
595 "Call DEBUGGER-LOOP-FN in a suitable debugging environment.
596
597 This function is called recursively at each debug level to invoke the
598 debugger loop. The purpose is to setup any necessary environment for
599 other debugger callbacks that will be called within the debugger loop.
600
601 For example, this is a reasonable place to compute a backtrace, switch
602 to safe reader/printer settings, and so on.")
603
604 (definterface call-with-debugger-hook (hook fun)
605 "Call FUN and use HOOK as debugger hook.
606
607 HOOK should be called for both BREAK and INVOKE-DEBUGGER."
608 (let ((*debugger-hook* hook))
609 (funcall fun)))
610
611 (define-condition sldb-condition (condition)
612 ((original-condition
613 :initarg :original-condition
614 :accessor original-condition))
615 (:report (lambda (condition stream)
616 (format stream "Condition in debugger code~@[: ~A~]"
617 (original-condition condition))))
618 (:documentation
619 "Wrapper for conditions that should not be debugged.
620
621 When a condition arises from the internals of the debugger, it is not
622 desirable to debug it -- we'd risk entering an endless loop trying to
623 debug the debugger! Instead, such conditions can be reported to the
624 user without (re)entering the debugger by wrapping them as
625 `sldb-condition's."))
626
627 (definterface compute-sane-restarts (condition)
628 "This is an opportunity for Lisps such as CLISP to remove
629 unwanted restarts from the output of CL:COMPUTE-RESTARTS,
630 otherwise it should simply call CL:COMPUTE-RESTARTS, which is
631 what the default implementation does."
632 (compute-restarts condition))
633
634 ;;; The following functions in this section are supposed to be called
635 ;;; within the dynamic contour of CALL-WITH-DEBUGGING-ENVIRONMENT only.
636
637 (definterface compute-backtrace (start end)
638 "Returns a backtrace of the condition currently being debugged,
639 that is an ordered list consisting of frames. (What constitutes a
640 frame is implementation dependent, but PRINT-FRAME must be defined on
641 it.)
642
643 ``Ordered list'' means that the i-th. frame is associated to the
644 frame-number i.
645
646 START and END are zero-based indices constraining the number of frames
647 returned. Frame zero is defined as the frame which invoked the
648 debugger. If END is nil, return the frames from START to the end of
649 the stack.")
650
651 (definterface print-frame (frame stream)
652 "Print frame to stream.")
653
654 (definterface frame-source-location-for-emacs (frame-number)
655 "Return the source location for the frame associated to FRAME-NUMBER.")
656
657 (definterface frame-catch-tags (frame-number)
658 "Return a list of catch tags for being printed in a debugger stack
659 frame.")
660
661 (definterface frame-locals (frame-number)
662 "Return a list of ((&key NAME ID VALUE) ...) where each element of
663 the list represents a local variable in the stack frame associated to
664 FRAME-NUMBER.
665
666 NAME, a symbol; the name of the local variable.
667
668 ID, an integer; used as primary key for the local variable, unique
669 relatively to the frame under operation.
670
671 value, an object; the value of the local variable.")
672
673 (definterface frame-var-value (frame-number var-id)
674 "Return the value of the local variable associated to VAR-ID
675 relatively to the frame associated to FRAME-NUMBER.")
676
677 (definterface disassemble-frame (frame-number)
678 "Disassemble the code for the FRAME-NUMBER.
679 The output should be written to standard output.
680 FRAME-NUMBER is a non-negative integer.")
681
682 (definterface eval-in-frame (form frame-number)
683 "Evaluate a Lisp form in the lexical context of a stack frame
684 in the debugger.
685
686 FRAME-NUMBER must be a positive integer with 0 indicating the
687 frame which invoked the debugger.
688
689 The return value is the result of evaulating FORM in the
690 appropriate context.")
691
692 (definterface return-from-frame (frame-number form)
693 "Unwind the stack to the frame FRAME-NUMBER and return the value(s)
694 produced by evaluating FORM in the frame context to its caller.
695
696 Execute any clean-up code from unwind-protect forms above the frame
697 during unwinding.
698
699 Return a string describing the error if it's not possible to return
700 from the frame.")
701
702 (definterface restart-frame (frame-number)
703 "Restart execution of the frame FRAME-NUMBER with the same arguments
704 as it was called originally.")
705
706 (definterface format-sldb-condition (condition)
707 "Format a condition for display in SLDB."
708 (princ-to-string condition))
709
710 (definterface condition-extras (condition)
711 "Return a list of extra for the debugger.
712 The allowed elements are of the form:
713 (:SHOW-FRAME-SOURCE frame-number)
714 (:REFERENCES &rest refs)
715 "
716 (declare (ignore condition))
717 '())
718
719 (definterface activate-stepping (frame-number)
720 "Prepare the frame FRAME-NUMBER for stepping.")
721
722 (definterface sldb-break-on-return (frame-number)
723 "Set a breakpoint in the frame FRAME-NUMBER.")
724
725 (definterface sldb-break-at-start (symbol)
726 "Set a breakpoint on the beginning of the function for SYMBOL.")
727
728 (definterface sldb-stepper-condition-p (condition)
729 "Return true if SLDB was invoked due to a single-stepping condition,
730 false otherwise. "
731 (declare (ignore condition))
732 nil)
733
734 (definterface sldb-step-into ()
735 "Step into the current single-stepper form.")
736
737 (definterface sldb-step-next ()
738 "Step to the next form in the current function.")
739
740 (definterface sldb-step-out ()
741 "Stop single-stepping temporarily, but resume it once the current function
742 returns.")
743
744
745 ;;;; Definition finding
746
747 (defstruct (:location (:type list) :named
748 (:constructor make-location
749 (buffer position &optional hints)))
750 buffer position
751 ;; Hints is a property list optionally containing:
752 ;; :snippet SOURCE-TEXT
753 ;; This is a snippet of the actual source text at the start of
754 ;; the definition, which could be used in a text search.
755 hints)
756
757 (defstruct (:error (:type list) :named (:constructor)) message)
758 (defstruct (:file (:type list) :named (:constructor)) name)
759 (defstruct (:buffer (:type list) :named (:constructor)) name)
760 (defstruct (:position (:type list) :named (:constructor)) pos)
761
762 (definterface find-definitions (name)
763 "Return a list ((DSPEC LOCATION) ...) for NAME's definitions.
764
765 NAME is a \"definition specifier\".
766
767 DSPEC is a \"definition specifier\" describing the
768 definition, e.g., FOO or (METHOD FOO (STRING NUMBER)) or
769 \(DEFVAR FOO).
770
771 LOCATION is the source location for the definition.")
772
773 (definterface find-source-location (object)
774 "Returns the source location of OBJECT, or NIL.
775
776 That is the source location of the underlying datastructure of
777 OBJECT. E.g. on a STANDARD-OBJECT, the source location of the
778 respective DEFCLASS definition is returned, on a STRUCTURE-CLASS the
779 respective DEFSTRUCT definition, and so on."
780 ;; This returns one source location and not a list of locations. It's
781 ;; supposed to return the location of the DEFGENERIC definition on
782 ;; #'SOME-GENERIC-FUNCTION.
783 )
784
785
786 (definterface buffer-first-change (filename)
787 "Called for effect the first time FILENAME's buffer is modified."
788 (declare (ignore filename))
789 nil)
790
791
792
793 ;;;; XREF
794
795 (definterface who-calls (function-name)
796 "Return the call sites of FUNCTION-NAME (a symbol).
797 The results is a list ((DSPEC LOCATION) ...).")
798
799 (definterface calls-who (function-name)
800 "Return the call sites of FUNCTION-NAME (a symbol).
801 The results is a list ((DSPEC LOCATION) ...).")
802
803 (definterface who-references (variable-name)
804 "Return the locations where VARIABLE-NAME (a symbol) is referenced.
805 See WHO-CALLS for a description of the return value.")
806
807 (definterface who-binds (variable-name)
808 "Return the locations where VARIABLE-NAME (a symbol) is bound.
809 See WHO-CALLS for a description of the return value.")
810
811 (definterface who-sets (variable-name)
812 "Return the locations where VARIABLE-NAME (a symbol) is set.
813 See WHO-CALLS for a description of the return value.")
814
815 (definterface who-macroexpands (macro-name)
816 "Return the locations where MACRO-NAME (a symbol) is expanded.
817 See WHO-CALLS for a description of the return value.")
818
819 (definterface who-specializes (class-name)
820 "Return the locations where CLASS-NAME (a symbol) is specialized.
821 See WHO-CALLS for a description of the return value.")
822
823 ;;; Simpler variants.
824
825 (definterface list-callers (function-name)
826 "List the callers of FUNCTION-NAME.
827 This function is like WHO-CALLS except that it is expected to use
828 lower-level means. Whereas WHO-CALLS is usually implemented with
829 special compiler support, LIST-CALLERS is usually implemented by
830 groveling for constants in function objects throughout the heap.
831
832 The return value is as for WHO-CALLS.")
833
834 (definterface list-callees (function-name)
835 "List the functions called by FUNCTION-NAME.
836 See LIST-CALLERS for a description of the return value.")
837
838
839 ;;;; Profiling
840
841 ;;; The following functions define a minimal profiling interface.
842
843 (definterface profile (fname)
844 "Marks symbol FNAME for profiling.")
845
846 (definterface profiled-functions ()
847 "Returns a list of profiled functions.")
848
849 (definterface unprofile (fname)
850 "Marks symbol FNAME as not profiled.")
851
852 (definterface unprofile-all ()
853 "Marks all currently profiled functions as not profiled."
854 (dolist (f (profiled-functions))
855 (unprofile f)))
856
857 (definterface profile-report ()
858 "Prints profile report.")
859
860 (definterface profile-reset ()
861 "Resets profile counters.")
862
863 (definterface profile-package (package callers-p methods)
864 "Wrap profiling code around all functions in PACKAGE. If a function
865 is already profiled, then unprofile and reprofile (useful to notice
866 function redefinition.)
867
868 If CALLERS-P is T names have counts of the most common calling
869 functions recorded.
870
871 When called with arguments :METHODS T, profile all methods of all
872 generic functions having names in the given package. Generic functions
873 themselves, that is, their dispatch functions, are left alone.")
874
875
876 ;;;; Inspector
877
878 (defgeneric emacs-inspect (object)
879 (:documentation
880 "Explain to Emacs how to inspect OBJECT.
881
882 Returns a list specifying how to render the object for inspection.
883
884 Every element of the list must be either a string, which will be
885 inserted into the buffer as is, or a list of the form:
886
887 (:value object &optional format) - Render an inspectable
888 object. If format is provided it must be a string and will be
889 rendered in place of the value, otherwise use princ-to-string.
890
891 (:newline) - Render a \\n
892
893 (:action label lambda &key (refresh t)) - Render LABEL (a text
894 string) which when clicked will call LAMBDA. If REFRESH is
895 non-NIL the currently inspected object will be re-inspected
896 after calling the lambda.
897 "))
898
899 (defmethod emacs-inspect ((object t))
900 "Generic method for inspecting any kind of object.
901
902 Since we don't know how to deal with OBJECT we simply dump the
903 output of CL:DESCRIBE."
904 `("Type: " (:value ,(type-of object)) (:newline)
905 "Don't know how to inspect the object, dumping output of CL:DESCRIBE:"
906 (:newline) (:newline)
907 ,(with-output-to-string (desc) (describe object desc))))
908
909 ;;; Utilities for inspector methods.
910 ;;;
911 (defun label-value-line (label value &key (newline t))
912 "Create a control list which prints \"LABEL: VALUE\" in the inspector.
913 If NEWLINE is non-NIL a `(:newline)' is added to the result."
914 (list* (princ-to-string label) ": " `(:value ,value)
915 (if newline '((:newline)) nil)))
916
917 (defmacro label-value-line* (&rest label-values)
918 ` (append ,@(loop for (label value) in label-values
919 collect `(label-value-line ,label ,value))))
920
921 (definterface describe-primitive-type (object)
922 "Return a string describing the primitive type of object."
923 (declare (ignore object))
924 "N/A")
925
926
927 ;;;; Multithreading
928 ;;;
929 ;;; The default implementations are sufficient for non-multiprocessing
930 ;;; implementations.
931
932 (definterface initialize-multiprocessing (continuation)
933 "Initialize multiprocessing, if necessary and then invoke CONTINUATION.
934
935 Depending on the impleimentaion, this function may never return."
936 (funcall continuation))
937
938 (definterface spawn (fn &key name)
939 "Create a new thread to call FN.")
940
941 (definterface thread-id (thread)
942 "Return an Emacs-parsable object to identify THREAD.
943
944 Ids should be comparable with equal, i.e.:
945 (equal (thread-id <t1>) (thread-id <t2>)) <==> (eq <t1> <t2>)"
946 thread)
947
948 (definterface find-thread (id)
949 "Return the thread for ID.
950 ID should be an id previously obtained with THREAD-ID.
951 Can return nil if the thread no longer exists."
952 (current-thread))
953
954 (definterface thread-name (thread)
955 "Return the name of THREAD.
956
957 Thread names are be single-line strings and are meaningful to the
958 user. They do not have to be unique."
959 (declare (ignore thread))
960 "The One True Thread")
961
962 (definterface thread-status (thread)
963 "Return a string describing THREAD's state."
964 (declare (ignore thread))
965 "")
966
967 (definterface thread-description (thread)
968 "Return a string describing THREAD."
969 (declare (ignore thread))
970 "")
971
972 (definterface set-thread-description (thread description)
973 "Set THREAD's description to DESCRIPTION."
974 (declare (ignore thread description))
975 "")
976
977 (definterface make-lock (&key name)
978 "Make a lock for thread synchronization.
979 Only one thread may hold the lock (via CALL-WITH-LOCK-HELD) at a time
980 but that thread may hold it more than once."
981 (declare (ignore name))
982 :null-lock)
983
984 (definterface call-with-lock-held (lock function)
985 "Call FUNCTION with LOCK held, queueing if necessary."
986 (declare (ignore lock)
987 (type function function))
988 (funcall function))
989
990 (definterface current-thread ()
991 "Return the currently executing thread."
992 0)
993
994 (definterface all-threads ()
995 "Return a list of all threads.")
996
997 (definterface thread-alive-p (thread)
998 "Test if THREAD is termintated."
999 (member thread (all-threads)))
1000
1001 (definterface interrupt-thread (thread fn)
1002 "Cause THREAD to execute FN.")
1003
1004 (definterface kill-thread (thread)
1005 "Kill THREAD."
1006 (declare (ignore thread))
1007 nil)
1008
1009 (definterface send (thread object)
1010 "Send OBJECT to thread THREAD.")
1011
1012 (definterface receive (&optional timeout)
1013 "Return the next message from current thread's mailbox."
1014 (receive-if (constantly t) timeout))
1015
1016 (definterface receive-if (predicate &optional timeout)
1017 "Return the first message satisfiying PREDICATE.")
1018
1019 (defvar *pending-slime-interrupts*)
1020
1021 (defun check-slime-interrupts ()
1022 "Execute pending interrupts if any.
1023 This should be called periodically in operations which
1024 can take a long time to complete."
1025 (when (and (boundp '*pending-slime-interrupts*)
1026 *pending-slime-interrupts*)
1027 (funcall (pop *pending-slime-interrupts*))))
1028
1029 (definterface toggle-trace (spec)
1030 "Toggle tracing of the function(s) given with SPEC.
1031 SPEC can be:
1032 (setf NAME) ; a setf function
1033 (:defmethod NAME QUALIFIER... (SPECIALIZER...)) ; a specific method
1034 (:defgeneric NAME) ; a generic function with all methods
1035 (:call CALLER CALLEE) ; trace calls from CALLER to CALLEE.
1036 (:labels TOPLEVEL LOCAL)
1037 (:flet TOPLEVEL LOCAL) ")
1038
1039
1040 ;;;; Weak datastructures
1041
1042 (definterface make-weak-key-hash-table (&rest args)
1043 "Like MAKE-HASH-TABLE, but weak w.r.t. the keys."
1044 (apply #'make-hash-table args))
1045
1046 (definterface make-weak-value-hash-table (&rest args)
1047 "Like MAKE-HASH-TABLE, but weak w.r.t. the values."
1048 (apply #'make-hash-table args))
1049
1050 (definterface hash-table-weakness (hashtable)
1051 "Return nil or one of :key :value :key-or-value :key-and-value"
1052 (declare (ignore hashtable))
1053 nil)
1054
1055
1056 ;;;; Character names
1057
1058 (definterface character-completion-set (prefix matchp)
1059 "Return a list of names of characters that match PREFIX."
1060 ;; Handle the standard and semi-standard characters.
1061 (loop for name in '("Newline" "Space" "Tab" "Page" "Rubout"
1062 "Linefeed" "Return" "Backspace")
1063 when (funcall matchp prefix name)
1064 collect name))
1065
1066
1067 (defparameter *type-specifier-arglists*
1068 '((and . (&rest type-specifiers))
1069 (array . (&optional element-type dimension-spec))
1070 (base-string . (&optional size))
1071 (bit-vector . (&optional size))
1072 (complex . (&optional type-specifier))
1073 (cons . (&optional car-typespec cdr-typespec))
1074 (double-float . (&optional lower-limit upper-limit))
1075 (eql . (object))
1076 (float . (&optional lower-limit upper-limit))
1077 (function . (&optional arg-typespec value-typespec))
1078 (integer . (&optional lower-limit upper-limit))
1079 (long-float . (&optional lower-limit upper-limit))
1080 (member . (&rest eql-objects))
1081 (mod . (n))
1082 (not . (type-specifier))
1083 (or . (&rest type-specifiers))
1084 (rational . (&optional lower-limit upper-limit))
1085 (real . (&optional lower-limit upper-limit))
1086 (satisfies . (predicate-symbol))
1087 (short-float . (&optional lower-limit upper-limit))
1088 (signed-byte . (&optional size))
1089 (simple-array . (&optional element-type dimension-spec))
1090 (simple-base-string . (&optional size))
1091 (simple-bit-vector . (&optional size))
1092 (simple-string . (&optional size))
1093 (single-float . (&optional lower-limit upper-limit))
1094 (simple-vector . (&optional size))
1095 (string . (&optional size))
1096 (unsigned-byte . (&optional size))
1097 (values . (&rest typespecs))
1098 (vector . (&optional element-type size))
1099 ))
1100
1101 ;;; Heap dumps
1102
1103 (definterface save-image (filename &optional restart-function)
1104 "Save a heap image to the file FILENAME.
1105 RESTART-FUNCTION, if non-nil, should be called when the image is loaded.")
1106
1107
1108

  ViewVC Help
Powered by ViewVC 1.1.5