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

Contents of /slime/swank-backend.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.72 - (show annotations)
Mon Nov 1 17:19:35 2004 UTC (9 years, 5 months ago) by heller
Branch: MAIN
Changes since 1.71: +2 -1 lines
(deftype severity): Add read-errors.
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 #:references
29 #:unbound-slot-filler
30 ;; inspector related symbols
31 #:inspector
32 #:inspect-for-emacs
33 #:raw-inspection
34 #:fancy-inspection
35 #:label-value-line
36 #:label-value-line*
37 ))
38
39 (defpackage :swank-mop
40 (:use)
41 (:export
42 ;; classes
43 #:standard-generic-function
44 #:standard-slot-definition
45 #:standard-method
46 #:standard-class
47 #:eql-specializer
48 #:eql-specializer-object
49 ;; standard-class readers
50 #:class-default-initargs
51 #:class-direct-default-initargs
52 #:class-direct-slots
53 #:class-direct-subclasses
54 #:class-direct-superclasses
55 #:class-finalized-p
56 #:class-name
57 #:class-precedence-list
58 #:class-prototype
59 #:class-slots
60 #:specializer-direct-methods
61 ;; generic function readers
62 #:generic-function-argument-precedence-order
63 #:generic-function-declarations
64 #:generic-function-lambda-list
65 #:generic-function-methods
66 #:generic-function-method-class
67 #:generic-function-method-combination
68 #:generic-function-name
69 ;; method readers
70 #:method-generic-function
71 #:method-function
72 #:method-lambda-list
73 #:method-specializers
74 #:method-qualifiers
75 ;; slot readers
76 #:slot-definition-allocation
77 #:slot-definition-documentation
78 #:slot-definition-initargs
79 #:slot-definition-initform
80 #:slot-definition-initfunction
81 #:slot-definition-name
82 #:slot-definition-type
83 #:slot-definition-readers
84 #:slot-definition-writers))
85
86 (in-package :swank-backend)
87
88
89 ;;;; Metacode
90
91 (defparameter *interface-functions* '()
92 "The names of all interface functions.")
93
94 (defparameter *unimplemented-interfaces* '()
95 "List of interface functions that are not implemented.
96 DEFINTERFACE adds to this list and DEFIMPLEMENTATION removes.")
97
98 (defmacro definterface (name args documentation &rest default-body)
99 "Define an interface function for the backend to implement.
100 A generic function is defined with NAME, ARGS, and DOCUMENTATION.
101
102 If a DEFAULT-BODY is supplied then NO-APPLICABLE-METHOD is specialized
103 to execute the body if the backend doesn't provide a specific
104 implementation.
105
106 Backends implement these functions using DEFIMPLEMENTATION."
107 (check-type documentation string "a documentation string")
108 (flet ((gen-default-impl ()
109 (let ((received-args (gensym "ARGS-")))
110 `(defmethod ,name ,args ,@default-body))))
111 `(progn (defgeneric ,name ,args (:documentation ,documentation))
112 (pushnew ',name *interface-functions*)
113 ,(if (null default-body)
114 `(pushnew ',name *unimplemented-interfaces*)
115 (gen-default-impl))
116 ;; see <http://www.franz.com/support/documentation/6.2/doc/pages/variables/compiler/s_cltl1-compile-file-toplevel-compatibility-p_s.htm>
117 (eval-when (:compile-toplevel :load-toplevel :execute)
118 (export ',name :swank-backend))
119 ',name)))
120
121 (defmacro defimplementation (name args &body body)
122 `(progn (defmethod ,name ,args ,@body)
123 (if (member ',name *interface-functions*)
124 (setq *unimplemented-interfaces*
125 (remove ',name *unimplemented-interfaces*))
126 (warn "DEFIMPLEMENTATION of undefined interface (~S)" ',name))
127 ',name))
128
129 (defun warn-unimplemented-interfaces ()
130 "Warn the user about unimplemented backend features.
131 The portable code calls this function at startup."
132 (warn "These Swank interfaces are unimplemented:~% ~A"
133 (sort (copy-list *unimplemented-interfaces*) #'string<)))
134
135 (defun import-to-swank-mop (symbol-list)
136 (dolist (sym symbol-list)
137 (let* ((swank-mop-sym (find-symbol (symbol-name sym) :swank-mop)))
138 (when swank-mop-sym
139 (unintern swank-mop-sym :swank-mop))
140 (import sym :swank-mop)
141 (export sym :swank-mop))))
142
143 (defun import-swank-mop-symbols (package except)
144 "Import the mop symbols from PACKAGE to SWANK-MOP.
145 EXCEPT is a list of symbol names which should be ignored."
146 (do-symbols (s :swank-mop)
147 (unless (member s except :test #'string=)
148 (let ((real-symbol (find-symbol (string s) package)))
149 (assert real-symbol)
150 (unintern s :swank-mop)
151 (import real-symbol :swank-mop)
152 (export real-symbol :swank-mop)))))
153
154
155 ;;;; Utilities
156
157 (defmacro with-struct ((conc-name &rest names) obj &body body)
158 "Like with-slots but works only for structs."
159 (flet ((reader (slot) (intern (concatenate 'string
160 (symbol-name conc-name)
161 (symbol-name slot))
162 (symbol-package conc-name))))
163 (let ((tmp (gensym "OO-")))
164 ` (let ((,tmp ,obj))
165 (symbol-macrolet
166 ,(loop for name in names collect
167 (typecase name
168 (symbol `(,name (,(reader name) ,tmp)))
169 (cons `(,(first name) (,(reader (second name)) ,tmp)))
170 (t (error "Malformed syntax in WITH-STRUCT: ~A" name))))
171 ,@body)))))
172
173
174 ;;;; TCP server
175
176 (definterface create-socket (host port)
177 "Create a listening TCP socket on interface HOST and port PORT .")
178
179 (definterface local-port (socket)
180 "Return the local port number of SOCKET.")
181
182 (definterface close-socket (socket)
183 "Close the socket SOCKET.")
184
185 (definterface accept-connection (socket)
186 "Accept a client connection on the listening socket SOCKET. Return
187 a stream for the new connection.")
188
189 (definterface add-sigio-handler (socket fn)
190 "Call FN whenever SOCKET is readable.")
191
192 (definterface remove-sigio-handlers (socket)
193 "Remove all sigio handlers for SOCKET.")
194
195 (definterface add-fd-handler (socket fn)
196 "Call FN when Lisp is waiting for input and SOCKET is readable.")
197
198 (definterface remove-fd-handlers (socket)
199 "Remove all fd-handlers for SOCKET.")
200
201 (definterface preferred-communication-style ()
202 "Return one of the symbols :spawn, :sigio, :fd-handler, or NIL."
203 nil)
204
205 ;;; Base condition for networking errors.
206 (define-condition network-error (simple-error) ())
207
208 (definterface emacs-connected (stream)
209 "Hook called when the first connection from Emacs is established.
210 Called from the INIT-FN of the socket server that accepts the
211 connection.
212
213 This is intended for setting up extra context, e.g. to discover
214 that the calling thread is the one that interacts with Emacs.
215
216 STREAM is the redirected user output stream to Emacs. This is passed
217 so that the backend can apply buffer flushing magic."
218 nil)
219
220
221 ;;;; Unix signals
222
223 (defconstant +sigint+ 2)
224
225 (definterface call-without-interrupts (fn)
226 "Call FN in a context where interrupts are disabled."
227 (funcall fn))
228
229 (definterface getpid ()
230 "Return the (Unix) process ID of this superior Lisp.")
231
232 (definterface lisp-implementation-type-name ()
233 "Return a short name for the Lisp implementation."
234 (lisp-implementation-type))
235
236 (definterface default-directory ()
237 "Return the default directory."
238 (directory-namestring (truename *default-pathname-defaults*)))
239
240 (definterface set-default-directory (directory)
241 "Set the default directory.
242 This is used to resolve filenames without directory component."
243 (setf *default-pathname-defaults* (truename (merge-pathnames directory)))
244 (default-directory))
245
246 (definterface call-with-syntax-hooks (fn)
247 "Call FN with hooks to handle special syntax."
248 (funcall fn))
249
250 (definterface default-readtable-alist ()
251 "Return a suitable initial value for SWANK:*READTABLE-ALIST*."
252 '())
253
254 (definterface quit-lisp ()
255 "Exit the current lisp image.")
256
257
258 ;;;; Compilation
259
260 (definterface call-with-compilation-hooks (func)
261 "Call FUNC with hooks to record compiler conditions.")
262
263 (defmacro with-compilation-hooks ((&rest ignore) &body body)
264 "Execute BODY as in CALL-WITH-COMPILATION-HOOKS."
265 (declare (ignore ignore))
266 `(call-with-compilation-hooks (lambda () (progn ,@body))))
267
268 (definterface swank-compile-string (string &key buffer position directory)
269 "Compile source from STRING. During compilation, compiler
270 conditions must be trapped and resignalled as COMPILER-CONDITIONs.
271
272 If supplied, BUFFER and POSITION specify the source location in Emacs.
273
274 Additionally, if POSITION is supplied, it must be added to source
275 positions reported in compiler conditions.
276
277 If DIRECTORY is specified it may be used by certain implementations to
278 rebind *DEFAULT-PATHNAME-DEFAULTS* which may improve the recording of
279 source information.")
280
281 (definterface operate-on-system (system-name operation-name &rest keyword-args)
282 "Perform OPERATION-NAME on SYSTEM-NAME using ASDF.
283 The KEYWORD-ARGS are passed on to the operation.
284 Example:
285 \(operate-on-system \"SWANK\" \"COMPILE-OP\" :force t)"
286 (unless (member :asdf *features*)
287 (error "ASDF is not loaded."))
288 (with-compilation-hooks ()
289 (let ((operate (find-symbol "OPERATE" :asdf))
290 (operation (find-symbol operation-name :asdf)))
291 (when (null operation)
292 (error "Couldn't find ASDF operation ~S" operation-name))
293 (apply operate operation system-name keyword-args))))
294
295 (definterface swank-compile-file (filename load-p)
296 "Compile FILENAME signalling COMPILE-CONDITIONs.
297 If LOAD-P is true, load the file after compilation.")
298
299 (deftype severity ()
300 '(member :error :read-error :warning :style-warning :note))
301
302 ;; Base condition type for compiler errors, warnings and notes.
303 (define-condition compiler-condition (condition)
304 ((original-condition
305 ;; The original condition thrown by the compiler if appropriate.
306 ;; May be NIL if a compiler does not report using conditions.
307 :type (or null condition)
308 :initarg :original-condition
309 :accessor original-condition)
310
311 (severity :type severity
312 :initarg :severity
313 :accessor severity)
314
315 (message :initarg :message
316 :accessor message)
317
318 (short-message :initarg :short-message
319 :initform nil
320 :accessor short-message)
321
322 (references :initarg :references
323 :initform nil
324 :accessor references)
325
326 (location :initarg :location
327 :accessor location)))
328
329
330 ;;;; Streams
331
332 (definterface make-fn-streams (input-fn output-fn)
333 "Return character input and output streams backended by functions.
334 When input is needed, INPUT-FN is called with no arguments to
335 return a string.
336 When output is ready, OUTPUT-FN is called with the output as its
337 argument.
338
339 Output should be forced to OUTPUT-FN before calling INPUT-FN.
340
341 The streams are returned as two values.")
342
343 (definterface make-stream-interactive (stream)
344 "Do any necessary setup to make STREAM work interactively.
345 This is called for each stream used for interaction with the user
346 \(e.g. *standard-output*). An implementation could setup some
347 implementation-specific functions to control output flushing at the
348 like."
349 nil)
350
351
352 ;;;; Documentation
353
354 (definterface arglist (name)
355 "Return the lambda list for the symbol NAME. NAME can also be
356 a lisp function object, on lisps which support this.
357
358 The result can be a list or the :not-available if the arglist
359 cannot be determined."
360 (declare (ignore name))
361 :not-available)
362
363 (definterface function-name (function)
364 "Return the name of the function object FUNCTION.
365
366 The result is either a symbol, a list, or NIL if no function name is available."
367 (declare (ignore function))
368 nil)
369
370 (definterface macroexpand-all (form)
371 "Recursively expand all macros in FORM.
372 Return the resulting form.")
373
374 (definterface describe-symbol-for-emacs (symbol)
375 "Return a property list describing SYMBOL.
376
377 The property list has an entry for each interesting aspect of the
378 symbol. The recognised keys are:
379
380 :VARIABLE :FUNCTION :SETF :TYPE :CLASS :MACRO :COMPILER-MACRO
381 :ALIEN-TYPE :ALIEN-STRUCT :ALIEN-UNION :ALIEN-ENUM
382
383 The value of each property is the corresponding documentation string,
384 or :NOT-DOCUMENTED. It is legal to include keys not listed here.
385
386 Properties should be included if and only if they are applicable to
387 the symbol. For example, only (and all) fbound symbols should include
388 the :FUNCTION property.
389
390 Example:
391 \(describe-symbol-for-emacs 'vector)
392 => (:CLASS :NOT-DOCUMENTED
393 :TYPE :NOT-DOCUMENTED
394 :FUNCTION \"Constructs a simple-vector from the given objects.\")")
395
396 (definterface describe-definition (name type)
397 "Describe the definition NAME of TYPE.
398 TYPE can be any value returned by DESCRIBE-SYMBOL-FOR-EMACS.
399
400 Return a documentation string, or NIL if none is available.")
401
402
403 ;;;; Debugging
404
405 (definterface call-with-debugging-environment (debugger-loop-fn)
406 "Call DEBUGGER-LOOP-FN in a suitable debugging environment.
407
408 This function is called recursively at each debug level to invoke the
409 debugger loop. The purpose is to setup any necessary environment for
410 other debugger callbacks that will be called within the debugger loop.
411
412 For example, this is a reasonable place to compute a backtrace, switch
413 to safe reader/printer settings, and so on.")
414
415 (define-condition sldb-condition (condition)
416 ((original-condition
417 :initarg :original-condition
418 :accessor original-condition))
419 (:report (lambda (condition stream)
420 (format stream "Condition in debugger code~@[: ~A~]"
421 (original-condition condition))))
422 (:documentation
423 "Wrapper for conditions that should not be debugged.
424
425 When a condition arises from the internals of the debugger, it is not
426 desirable to debug it -- we'd risk entering an endless loop trying to
427 debug the debugger! Instead, such conditions can be reported to the
428 user without (re)entering the debugger by wrapping them as
429 `sldb-condition's."))
430
431 (definterface compute-backtrace (start end)
432 "Return a list containing a backtrace of the condition current
433 being debugged. The results are unspecified if this function is
434 called outside the dynamic contour CALL-WITH-DEBUGGING-ENVIRONMENT.
435
436 START and END are zero-based indices constraining the number of frames
437 returned. Frame zero is defined as the frame which invoked the
438 debugger. If END is nil, return the frames from START to the end of
439 the stack.")
440
441 (definterface print-frame (frame stream)
442 "Print frame to stream.")
443
444 (definterface frame-package (frame)
445 "Return the preferred package to use when printing local variables.
446 NIL can be used if no particular package is known."
447 nil)
448
449 (definterface frame-source-location-for-emacs (frame-number)
450 "Return the source location for FRAME-NUMBER.")
451
452 (definterface frame-catch-tags (frame-number)
453 "Return a list of XXX list of what? catch tags for a debugger
454 stack frame. The results are undefined unless this is called
455 within the dynamic contour of a function defined by
456 DEFINE-DEBUGGER-HOOK.")
457
458 (definterface frame-locals (frame-number)
459 "Return a list of XXX local variable designators define me
460 for a debugger stack frame. The results are undefined unless
461 this is called within the dynamic contour of a function defined
462 by DEFINE-DEBUGGER-HOOK.")
463
464 (definterface frame-var-value (frame var)
465 "Return the value of VAR in FRAME.
466 FRAME is the number of the frame in the backtrace.
467 VAR is the number of the variable in the frame.")
468
469 (definterface disassemble-frame (frame-number)
470 "Disassemble the code for the FRAME-NUMBER.
471 The output should be written to standard output.
472 FRAME-NUMBER is a non-negative interger.")
473
474 (definterface eval-in-frame (form frame-number)
475 "Evaluate a Lisp form in the lexical context of a stack frame
476 in the debugger. The results are undefined unless called in the
477 dynamic contour of a function defined by DEFINE-DEBUGGER-HOOK.
478
479 FRAME-NUMBER must be a positive integer with 0 indicating the
480 frame which invoked the debugger.
481
482 The return value is the result of evaulating FORM in the
483 appropriate context.")
484
485 (definterface return-from-frame (frame-number form)
486 "Unwind the stack to the frame FRAME-NUMBER and return the value(s)
487 produced by evaluating FORM in the frame context to its caller.
488
489 Execute any clean-up code from unwind-protect forms above the frame
490 during unwinding.
491
492 Return a string describing the error if it's not possible to return
493 from the frame.")
494
495 (definterface restart-frame (frame-number)
496 "Restart execution of the frame FRAME-NUMBER with the same arguments
497 as it was called originally.")
498
499 (definterface format-sldb-condition (condition)
500 "Format a condition for display in SLDB."
501 (princ-to-string condition))
502
503 (definterface condition-references (condition)
504 "Return a list of documentation references for a condition.
505 Each reference is one of:
506 (:ANSI-CL
507 {:FUNCTION | :SPECIAL-OPERATOR | :MACRO | :SECTION | :GLOSSARY }
508 symbol-or-name)
509 (:SBCL :NODE node-name)"
510 '())
511
512 (definterface condition-extras (condition)
513 "Return a list of extra for the debugger.
514 The allowed elements are of the form:
515 (:SHOW-FRAME-SOURCE frame-number)"
516 '())
517
518 (definterface activate-stepping (frame-number)
519 "Prepare the frame FRAME-NUMBER for stepping.")
520
521 (definterface sldb-break-on-return (frame-number)
522 "Set a breakpoint in the frame FRAME-NUMBER.")
523
524 (definterface sldb-break-at-start (symbol)
525 "Set a breakpoint on the beginning of the function for SYMBOL.")
526
527
528
529 ;;;; Definition finding
530
531 (defstruct (:location (:type list) :named
532 (:constructor make-location
533 (buffer position &optional hints)))
534 buffer position
535 ;; Hints is a property list optionally containing:
536 ;; :snippet SOURCE-TEXT
537 ;; This is a snippet of the actual source text at the start of
538 ;; the definition, which could be used in a text search.
539 hints)
540
541 (defstruct (:error (:type list) :named (:constructor)) message)
542 (defstruct (:file (:type list) :named (:constructor)) name)
543 (defstruct (:buffer (:type list) :named (:constructor)) name)
544 (defstruct (:position (:type list) :named (:constructor)) pos)
545
546 (definterface find-definitions (name)
547 "Return a list ((DSPEC LOCATION) ...) for NAME's definitions.
548
549 NAME is a \"definition specifier\".
550
551 DSPEC is a \"definition specifier\" describing the
552 definition, e.g., FOO or (METHOD FOO (STRING NUMBER)) or
553 \(DEFVAR FOO).
554
555 LOCATION is the source location for the definition.")
556
557 (definterface buffer-first-change (filename)
558 "Called for effect the first time FILENAME's buffer is modified."
559 nil)
560
561
562 ;;;; XREF
563
564 (definterface who-calls (function-name)
565 "Return the call sites of FUNCTION-NAME (a symbol).
566 The results is a list ((DSPEC LOCATION) ...).")
567
568 (definterface who-references (variable-name)
569 "Return the locations where VARIABLE-NAME (a symbol) is referenced.
570 See WHO-CALLS for a description of the return value.")
571
572 (definterface who-binds (variable-name)
573 "Return the locations where VARIABLE-NAME (a symbol) is bound.
574 See WHO-CALLS for a description of the return value.")
575
576 (definterface who-sets (variable-name)
577 "Return the locations where VARIABLE-NAME (a symbol) is set.
578 See WHO-CALLS for a description of the return value.")
579
580 (definterface who-macroexpands (macro-name)
581 "Return the locations where MACRO-NAME (a symbol) is expanded.
582 See WHO-CALLS for a description of the return value.")
583
584 (definterface who-specializes (class-name)
585 "Return the locations where CLASS-NAME (a symbol) is specialized.
586 See WHO-CALLS for a description of the return value.")
587
588 ;;; Simpler variants.
589
590 (definterface list-callers (function-name)
591 "List the callers of FUNCTION-NAME.
592 This function is like WHO-CALLS except that it is expected to use
593 lower-level means. Whereas WHO-CALLS is usually implemented with
594 special compiler support, LIST-CALLERS is usually implemented by
595 groveling for constants in function objects throughout the heap.
596
597 The return value is as for WHO-CALLS.")
598
599 (definterface list-callees (function-name)
600 "List the functions called by FUNCTION-NAME.
601 See LIST-CALLERS for a description of the return value.")
602
603
604 ;;;; Profiling
605
606 ;;; The following functions define a minimal profiling interface.
607
608 (definterface profile (fname)
609 "Marks symbol FNAME for profiling.")
610
611 (definterface profiled-functions ()
612 "Returns a list of profiled functions.")
613
614 (definterface unprofile (fname)
615 "Marks symbol FNAME as not profiled.")
616
617 (definterface unprofile-all ()
618 "Marks all currently profiled functions as not profiled."
619 (dolist (f (profiled-functions))
620 (unprofile f)))
621
622 (definterface profile-report ()
623 "Prints profile report.")
624
625 (definterface profile-reset ()
626 "Resets profile counters.")
627
628 (definterface profile-package (package callers-p methods)
629 "Wrap profiling code around all functions in PACKAGE. If a function
630 is already profiled, then unprofile and reprofile (useful to notice
631 function redefinition.)
632
633 If CALLERS-P is T names have counts of the most common calling
634 functions recorded.
635
636 When called with arguments :METHODS T, profile all methods of all
637 generic functions having names in the given package. Generic functions
638 themselves, that is, their dispatch functions, are left alone.")
639
640
641 ;;;; Inspector
642
643 (defclass inspector ()
644 ()
645 (:documentation "Super class of inspector objects.
646
647 Implementations should sub class in order to dispatch off of the
648 inspect-for-emacs method."))
649
650 (definterface make-default-inspector ()
651 "Return an inspector object suitable for passing to inspect-for-emacs.")
652
653 (definterface inspect-for-emacs (object inspector)
654 "Explain to emacs how to inspect OBJECT.
655
656 The argument INSPECTOR is an object representing how to get at
657 the internals of OBJECT, it is usually an implementation specific
658 class used simply for dispatching to the proper method.
659
660 The orgument INSPECTION-MODE is an object specifying how, and
661 what, to show to the user.
662
663 Returns two values: a string which will be used as the title of
664 the inspector buffer and a list specifying how to render the
665 object for inspection.
666
667 Every elementi of the list must be either a string, which will be
668 inserted into the buffer as is, or a list of the form:
669
670 (:value object &optional format) - Render an inspectable
671 object. If format is provided it must be a string and will be
672 rendered in place of the value, otherwise use princ-to-string.
673
674 (:newline) - Render a \\n
675
676 (:action label lambda) - Render LABEL (a text string) which when
677 clicked will call LAMBDA.
678
679 NIL - do nothing.")
680
681 (defmethod inspect-for-emacs (object inspector)
682 "Generic method for inspecting any kind of object.
683
684 Since we don't know how to deal with OBJECT we simply dump the
685 output of CL:DESCRIBE."
686 (declare (ignore inspector inspection-mode))
687 (values "A value."
688 `("Type: " (:value ,(type-of object))
689 (:newline)
690 "Don't know how to inspect the object, dumping output of CL:DESCIRBE:"
691 (:newline) (:newline)
692 ,(with-output-to-string (desc)
693 (describe object desc)))))
694
695 ;;; Utilities to for inspector methods.
696 ;;;
697 (defun label-value-line (label value)
698 "Create a control list which prints \"LABEL: VALUE\" in the inspector."
699 (list (princ-to-string label) ": " `(:value ,value) '(:newline)))
700
701 (defmacro label-value-line* (&rest label-values)
702 ` (append ,@(loop for (label value) in label-values
703 collect `(label-value-line ,label ,value))))
704
705 (definterface describe-primitive-type (object)
706 "Return a string describing the primitive type of object."
707 (declare (ignore object))
708 "N/A")
709
710
711 ;;;; Multithreading
712 ;;;
713 ;;; The default implementations are sufficient for non-multiprocessing
714 ;;; implementations.
715
716 (definterface startup-multiprocessing ()
717 "Initialize multiprocessing, if necessary.
718
719 This function is called directly through the listener, not in an RPC
720 from Emacs. This is to support interfaces such as CMUCL's
721 MP::STARTUP-IDLE-AND-TOP-LEVEL-LOOPS which does not return like a
722 normal function."
723 nil)
724
725 (definterface spawn (fn &key name)
726 "Create a new thread to call FN.")
727
728 (definterface thread-id (thread)
729 "Return an Emacs-parsable object to identify THREAD.
730
731 Ids should be comparable with equal, i.e.:
732 (equal (thread-id <t1>) (thread-id <t2>)) <==> (eq <t1> <t2>)")
733
734 (definterface find-thread (id)
735 "Return the thread for ID.
736 ID should be an id previously obtained with THREAD-ID.
737 Can return nil if the thread no longer exists.")
738
739 (definterface thread-name (thread)
740 "Return the name of THREAD.
741
742 Thread names are be single-line strings and are meaningful to the
743 user. They do not have to be unique."
744 (declare (ignore thread))
745 "The One True Thread")
746
747 (definterface thread-status (thread)
748 "Return a string describing THREAD's state."
749 (declare (ignore thread))
750 "")
751
752 (definterface make-lock (&key name)
753 "Make a lock for thread synchronization.
754 Only one thread may hold the lock (via CALL-WITH-LOCK-HELD) at a time."
755 (declare (ignore name))
756 :null-lock)
757
758 (definterface call-with-lock-held (lock function)
759 "Call FUNCTION with LOCK held, queueing if necessary."
760 (declare (ignore lock)
761 (type function function))
762 (funcall function))
763
764 (definterface current-thread ()
765 "Return the currently executing thread."
766 0)
767
768 (definterface all-threads ()
769 "Return a list of all threads.")
770
771 (definterface thread-alive-p (thread)
772 "Test if THREAD is termintated."
773 (member thread (all-threads)))
774
775 (definterface interrupt-thread (thread fn)
776 "Cause THREAD to execute FN.")
777
778 (definterface kill-thread (thread)
779 "Kill THREAD."
780 (declare (ignore thread))
781 nil)
782
783 (definterface send (thread object)
784 "Send OBJECT to thread THREAD.")
785
786 (definterface receive ()
787 "Return the next message from current thread's mailbox.")

  ViewVC Help
Powered by ViewVC 1.1.5