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

Contents of /slime/swank-sbcl.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.151 - (show annotations)
Mon Dec 5 23:01:50 2005 UTC (8 years, 4 months ago) by jsnellman
Branch: MAIN
Changes since 1.150: +19 -6 lines
2005-12-06  Juho Snellman <jsnell@iki.fi>
        * swank-sbcl.lisp (function-source-location,
          safe-function-source-location): Oops, define these functions
          also for the >0.9.6 case. Fixes broken sldb-show-source on
          SBCL 0.9.7.
1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
2 ;;;
3 ;;; swank-sbcl.lisp --- SLIME backend for SBCL.
4 ;;;
5 ;;; Created 2003, Daniel Barlow <dan@metacircles.com>
6 ;;;
7 ;;; This code has been placed in the Public Domain. All warranties are
8 ;;; disclaimed.
9
10 ;;; Requires the SB-INTROSPECT contrib.
11
12 ;;; Administrivia
13
14 (in-package :swank-backend)
15
16 (eval-when (:compile-toplevel :load-toplevel :execute)
17 (require 'sb-bsd-sockets)
18 (require 'sb-introspect)
19 (require 'sb-posix))
20
21 (declaim (optimize (debug 2)))
22
23 (import-from :sb-gray *gray-stream-symbols* :swank-backend)
24
25 ;;; swank-mop
26
27 (import-swank-mop-symbols :sb-mop '(:slot-definition-documentation))
28
29 (defun swank-mop:slot-definition-documentation (slot)
30 (sb-pcl::documentation slot t))
31
32 ;;; TCP Server
33
34 (defimplementation preferred-communication-style ()
35 (if (and (member :sb-thread *features*)
36 #+linux
37 (not (sb-alien:extern-alien "linux_no_threads_p" sb-alien:boolean)))
38 :spawn
39 :fd-handler))
40
41 (defun resolve-hostname (name)
42 (car (sb-bsd-sockets:host-ent-addresses
43 (sb-bsd-sockets:get-host-by-name name))))
44
45 (defimplementation create-socket (host port)
46 (let ((socket (make-instance 'sb-bsd-sockets:inet-socket
47 :type :stream
48 :protocol :tcp)))
49 (setf (sb-bsd-sockets:sockopt-reuse-address socket) t)
50 (sb-bsd-sockets:socket-bind socket (resolve-hostname host) port)
51 (sb-bsd-sockets:socket-listen socket 5)
52 socket))
53
54 (defimplementation local-port (socket)
55 (nth-value 1 (sb-bsd-sockets:socket-name socket)))
56
57 (defimplementation close-socket (socket)
58 (sb-sys:invalidate-descriptor (socket-fd socket))
59 (sb-bsd-sockets:socket-close socket))
60
61 (defimplementation accept-connection (socket &key
62 (external-format :iso-latin-1-unix)
63 (buffering :full))
64 (make-socket-io-stream (accept socket) external-format buffering))
65
66 (defvar *sigio-handlers* '()
67 "List of (key . fn) pairs to be called on SIGIO.")
68
69 (defun sigio-handler (signal code scp)
70 (declare (ignore signal code scp))
71 (mapc (lambda (handler)
72 (funcall (the function (cdr handler))))
73 *sigio-handlers*))
74
75 (defun set-sigio-handler ()
76 (sb-sys:enable-interrupt sb-unix:sigio (lambda (signal code scp)
77 (sigio-handler signal code scp))))
78
79 (defun enable-sigio-on-fd (fd)
80 (sb-posix::fcntl fd sb-posix::f-setfl sb-posix::o-async)
81 (sb-posix::fcntl fd sb-posix::f-setown (getpid)))
82
83 (defimplementation add-sigio-handler (socket fn)
84 (set-sigio-handler)
85 (let ((fd (socket-fd socket)))
86 (format *debug-io* "Adding sigio handler: ~S ~%" fd)
87 (enable-sigio-on-fd fd)
88 (push (cons fd fn) *sigio-handlers*)))
89
90 (defimplementation remove-sigio-handlers (socket)
91 (let ((fd (socket-fd socket)))
92 (setf *sigio-handlers* (delete fd *sigio-handlers* :key #'car))
93 (sb-sys:invalidate-descriptor fd))
94 (close socket))
95
96 (defimplementation add-fd-handler (socket fn)
97 (declare (type function fn))
98 (let ((fd (socket-fd socket)))
99 (format *debug-io* "; Adding fd handler: ~S ~%" fd)
100 (sb-sys:add-fd-handler fd :input (lambda (_)
101 _
102 (funcall fn)))))
103
104 (defimplementation remove-fd-handlers (socket)
105 (sb-sys:invalidate-descriptor (socket-fd socket)))
106
107 (defun socket-fd (socket)
108 (etypecase socket
109 (fixnum socket)
110 (sb-bsd-sockets:socket (sb-bsd-sockets:socket-file-descriptor socket))
111 (file-stream (sb-sys:fd-stream-fd socket))))
112
113 (defun find-external-format (coding-system)
114 (ecase coding-system
115 (:iso-latin-1-unix :iso-8859-1)
116 (:utf-8-unix :utf-8)
117 (:euc-jp-unix :euc-jp)))
118
119 (defun make-socket-io-stream (socket external-format buffering)
120 (let ((ef (find-external-format external-format)))
121 (sb-bsd-sockets:socket-make-stream socket
122 :output t
123 :input t
124 :element-type 'character
125 :buffering buffering
126 #+sb-unicode :external-format
127 #+sb-unicode ef
128 )))
129
130 (defun accept (socket)
131 "Like socket-accept, but retry on EAGAIN."
132 (loop (handler-case
133 (return (sb-bsd-sockets:socket-accept socket))
134 (sb-bsd-sockets:interrupted-error ()))))
135
136 (defmethod call-without-interrupts (fn)
137 (declare (type function fn))
138 (sb-sys:without-interrupts (funcall fn)))
139
140 (defimplementation getpid ()
141 (sb-posix:getpid))
142
143 (defimplementation lisp-implementation-type-name ()
144 "sbcl")
145
146
147 ;;;; Support for SBCL syntax
148
149 ;;; SBCL's source code is riddled with #! reader macros. Also symbols
150 ;;; containing `!' have special meaning. We have to work long and
151 ;;; hard to be able to read the source. To deal with #! reader
152 ;;; macros, we use a special readtable. The special symbols are
153 ;;; converted by a condition handler.
154
155 (defun feature-in-list-p (feature list)
156 (etypecase feature
157 (symbol (member feature list :test #'eq))
158 (cons (flet ((subfeature-in-list-p (subfeature)
159 (feature-in-list-p subfeature list)))
160 (ecase (first feature)
161 (:or (some #'subfeature-in-list-p (rest feature)))
162 (:and (every #'subfeature-in-list-p (rest feature)))
163 (:not (destructuring-bind (e) (cdr feature)
164 (not (subfeature-in-list-p e)))))))))
165
166 (defun shebang-reader (stream sub-character infix-parameter)
167 (declare (ignore sub-character))
168 (when infix-parameter
169 (error "illegal read syntax: #~D!" infix-parameter))
170 (let ((next-char (read-char stream)))
171 (unless (find next-char "+-")
172 (error "illegal read syntax: #!~C" next-char))
173 ;; When test is not satisfied
174 ;; FIXME: clearer if order of NOT-P and (NOT NOT-P) were reversed? then
175 ;; would become "unless test is satisfied"..
176 (when (let* ((*package* (find-package "KEYWORD"))
177 (*read-suppress* nil)
178 (not-p (char= next-char #\-))
179 (feature (read stream)))
180 (if (feature-in-list-p feature *features*)
181 not-p
182 (not not-p)))
183 ;; Read (and discard) a form from input.
184 (let ((*read-suppress* t))
185 (read stream t nil t))))
186 (values))
187
188 (defvar *shebang-readtable*
189 (let ((*readtable* (copy-readtable nil)))
190 (set-dispatch-macro-character #\# #\!
191 (lambda (s c n) (shebang-reader s c n))
192 *readtable*)
193 *readtable*))
194
195 (defun shebang-readtable ()
196 *shebang-readtable*)
197
198 (defun sbcl-package-p (package)
199 (let ((name (package-name package)))
200 (eql (mismatch "SB-" name) 3)))
201
202 (defun sbcl-source-file-p (filename)
203 (loop for (_ pattern) in (logical-pathname-translations "SYS")
204 thereis (pathname-match-p filename pattern)))
205
206 (defun guess-readtable-for-filename (filename)
207 (if (sbcl-source-file-p filename)
208 (shebang-readtable)
209 *readtable*))
210
211 (defvar *debootstrap-packages* t)
212
213 (defun call-with-debootstrapping (fun)
214 (handler-bind ((sb-int:bootstrap-package-not-found
215 #'sb-int:debootstrap-package))
216 (funcall fun)))
217
218 (defmacro with-debootstrapping (&body body)
219 `(call-with-debootstrapping (lambda () ,@body)))
220
221 (defimplementation call-with-syntax-hooks (fn)
222 (cond ((and *debootstrap-packages*
223 (sbcl-package-p *package*))
224 (with-debootstrapping (funcall fn)))
225 (t
226 (funcall fn))))
227
228 (defimplementation default-readtable-alist ()
229 (let ((readtable (shebang-readtable)))
230 (loop for p in (remove-if-not #'sbcl-package-p (list-all-packages))
231 collect (cons (package-name p) readtable))))
232
233 ;;; Utilities
234
235 (defimplementation arglist ((fname t))
236 (sb-introspect:function-arglist fname))
237
238 (defimplementation function-name ((f function))
239 (sb-impl::%fun-name f))
240
241 (defvar *buffer-name* nil)
242 (defvar *buffer-offset*)
243 (defvar *buffer-substring* nil)
244
245 (defvar *previous-compiler-condition* nil
246 "Used to detect duplicates.")
247
248 (defun handle-notification-condition (condition)
249 "Handle a condition caused by a compiler warning.
250 This traps all compiler conditions at a lower-level than using
251 C:*COMPILER-NOTIFICATION-FUNCTION*. The advantage is that we get to
252 craft our own error messages, which can omit a lot of redundant
253 information."
254 (let ((context (sb-c::find-error-context nil)))
255 (unless (eq condition *previous-compiler-condition*)
256 (setq *previous-compiler-condition* condition)
257 (signal-compiler-condition condition context))))
258
259 (defun signal-compiler-condition (condition context)
260 (signal (make-condition
261 'compiler-condition
262 :original-condition condition
263 :severity (etypecase condition
264 (sb-c:compiler-error :error)
265 (sb-ext:compiler-note :note)
266 (style-warning :style-warning)
267 (warning :warning)
268 (error :error))
269 :short-message (brief-compiler-message-for-emacs condition)
270 :references (condition-references (real-condition condition))
271 :message (long-compiler-message-for-emacs condition context)
272 :location (compiler-note-location context))))
273
274 (defun real-condition (condition)
275 "Return the encapsulated condition or CONDITION itself."
276 (typecase condition
277 (sb-int:encapsulated-condition (sb-int:encapsulated-condition condition))
278 (t condition)))
279
280 (defun compiler-note-location (context)
281 (if context
282 (locate-compiler-note
283 (sb-c::compiler-error-context-file-name context)
284 (compiler-source-path context)
285 (sb-c::compiler-error-context-original-source context))
286 (list :error "No error location available")))
287
288 (defun locate-compiler-note (file source-path source)
289 (cond ((and (eq file :lisp)
290 *buffer-name*)
291 ;; Compiling from a buffer
292 (let ((position (+ *buffer-offset*
293 (source-path-string-position
294 (cons 0 (nthcdr 2 source-path))
295 *buffer-substring*))))
296 (make-location (list :buffer *buffer-name*)
297 (list :position position))))
298 ((and (pathnamep file) (null *buffer-name*))
299 ;; Compiling from a file
300 (make-location (list :file (namestring file))
301 (list :position
302 (1+ (source-path-file-position
303 source-path file)))))
304 ((and (eq file :lisp) (stringp source))
305 ;; Compiling macro generated code
306 (make-location (list :source-form source)
307 (list :position 1)))
308 (t
309 (error "unhandled case"))))
310
311 (defun brief-compiler-message-for-emacs (condition)
312 "Briefly describe a compiler error for Emacs.
313 When Emacs presents the message it already has the source popped up
314 and the source form highlighted. This makes much of the information in
315 the error-context redundant."
316 (let ((sb-int:*print-condition-references* nil))
317 (princ-to-string condition)))
318
319 (defun long-compiler-message-for-emacs (condition error-context)
320 "Describe a compiler error for Emacs including context information."
321 (declare (type (or sb-c::compiler-error-context null) error-context))
322 (multiple-value-bind (enclosing source)
323 (if error-context
324 (values (sb-c::compiler-error-context-enclosing-source error-context)
325 (sb-c::compiler-error-context-source error-context)))
326 (let ((sb-int:*print-condition-references* nil))
327 (format nil "~@[--> ~{~<~%--> ~1:;~A~> ~}~%~]~@[~{==>~%~A~%~}~]~A"
328 enclosing source condition))))
329
330 (defun compiler-source-path (context)
331 "Return the source-path for the current compiler error.
332 Returns NIL if this cannot be determined by examining internal
333 compiler state."
334 (cond ((sb-c::node-p context)
335 (reverse
336 (sb-c::source-path-original-source
337 (sb-c::node-source-path context))))
338 ((sb-c::compiler-error-context-p context)
339 (reverse
340 (sb-c::compiler-error-context-original-source-path context)))))
341
342 (defimplementation call-with-compilation-hooks (function)
343 (declare (type function function))
344 (handler-bind ((sb-c:fatal-compiler-error #'handle-file-compiler-termination)
345 (sb-c:compiler-error #'handle-notification-condition)
346 (sb-ext:compiler-note #'handle-notification-condition)
347 (style-warning #'handle-notification-condition)
348 (warning #'handle-notification-condition))
349 (funcall function)))
350
351 (defun handle-file-compiler-termination (condition)
352 "Handle a condition that caused the file compiler to terminate."
353 (handle-notification-condition
354 (sb-int:encapsulated-condition condition)))
355
356 (defvar *trap-load-time-warnings* nil)
357
358 (defimplementation swank-compile-file (filename load-p
359 &optional external-format)
360 (let ((ef (if external-format
361 (find-external-format external-format)
362 :default)))
363 (handler-case
364 (let ((output-file (with-compilation-hooks ()
365 (compile-file filename :external-format ef))))
366 (when output-file
367 ;; Cache the latest source file for definition-finding.
368 (source-cache-get filename (file-write-date filename))
369 (when load-p
370 (load output-file))))
371 (sb-c:fatal-compiler-error () nil))))
372
373 ;;;; compile-string
374
375 (defimplementation swank-compile-string (string &key buffer position directory)
376 (declare (ignore directory))
377 (flet ((compileit (cont)
378 (let ((*buffer-name* buffer)
379 (*buffer-offset* position)
380 (*buffer-substring* string))
381 (with-compilation-hooks ()
382 (with-compilation-unit (:source-plist
383 (list :emacs-buffer buffer
384 :emacs-string string
385 :emacs-position position))
386 (funcall cont (compile nil
387 `(lambda ()
388 ,(read-from-string string)))))))))
389 (if *trap-load-time-warnings*
390 (compileit #'funcall)
391 (funcall (compileit #'identity)))))
392
393
394 ;;;; Definitions
395
396 (defvar *debug-definition-finding* nil
397 "When true don't handle errors while looking for definitions.
398 This is useful when debugging the definition-finding code.")
399
400 ;;; As of SBCL 0.9.7 most of the gritty details of source location handling
401 ;;; are supported reasonably well by SB-INTROSPECT.
402
403 (eval-when (:compile-toplevel :load-toplevel :execute)
404 (defun new-definition-source-p ()
405 (if (find-symbol "FIND-DEFINITION-SOURCES-BY-NAME" "SB-INTROSPECT")
406 '(and)
407 '(or))))
408
409 ;;; SBCL > 0.9.6
410 #+#.(swank-backend::new-definition-source-p)
411 (progn
412
413 (defparameter *definition-types*
414 '(:variable defvar
415 :constant defconstant
416 :type deftype
417 :symbol-macro define-symbol-macro
418 :macro defmacro
419 :compiler-macro define-compiler-macro
420 :function defun
421 :generic-function defgeneric
422 :method defmethod
423 :setf-expander define-setf-expander
424 :structure defstruct
425 :condition defcondition
426 :class defclass
427 :method-combination define-method-combination
428 :package defpackage
429 :transform :deftransform
430 :optimizer :defoptimizer
431 :vop :define-vop
432 :source-transform :define-source-transform)
433 "Map SB-INTROSPECT definition type names to Slime-friendly forms")
434
435 (defimplementation find-definitions (name)
436 (loop for type in *definition-types* by #'cddr
437 for locations = (sb-introspect:find-definition-sources-by-name
438 name type)
439 append (loop for source-location in locations collect
440 (make-source-location-specification type name
441 source-location))))
442
443 (defun make-source-location-specification (type name source-location)
444 (list (list* (getf *definition-types* type)
445 name
446 (sb-introspect::definition-source-description source-location))
447 (if *debug-definition-finding*
448 (make-definition-source-location source-location type name)
449 (handler-case (make-definition-source-location source-location
450 type name)
451 (error (e)
452 (list :error (format nil "Error: ~A" e)))))))
453
454 (defun make-definition-source-location (definition-source type name)
455 (with-struct (sb-introspect::definition-source-
456 pathname form-path character-offset plist
457 file-write-date)
458 definition-source
459 (destructuring-bind (&key emacs-buffer emacs-position
460 emacs-string &allow-other-keys)
461 plist
462 (cond
463 (emacs-buffer
464 (let ((pos (if form-path
465 (with-debootstrapping
466 (source-path-string-position
467 form-path emacs-string))
468 character-offset)))
469 (make-location `(:buffer ,emacs-buffer)
470 `(:position ,(+ pos emacs-position))
471 `(:snippet ,emacs-string))))
472 ((not pathname)
473 `(:error ,(format nil "Source of ~A ~A not found"
474 (string-downcase type) name)))
475 (t
476 (let* ((namestring (namestring (translate-logical-pathname pathname)))
477 (*readtable* (guess-readtable-for-filename namestring))
478 (pos (1+ (with-debootstrapping
479 ;; Some internal functions have no source path
480 ;; or offset available, just the file (why?).
481 ;; In these cases we can at least try to open
482 ;; the right file.
483 (if form-path
484 (source-path-file-position form-path
485 pathname)
486 0))))
487 (snippet (source-hint-snippet namestring
488 file-write-date pos)))
489 (make-location `(:file ,namestring)
490 `(:position ,pos)
491 `(:snippet ,snippet))))))))
492
493 (defun source-hint-snippet (filename write-date position)
494 (let ((source (get-source-code filename write-date)))
495 (with-input-from-string (s source)
496 (read-snippet s position))))
497
498 (defun function-source-location (function &optional name)
499 (declare (type function function))
500 (let ((location (sb-introspect:find-definition-source function)))
501 (make-definition-source-location location :function name)))
502
503 (defun safe-function-source-location (fun name)
504 (if *debug-definition-finding*
505 (function-source-location fun name)
506 (handler-case (function-source-location fun name)
507 (error (e)
508 (list :error (format nil "Error: ~A" e))))))
509 ) ;; End >0.9.6
510
511 ;;; Support for SBCL 0.9.6 and earlier. Feel free to delete this
512 ;;; after January 2006.
513 #-#.(swank-backend::new-definition-source-p)
514 (progn
515 (defimplementation find-definitions (name)
516 (append (function-definitions name)
517 (compiler-definitions name)))
518
519 ;;;;; Function definitions
520
521 (defun function-definitions (name)
522 (flet ((loc (fn name) (safe-function-source-location fn name)))
523 (append
524 (cond ((and (symbolp name) (macro-function name))
525 (list (list `(defmacro ,name)
526 (loc (macro-function name) name))))
527 ((fboundp name)
528 (let ((fn (fdefinition name)))
529 (typecase fn
530 (generic-function
531 (cons (list `(defgeneric ,name) (loc fn name))
532 (method-definitions fn)))
533 (t
534 (list (list `(function ,name) (loc fn name))))))))
535 (when (compiler-macro-function name)
536 (list (list `(define-compiler-macro ,name)
537 (loc (compiler-macro-function name) name)))))))
538
539 ;;;; function -> soucre location translation
540
541 ;;; Here we try to find the source locations for function objects. We
542 ;;; have to special case functions which were compiled with C-c C-c.
543 ;;; For the other functions we used the toplevel form number as
544 ;;; returned by the sb-introspect package to find the offset in the
545 ;;; source file. (If the function has debug-blocks, we should search
546 ;;; the position of the first code-location; for some reason, that
547 ;;; doesn't seem to work.)
548
549 (defun function-source-location (function &optional name)
550 "Try to find the canonical source location of FUNCTION."
551 (declare (type function function)
552 (ignore name))
553 (find-function-source-location function))
554
555 (defun safe-function-source-location (fun name)
556 (if *debug-definition-finding*
557 (function-source-location fun name)
558 (handler-case (function-source-location fun name)
559 (error (e)
560 (list :error (format nil "Error: ~A" e))))))
561
562 (defun find-function-source-location (function)
563 (with-struct (sb-introspect::definition-source- form-path character-offset plist)
564 (sb-introspect:find-definition-source function)
565 (destructuring-bind (&key emacs-buffer emacs-position emacs-string) plist
566 (if emacs-buffer
567 (let ((pos (if form-path
568 (with-debootstrapping
569 (source-path-string-position
570 form-path emacs-string))
571 character-offset)))
572 (make-location `(:buffer ,emacs-buffer)
573 `(:position ,(+ pos emacs-position))
574 `(:snippet ,emacs-string)))
575 (cond #+(or)
576 ;; doesn't work for unknown reasons
577 ((function-has-start-location-p function)
578 (code-location-source-location (function-start-location function)))
579 ((not (function-source-filename function))
580 (error "Source filename not recorded for ~A" function))
581 (t
582 (let* ((pos (function-source-position function))
583 (snippet (function-hint-snippet function pos)))
584 (make-location `(:file ,(function-source-filename function))
585 `(:position ,pos)
586 `(:snippet ,snippet)))))))))
587
588 (defun function-source-position (function)
589 ;; We only consider the toplevel form number here.
590 (let* ((tlf (function-toplevel-form-number function))
591 (filename (function-source-filename function))
592 (*readtable* (guess-readtable-for-filename filename)))
593 (with-debootstrapping
594 (source-path-file-position (list tlf) filename))))
595
596 (defun function-source-filename (function)
597 (ignore-errors
598 (namestring
599 (truename
600 (sb-introspect:definition-source-pathname
601 (sb-introspect:find-definition-source function))))))
602
603 (defun function-source-write-date (function)
604 (sb-introspect:definition-source-file-write-date
605 (sb-introspect:find-definition-source function)))
606
607 (defun function-toplevel-form-number (function)
608 (car
609 (sb-introspect:definition-source-form-path
610 (sb-introspect:find-definition-source function))))
611
612 (defun function-hint-snippet (function position)
613 (let ((source (get-source-code (function-source-filename function)
614 (function-source-write-date function))))
615 (with-input-from-string (s source)
616 (read-snippet s position))))
617
618 (defun function-has-start-location-p (function)
619 (ignore-errors (function-start-location function)))
620
621 (defun function-start-location (function)
622 (let ((dfun (sb-di:fun-debug-fun function)))
623 (and dfun (sb-di:debug-fun-start-location dfun))))
624
625 (defun method-definitions (gf)
626 (let ((methods (sb-mop:generic-function-methods gf))
627 (name (sb-mop:generic-function-name gf)))
628 (loop for method in methods
629 collect (list `(method ,name ,@(method-qualifiers method)
630 ,(sb-pcl::unparse-specializers method))
631 (method-source-location method)))))
632
633 (defun method-source-location (method)
634 (safe-function-source-location (or (sb-pcl::method-fast-function method)
635 (sb-pcl:method-function method))
636 nil))
637
638 ;;;;; Compiler definitions
639
640 (defun compiler-definitions (name)
641 (let ((fun-info (sb-int:info :function :info name)))
642 (when fun-info
643 (append (transform-definitions fun-info name)
644 (optimizer-definitions fun-info name)))))
645
646 (defun transform-definitions (fun-info name)
647 (loop for xform in (sb-c::fun-info-transforms fun-info)
648 for loc = (safe-function-source-location
649 (sb-c::transform-function xform) name)
650 for typespec = (sb-kernel:type-specifier (sb-c::transform-type xform))
651 for note = (sb-c::transform-note xform)
652 for spec = (if (consp typespec)
653 `(sb-c:deftransform ,(second typespec) ,note)
654 `(sb-c:deftransform ,note))
655 collect `(,spec ,loc)))
656
657 (defun optimizer-definitions (fun-info fun-name)
658 (let ((otypes '((sb-c::fun-info-derive-type . sb-c:derive-type)
659 (sb-c::fun-info-ltn-annotate . sb-c:ltn-annotate)
660 (sb-c::fun-info-ltn-annotate . sb-c:ltn-annotate)
661 (sb-c::fun-info-optimizer . sb-c:optimizer))))
662 (loop for (reader . name) in otypes
663 for fn = (funcall reader fun-info)
664 when fn collect `((sb-c:defoptimizer ,name)
665 ,(safe-function-source-location fn fun-name)))))
666 ) ;; End SBCL <= 0.9.6 compability
667
668 (defimplementation describe-symbol-for-emacs (symbol)
669 "Return a plist describing SYMBOL.
670 Return NIL if the symbol is unbound."
671 (let ((result '()))
672 (flet ((doc (kind)
673 (or (documentation symbol kind) :not-documented))
674 (maybe-push (property value)
675 (when value
676 (setf result (list* property value result)))))
677 (maybe-push
678 :variable (multiple-value-bind (kind recorded-p)
679 (sb-int:info :variable :kind symbol)
680 (declare (ignore kind))
681 (if (or (boundp symbol) recorded-p)
682 (doc 'variable))))
683 (when (fboundp symbol)
684 (maybe-push
685 (cond ((macro-function symbol) :macro)
686 ((special-operator-p symbol) :special-operator)
687 ((typep (fdefinition symbol) 'generic-function)
688 :generic-function)
689 (t :function))
690 (doc 'function)))
691 (maybe-push
692 :setf (if (or (sb-int:info :setf :inverse symbol)
693 (sb-int:info :setf :expander symbol))
694 (doc 'setf)))
695 (maybe-push
696 :type (if (sb-int:info :type :kind symbol)
697 (doc 'type)))
698 result)))
699
700 (defimplementation describe-definition (symbol type)
701 (case type
702 (:variable
703 (describe symbol))
704 (:function
705 (describe (symbol-function symbol)))
706 (:setf
707 (describe (or (sb-int:info :setf :inverse symbol)
708 (sb-int:info :setf :expander symbol))))
709 (:class
710 (describe (find-class symbol)))
711 (:type
712 (describe (sb-kernel:values-specifier-type symbol)))))
713
714 (defimplementation list-callers (symbol)
715 (let ((fn (fdefinition symbol)))
716 (mapcar #'function-dspec (sb-introspect:find-function-callers fn))))
717
718 (defimplementation list-callees (symbol)
719 (let ((fn (fdefinition symbol)))
720 (mapcar #'function-dspec (sb-introspect:find-function-callees fn))))
721
722 (defun function-dspec (fn)
723 "Describe where the function FN was defined.
724 Return a list of the form (NAME LOCATION)."
725 (let ((name (sb-kernel:%fun-name fn)))
726 (list name (safe-function-source-location fn name))))
727
728 ;;; macroexpansion
729
730 (defimplementation macroexpand-all (form)
731 (let ((sb-walker:*walk-form-expand-macros-p* t))
732 (sb-walker:walk-form form)))
733
734
735 ;;; Debugging
736
737 (defvar *sldb-stack-top*)
738
739 (defimplementation install-debugger-globally (function)
740 (setq sb-ext:*invoke-debugger-hook* function)
741 (setq *debugger-hook* function))
742
743 (defimplementation call-with-debugging-environment (debugger-loop-fn)
744 (declare (type function debugger-loop-fn))
745 (let* ((*sldb-stack-top* (or sb-debug:*stack-top-hint* (sb-di:top-frame)))
746 (sb-debug:*stack-top-hint* nil))
747 (handler-bind ((sb-di:debug-condition
748 (lambda (condition)
749 (signal (make-condition
750 'sldb-condition
751 :original-condition condition)))))
752 (funcall debugger-loop-fn))))
753
754 (defimplementation call-with-debugger-hook (hook fun)
755 (let ((sb-ext:*invoke-debugger-hook* hook))
756 (funcall fun)))
757
758 (defun nth-frame (index)
759 (do ((frame *sldb-stack-top* (sb-di:frame-down frame))
760 (i index (1- i)))
761 ((zerop i) frame)))
762
763 (defimplementation compute-backtrace (start end)
764 "Return a list of frames starting with frame number START and
765 continuing to frame number END or, if END is nil, the last frame on the
766 stack."
767 (let ((end (or end most-positive-fixnum)))
768 (loop for f = (nth-frame start) then (sb-di:frame-down f)
769 for i from start below end
770 while f
771 collect f)))
772
773 (defimplementation print-frame (frame stream)
774 (sb-debug::print-frame-call frame stream))
775
776 ;;;; Code-location -> source-location translation
777
778 ;;; If debug-block info is avaibale, we determine the file position of
779 ;;; the source-path for a code-location. If the code was compiled
780 ;;; with C-c C-c, we have to search the position in the source string.
781 ;;; If there's no debug-block info, we return the (less precise)
782 ;;; source-location of the corresponding function.
783
784 (defun code-location-source-location (code-location)
785 (let* ((dsource (sb-di:code-location-debug-source code-location))
786 (plist (sb-c::debug-source-plist dsource)))
787 (if (getf plist :emacs-buffer)
788 (emacs-buffer-source-location code-location plist)
789 (ecase (sb-di:debug-source-from dsource)
790 (:file (file-source-location code-location))
791 (:lisp (lisp-source-location code-location))))))
792
793 ;;; FIXME: The naming policy of source-location functions is a bit
794 ;;; fuzzy: we have FUNCTION-SOURCE-LOCATION which returns the
795 ;;; source-location for a function, and we also have FILE-SOURCE-LOCATION &co
796 ;;; which returns the source location for a _code-location_.
797 ;;;
798 ;;; Maybe these should be named code-location-file-source-location,
799 ;;; etc, turned into generic functions, or something. In the very
800 ;;; least the names should indicate the main entry point vs. helper
801 ;;; status.
802
803 (defun file-source-location (code-location)
804 (if (code-location-has-debug-block-info-p code-location)
805 (source-file-source-location code-location)
806 (fallback-source-location code-location)))
807
808 (defun fallback-source-location (code-location)
809 (let ((fun (code-location-debug-fun-fun code-location)))
810 (cond (fun (function-source-location fun))
811 (t (error "Cannot find source location for: ~A " code-location)))))
812
813 (defun lisp-source-location (code-location)
814 (let ((source (prin1-to-string
815 (sb-debug::code-location-source-form code-location 100))))
816 (make-location `(:source-form ,source) '(:position 0))))
817
818 (defun emacs-buffer-source-location (code-location plist)
819 (if (code-location-has-debug-block-info-p code-location)
820 (destructuring-bind (&key emacs-buffer emacs-position emacs-string) plist
821 (let* ((pos (string-source-position code-location emacs-string))
822 (snipped (with-input-from-string (s emacs-string)
823 (read-snippet s pos))))
824 (make-location `(:buffer ,emacs-buffer)
825 `(:position ,(+ emacs-position pos))
826 `(:snippet ,snipped))))
827 (fallback-source-location code-location)))
828
829 (defun source-file-source-location (code-location)
830 (let* ((code-date (code-location-debug-source-created code-location))
831 (filename (code-location-debug-source-name code-location))
832 (source-code (get-source-code filename code-date)))
833 (with-input-from-string (s source-code)
834 (let* ((pos (stream-source-position code-location s))
835 (snippet (read-snippet s pos)))
836 (make-location `(:file ,filename)
837 `(:position ,(1+ pos))
838 `(:snippet ,snippet))))))
839
840 (defun code-location-debug-source-name (code-location)
841 (sb-c::debug-source-name (sb-di::code-location-debug-source code-location)))
842
843 (defun code-location-debug-source-created (code-location)
844 (sb-c::debug-source-created
845 (sb-di::code-location-debug-source code-location)))
846
847 (defun code-location-debug-fun-fun (code-location)
848 (sb-di:debug-fun-fun (sb-di:code-location-debug-fun code-location)))
849
850 (defun code-location-has-debug-block-info-p (code-location)
851 (handler-case
852 (progn (sb-di:code-location-debug-block code-location)
853 t)
854 (sb-di:no-debug-blocks () nil)))
855
856 (defun stream-source-position (code-location stream)
857 (let* ((cloc (sb-debug::maybe-block-start-location code-location))
858 (tlf-number (sb-di::code-location-toplevel-form-offset cloc))
859 (form-number (sb-di::code-location-form-number cloc)))
860 (multiple-value-bind (tlf pos-map) (read-source-form tlf-number stream)
861 (let* ((path-table (sb-di::form-number-translations tlf 0))
862 (path (cond ((<= (length path-table) form-number)
863 (warn "inconsistent form-number-translations")
864 (list 0))
865 (t
866 (reverse (cdr (aref path-table form-number)))))))
867 (source-path-source-position path tlf pos-map)))))
868
869 (defun string-source-position (code-location string)
870 (with-input-from-string (s string)
871 (stream-source-position code-location s)))
872
873 ;;; source-path-file-position and friends are in swank-source-path-parser
874
875 (defun safe-source-location-for-emacs (code-location)
876 (if *debug-definition-finding*
877 (code-location-source-location code-location)
878 (handler-case (code-location-source-location code-location)
879 (error (c) (list :error (format nil "~A" c))))))
880
881 (defimplementation frame-source-location-for-emacs (index)
882 (safe-source-location-for-emacs
883 (sb-di:frame-code-location (nth-frame index))))
884
885 (defun frame-debug-vars (frame)
886 "Return a vector of debug-variables in frame."
887 (sb-di::debug-fun-debug-vars (sb-di:frame-debug-fun frame)))
888
889 (defun debug-var-value (var frame location)
890 (ecase (sb-di:debug-var-validity var location)
891 (:valid (sb-di:debug-var-value var frame))
892 ((:invalid :unknown) ':<not-available>)))
893
894 (defimplementation frame-locals (index)
895 (let* ((frame (nth-frame index))
896 (loc (sb-di:frame-code-location frame))
897 (vars (frame-debug-vars frame)))
898 (loop for v across vars collect
899 (list :name (sb-di:debug-var-symbol v)
900 :id (sb-di:debug-var-id v)
901 :value (debug-var-value v frame loc)))))
902
903 (defimplementation frame-var-value (frame var)
904 (let* ((frame (nth-frame frame))
905 (dvar (aref (frame-debug-vars frame) var)))
906 (debug-var-value dvar frame (sb-di:frame-code-location frame))))
907
908 (defimplementation frame-catch-tags (index)
909 (mapcar #'car (sb-di:frame-catches (nth-frame index))))
910
911 (defimplementation eval-in-frame (form index)
912 (let ((frame (nth-frame index)))
913 (funcall (the function
914 (sb-di:preprocess-for-eval form
915 (sb-di:frame-code-location frame)))
916 frame)))
917
918 (defun sb-debug-catch-tag-p (tag)
919 (and (symbolp tag)
920 (not (symbol-package tag))
921 (string= tag :sb-debug-catch-tag)))
922
923 (defimplementation return-from-frame (index form)
924 (let* ((frame (nth-frame index))
925 (probe (assoc-if #'sb-debug-catch-tag-p
926 (sb-di::frame-catches frame))))
927 (cond (probe (throw (car probe) (eval-in-frame form index)))
928 (t (format nil "Cannot return from frame: ~S" frame)))))
929
930 ;;;;; reference-conditions
931
932 (defimplementation format-sldb-condition (condition)
933 (let ((sb-int:*print-condition-references* nil))
934 (princ-to-string condition)))
935
936 (defimplementation condition-references (condition)
937 (if (typep condition 'sb-int:reference-condition)
938 (sb-int:reference-condition-references condition)
939 '()))
940
941
942 ;;;; Profiling
943
944 (defimplementation profile (fname)
945 (when fname (eval `(sb-profile:profile ,fname))))
946
947 (defimplementation unprofile (fname)
948 (when fname (eval `(sb-profile:unprofile ,fname))))
949
950 (defimplementation unprofile-all ()
951 (sb-profile:unprofile)
952 "All functions unprofiled.")
953
954 (defimplementation profile-report ()
955 (sb-profile:report))
956
957 (defimplementation profile-reset ()
958 (sb-profile:reset)
959 "Reset profiling counters.")
960
961 (defimplementation profiled-functions ()
962 (sb-profile:profile))
963
964 (defimplementation profile-package (package callers methods)
965 (declare (ignore callers methods))
966 (eval `(sb-profile:profile ,(package-name (find-package package)))))
967
968
969 ;;;; Inspector
970
971 (defclass sbcl-inspector (inspector)
972 ())
973
974 (defimplementation make-default-inspector ()
975 (make-instance 'sbcl-inspector))
976
977 (defmethod inspect-for-emacs ((o t) (inspector sbcl-inspector))
978 (declare (ignore inspector))
979 (cond ((sb-di::indirect-value-cell-p o)
980 (values "A value cell." (label-value-line*
981 (:value (sb-kernel:value-cell-ref o)))))
982 (t
983 (multiple-value-bind (text label parts) (sb-impl::inspected-parts o)
984 (if label
985 (values text (loop for (l . v) in parts
986 append (label-value-line l v)))
987 (values text (loop for value in parts for i from 0
988 append (label-value-line i value))))))))
989
990 (defmethod inspect-for-emacs ((o function) (inspector sbcl-inspector))
991 (declare (ignore inspector))
992 (let ((header (sb-kernel:widetag-of o)))
993 (cond ((= header sb-vm:simple-fun-header-widetag)
994 (values "A simple-fun."
995 (label-value-line*
996 (:name (sb-kernel:%simple-fun-name o))
997 (:arglist (sb-kernel:%simple-fun-arglist o))
998 (:self (sb-kernel:%simple-fun-self o))
999 (:next (sb-kernel:%simple-fun-next o))
1000 (:type (sb-kernel:%simple-fun-type o))
1001 (:code (sb-kernel:fun-code-header o)))))
1002 ((= header sb-vm:closure-header-widetag)
1003 (values "A closure."
1004 (append
1005 (label-value-line :function (sb-kernel:%closure-fun o))
1006 `("Closed over values:" (:newline))
1007 (loop for i below (1- (sb-kernel:get-closure-length o))
1008 append (label-value-line
1009 i (sb-kernel:%closure-index-ref o i))))))
1010 (t (call-next-method o)))))
1011
1012 (defmethod inspect-for-emacs ((o sb-kernel:code-component) (_ sbcl-inspector))
1013 (declare (ignore _))
1014 (values (format nil "~A is a code data-block." o)
1015 (append
1016 (label-value-line*
1017 (:code-size (sb-kernel:%code-code-size o))
1018 (:entry-points (sb-kernel:%code-entry-points o))
1019 (:debug-info (sb-kernel:%code-debug-info o))
1020 (:trace-table-offset (sb-kernel:code-header-ref
1021 o sb-vm:code-trace-table-offset-slot)))
1022 `("Constants:" (:newline))
1023 (loop for i from sb-vm:code-constants-offset
1024 below (sb-kernel:get-header-data o)
1025 append (label-value-line i (sb-kernel:code-header-ref o i)))
1026 `("Code:" (:newline)
1027 , (with-output-to-string (s)
1028 (cond ((sb-kernel:%code-debug-info o)
1029 (sb-disassem:disassemble-code-component o :stream s))
1030 (t
1031 (sb-disassem:disassemble-memory
1032 (sb-disassem::align
1033 (+ (logandc2 (sb-kernel:get-lisp-obj-address o)
1034 sb-vm:lowtag-mask)
1035 (* sb-vm:code-constants-offset
1036 sb-vm:n-word-bytes))
1037 (ash 1 sb-vm:n-lowtag-bits))
1038 (ash (sb-kernel:%code-code-size o) sb-vm:word-shift)
1039 :stream s))))))))
1040
1041 (defmethod inspect-for-emacs ((o sb-kernel:fdefn) (inspector sbcl-inspector))
1042 (declare (ignore inspector))
1043 (values "A fdefn object."
1044 (label-value-line*
1045 (:name (sb-kernel:fdefn-name o))
1046 (:function (sb-kernel:fdefn-fun o)))))
1047
1048 (defmethod inspect-for-emacs :around ((o generic-function)
1049 (inspector sbcl-inspector))
1050 (declare (ignore inspector))
1051 (multiple-value-bind (title contents) (call-next-method)
1052 (values title
1053 (append
1054 contents
1055 (label-value-line*
1056 (:pretty-arglist (sb-pcl::generic-function-pretty-arglist o))
1057 (:initial-methods (sb-pcl::generic-function-initial-methods o))
1058 )))))
1059
1060
1061 ;;;; Multiprocessing
1062
1063 #+(and sb-thread
1064 #.(cl:if (cl:find-symbol "THREAD-NAME" "SB-THREAD") '(and) '(or)))
1065 (progn
1066 (defvar *thread-id-counter* 0)
1067
1068 (defvar *thread-id-counter-lock*
1069 (sb-thread:make-mutex :name "thread id counter lock"))
1070
1071 (defun next-thread-id ()
1072 (sb-thread:with-mutex (*thread-id-counter-lock*)
1073 (incf *thread-id-counter*)))
1074
1075 (defparameter *thread-id-map* (make-hash-table))
1076
1077 ;; This should be a thread -> id map but as weak keys are not
1078 ;; supported it is id -> map instead.
1079 (defvar *thread-id-map-lock*
1080 (sb-thread:make-mutex :name "thread id map lock"))
1081
1082 (defimplementation spawn (fn &key name)
1083 (sb-thread:make-thread fn :name name))
1084
1085 (defimplementation startup-multiprocessing ())
1086
1087 (defimplementation thread-id (thread)
1088 (sb-thread:with-mutex (*thread-id-map-lock*)
1089 (loop for id being the hash-key in *thread-id-map*
1090 using (hash-value thread-pointer)
1091 do
1092 (let ((maybe-thread (sb-ext:weak-pointer-value thread-pointer)))
1093 (cond ((null maybe-thread)
1094 ;; the value is gc'd, remove it manually
1095 (remhash id *thread-id-map*))
1096 ((eq thread maybe-thread)
1097 (return-from thread-id id)))))
1098 ;; lazy numbering
1099 (let ((id (next-thread-id)))
1100 (setf (gethash id *thread-id-map*) (sb-ext:make-weak-pointer thread))
1101 id)))
1102
1103 (defimplementation find-thread (id)
1104 (sb-thread:with-mutex (*thread-id-map-lock*)
1105 (let ((thread-pointer (gethash id *thread-id-map*)))
1106 (if thread-pointer
1107 (let ((maybe-thread (sb-ext:weak-pointer-value thread-pointer)))
1108 (if maybe-thread
1109 maybe-thread
1110 ;; the value is gc'd, remove it manually
1111 (progn
1112 (remhash id *thread-id-map*)
1113 nil)))
1114 nil))))
1115
1116 (defimplementation thread-name (thread)
1117 ;; sometimes the name is not a string (e.g. NIL)
1118 (princ-to-string (sb-thread:thread-name thread)))
1119
1120 (defimplementation thread-status (thread)
1121 (if (sb-thread:thread-alive-p thread)
1122 "RUNNING"
1123 "STOPPED"))
1124
1125 (defimplementation make-lock (&key name)
1126 (sb-thread:make-mutex :name name))
1127
1128 (defimplementation call-with-lock-held (lock function)
1129 (declare (type function function))
1130 (sb-thread:with-mutex (lock) (funcall function)))
1131
1132 (defimplementation current-thread ()
1133 sb-thread:*current-thread*)
1134
1135 (defimplementation all-threads ()
1136 (sb-thread:list-all-threads))
1137
1138 (defimplementation interrupt-thread (thread fn)
1139 (sb-thread:interrupt-thread thread fn))
1140
1141 (defimplementation kill-thread (thread)
1142 (sb-thread:terminate-thread thread))
1143
1144 (defimplementation thread-alive-p (thread)
1145 (sb-thread:thread-alive-p thread))
1146
1147 (defvar *mailbox-lock* (sb-thread:make-mutex :name "mailbox lock"))
1148 (defvar *mailboxes* (list))
1149 (declaim (type list *mailboxes*))
1150
1151 (defstruct (mailbox (:conc-name mailbox.))
1152 thread
1153 (mutex (sb-thread:make-mutex))
1154 (waitqueue (sb-thread:make-waitqueue))
1155 (queue '() :type list))
1156
1157 (defun mailbox (thread)
1158 "Return THREAD's mailbox."
1159 (sb-thread:with-mutex (*mailbox-lock*)
1160 (or (find thread *mailboxes* :key #'mailbox.thread)
1161 (let ((mb (make-mailbox :thread thread)))
1162 (push mb *mailboxes*)
1163 mb))))
1164
1165 (defimplementation send (thread message)
1166 (let* ((mbox (mailbox thread))
1167 (mutex (mailbox.mutex mbox)))
1168 (sb-thread:with-mutex (mutex)
1169 (setf (mailbox.queue mbox)
1170 (nconc (mailbox.queue mbox) (list message)))
1171 (sb-thread:condition-broadcast (mailbox.waitqueue mbox)))))
1172
1173 (defimplementation receive ()
1174 (let* ((mbox (mailbox (current-thread)))
1175 (mutex (mailbox.mutex mbox)))
1176 (sb-thread:with-mutex (mutex)
1177 (loop
1178 (let ((q (mailbox.queue mbox)))
1179 (cond (q (return (pop (mailbox.queue mbox))))
1180 (t (sb-thread:condition-wait (mailbox.waitqueue mbox)
1181 mutex))))))))
1182
1183
1184 ;;; Auto-flush streams
1185
1186 ;; XXX race conditions
1187 (defvar *auto-flush-streams* '())
1188
1189 (defvar *auto-flush-thread* nil)
1190
1191 (defimplementation make-stream-interactive (stream)
1192 (setq *auto-flush-streams* (adjoin stream *auto-flush-streams*))
1193 (unless *auto-flush-thread*
1194 (setq *auto-flush-thread*
1195 (sb-thread:make-thread #'flush-streams
1196 :name "auto-flush-thread"))))
1197
1198 (defun flush-streams ()
1199 (loop
1200 (setq *auto-flush-streams*
1201 (remove-if (lambda (x)
1202 (not (and (open-stream-p x)
1203 (output-stream-p x))))
1204 *auto-flush-streams*))
1205 (mapc #'finish-output *auto-flush-streams*)
1206 (sleep 0.15)))
1207
1208 )
1209
1210 (defimplementation quit-lisp ()
1211 #+sb-thread
1212 (dolist (thread (remove (current-thread) (all-threads)))
1213 (ignore-errors (sb-thread:interrupt-thread
1214 thread (lambda () (sb-ext:quit :recklessly-p t)))))
1215 (sb-ext:quit))
1216
1217
1218
1219 ;;Trace implementations
1220 ;;In SBCL, we have:
1221 ;; (trace <name>)
1222 ;; (trace :methods '<name>) ;to trace all methods of the gf <name>
1223 ;; (trace (method <name> <qualifier>? (<specializer>+)))
1224 ;; <name> can be a normal name or a (setf name)
1225
1226 (defun toggle-trace-aux (fspec &rest args)
1227 (cond ((member fspec (eval '(trace)) :test #'equal)
1228 (eval `(untrace ,fspec))
1229 (format nil "~S is now untraced." fspec))
1230 (t
1231 (eval `(trace ,@(if args `(:encapsulate nil) (list)) ,fspec ,@args))
1232 (format nil "~S is now traced." fspec))))
1233
1234 (defun process-fspec (fspec)
1235 (cond ((consp fspec)
1236 (ecase (first fspec)
1237 ((:defun :defgeneric) (second fspec))
1238 ((:defmethod) `(method ,@(rest fspec)))
1239 ((:labels) `(labels ,(process-fspec (second fspec)) ,(third fspec)))
1240 ((:flet) `(flet ,(process-fspec (second fspec)) ,(third fspec)))))
1241 (t
1242 fspec)))
1243
1244 (defimplementation toggle-trace (spec)
1245 (ecase (car spec)
1246 ((setf)
1247 (toggle-trace-aux spec))
1248 ((:defmethod)
1249 (toggle-trace-aux `(sb-pcl::fast-method ,@(rest (process-fspec spec)))))
1250 ((:defgeneric)
1251 (toggle-trace-aux (second spec) :methods t))
1252 ((:call)
1253 (destructuring-bind (caller callee) (cdr spec)
1254 (toggle-trace-aux callee :wherein (list (process-fspec caller)))))))
1255
1256 ;;; Weak datastructures
1257
1258
1259 ;; SBCL doesn't actually implement weak hash-tables, the WEAK-P
1260 ;; keyword is just a decoy. Leave this here, but commented out,
1261 ;; so that no-one tries adding it back.
1262 #+(or)
1263 (defimplementation make-weak-key-hash-table (&rest args)
1264 (apply #'make-hash-table :weak-p t args))
1265

  ViewVC Help
Powered by ViewVC 1.1.5