Skip to content
Newer
Older
100644 832 lines (695 sloc) 29.3 KB
d502794 (find-external-format): Translate :utf-8-unix to :utf8, which Allegro
Helmut Eller authored Oct 10, 2005
1 ;;;; -*- indent-tabs-mode: nil; outline-regexp: ";;;;;* "; -*-
f912c9c New file.
Helmut Eller authored Dec 6, 2003
2 ;;;
3 ;;; swank-allegro.lisp --- Allegro CL specific code for SLIME.
4 ;;;
2ab1edd (find-fspec-location): excl:source-file can return stuff like
Helmut Eller authored Oct 1, 2004
5 ;;; Created 2003
f912c9c New file.
Helmut Eller authored Dec 6, 2003
6 ;;;
7 ;;; This code has been placed in the Public Domain. All warranties
521e923 (swank-compile-file): New optional argument `external-format'.
Helmut Eller authored Jul 5, 2005
8 ;;; are disclaimed.
f912c9c New file.
Helmut Eller authored Dec 6, 2003
9 ;;;
10
8052a9e Minor modifications.
Helmut Eller authored Mar 9, 2004
11 (in-package :swank-backend)
12
f912c9c New file.
Helmut Eller authored Dec 6, 2003
13 (eval-when (:compile-toplevel :load-toplevel :execute)
14 (require :sock)
d502794 (find-external-format): Translate :utf-8-unix to :utf8, which Allegro
Helmut Eller authored Oct 10, 2005
15 (require :process))
aa65d6e Implemented.
Luke Gorrie authored Jun 7, 2004
16
d502794 (find-external-format): Translate :utf-8-unix to :utf8, which Allegro
Helmut Eller authored Oct 10, 2005
17 (import-from :excl *gray-stream-symbols* :swank-backend)
f912c9c New file.
Helmut Eller authored Dec 6, 2003
18
f759e67 2004-09-13 Marco Baringer <mb@bese.it>
Marco Baringer authored Sep 12, 2004
19 ;;; swank-mop
20
2ab1edd (find-fspec-location): excl:source-file can return stuff like
Helmut Eller authored Oct 1, 2004
21 (import-swank-mop-symbols :clos '(:slot-definition-documentation))
ff1fa86 2004-09-13 Marco Baringer <mb@bese.it>
Marco Baringer authored Sep 13, 2004
22
23 (defun swank-mop:slot-definition-documentation (slot)
5bb5d51 (swank-mop:slot-definition-documentation): ACL 7 says documentation
Helmut Eller authored Nov 19, 2004
24 (documentation slot t))
f759e67 2004-09-13 Marco Baringer <mb@bese.it>
Marco Baringer authored Sep 12, 2004
25
d502794 (find-external-format): Translate :utf-8-unix to :utf8, which Allegro
Helmut Eller authored Oct 10, 2005
26
fab0b31 Add multiprocessing support.
Helmut Eller authored Jan 16, 2004
27 ;;;; TCP Server
f912c9c New file.
Helmut Eller authored Dec 6, 2003
28
8052a9e Minor modifications.
Helmut Eller authored Mar 9, 2004
29 (defimplementation preferred-communication-style ()
30 :spawn)
92d6085 Use signal driven IO for CMUCL and SBCL. Use one thread per request
Helmut Eller authored Jan 31, 2004
31
39861f4 (create-socket): Take interface as argument.
Helmut Eller authored Feb 8, 2004
32 (defimplementation create-socket (host port)
33 (socket:make-socket :connect :passive :local-port port
34 :local-host host :reuse-address t))
bba6c65 (format-condition-for-emacs): Replaced with debugger-condition-for-em…
Helmut Eller authored Jan 2, 2004
35
72f16c0 Replace defmethod with defimplementation.
Helmut Eller authored Jan 20, 2004
36 (defimplementation local-port (socket)
7b493c0 (create-socket, local-port, close-socket, accept-connection)
Helmut Eller authored Jan 13, 2004
37 (socket:local-port socket))
c9ef56e (create-swank-server): Add support for BACKGROUND and CLOSE argument.
Helmut Eller authored Dec 14, 2003
38
72f16c0 Replace defmethod with defimplementation.
Helmut Eller authored Jan 20, 2004
39 (defimplementation close-socket (socket)
7b493c0 (create-socket, local-port, close-socket, accept-connection)
Helmut Eller authored Jan 13, 2004
40 (close socket))
c9ef56e (create-swank-server): Add support for BACKGROUND and CLOSE argument.
Helmut Eller authored Dec 14, 2003
41
d4ac7e7 * Improve the robustness of connection establishment.
Douglas Crosher authored Mar 22, 2006
42 (defimplementation accept-connection (socket &key external-format buffering
43 timeout)
44 (declare (ignore buffering timeout))
5fb5464 (find-external-format, guess-external-format): New.
Helmut Eller authored Nov 19, 2006
45 (let ((s (socket:accept-connection socket :wait t)))
46 (when external-format
47 (setf (stream-external-format s) external-format))
984c411 (accept-connection): Accept :external-format as argument.
Helmut Eller authored Nov 19, 2004
48 s))
c9ef56e (create-swank-server): Add support for BACKGROUND and CLOSE argument.
Helmut Eller authored Dec 14, 2003
49
5fb5464 (find-external-format, guess-external-format): New.
Helmut Eller authored Nov 19, 2006
50 (defvar *external-format-to-coding-system*
51 '((:iso-8859-1
52 "latin-1" "latin-1-unix" "iso-latin-1-unix"
53 "iso-8859-1" "iso-8859-1-unix")
54 (:utf-8 "utf-8" "utf-8-unix")
55 (:euc-jp "euc-jp" "euc-jp-unix")
56 (:us-ascii "us-ascii" "us-ascii-unix")
57 (:emacs-mule "emacs-mule" "emacs-mule-unix")))
58
59 (defimplementation find-external-format (coding-system)
60 (let ((e (rassoc-if (lambda (x) (member coding-system x :test #'equal))
61 *external-format-to-coding-system*)))
62 (and e (excl:crlf-base-ef
63 (excl:find-external-format (car e)
64 :try-variant t)))))
ca9bb1b (set-external-format): New function. Use LF as eol mark.
Helmut Eller authored Nov 24, 2004
65
58bc7fb (format-sldb-condition, condition-references): Add workarounds for
Helmut Eller authored Jun 12, 2004
66 (defimplementation format-sldb-condition (c)
67 (princ-to-string c))
68
2b0dd28 (frame-var-value): New backend function.
Helmut Eller authored Jun 25, 2004
69 (defimplementation call-with-syntax-hooks (fn)
70 (funcall fn))
71
6fa3b33 (arglist-string): Refactor common code to swank.lisp.
Helmut Eller authored Jan 18, 2004
72 ;;;; Unix signals
73
72f16c0 Replace defmethod with defimplementation.
Helmut Eller authored Jan 20, 2004
74 (defimplementation call-without-interrupts (fn)
6fa3b33 (arglist-string): Refactor common code to swank.lisp.
Helmut Eller authored Jan 18, 2004
75 (excl:without-interrupts (funcall fn)))
76
72f16c0 Replace defmethod with defimplementation.
Helmut Eller authored Jan 20, 2004
77 (defimplementation getpid ()
fab0b31 Add multiprocessing support.
Helmut Eller authored Jan 16, 2004
78 (excl::getpid))
79
6827452 (lisp-implementation-type-name): Implement it.
Helmut Eller authored Feb 26, 2004
80 (defimplementation lisp-implementation-type-name ()
81 "allegro")
82
38b61c2 Allegro specific version of set-default-directory
Peter Seibel authored Apr 7, 2004
83 (defimplementation set-default-directory (directory)
b408600 (set-default-directory): Fix for pathnames without a trailing slash.
Matthias Koeppe authored Mar 24, 2006
84 (let* ((dir (namestring (truename (merge-pathnames directory)))))
85 (setf *default-pathname-defaults* (pathname (excl:chdir dir)))
358236a (handle-compiler-warning): Handle undefined-functions warnings by
Helmut Eller authored Dec 5, 2004
86 dir))
38b61c2 Allegro specific version of set-default-directory
Peter Seibel authored Apr 7, 2004
87
167a03c (default-directory, call-with-syntax-hooks): Add implementations as
Helmut Eller authored Jun 16, 2004
88 (defimplementation default-directory ()
358236a (handle-compiler-warning): Handle undefined-functions warnings by
Helmut Eller authored Dec 5, 2004
89 (namestring (excl:current-directory)))
167a03c (default-directory, call-with-syntax-hooks): Add implementations as
Helmut Eller authored Jun 16, 2004
90
fab0b31 Add multiprocessing support.
Helmut Eller authored Jan 16, 2004
91 ;;;; Misc
f912c9c New file.
Helmut Eller authored Dec 6, 2003
92
8052a9e Minor modifications.
Helmut Eller authored Mar 9, 2004
93 (defimplementation arglist (symbol)
d589600 (arglist): Return :not-available if arglist lookup fails with an
Luke Gorrie authored Apr 26, 2004
94 (handler-case (excl:arglist symbol)
95 (simple-error () :not-available)))
8052a9e Minor modifications.
Helmut Eller authored Mar 9, 2004
96
97 (defimplementation macroexpand-all (form)
98 (excl::walk form))
f912c9c New file.
Helmut Eller authored Dec 6, 2003
99
72f16c0 Replace defmethod with defimplementation.
Helmut Eller authored Jan 20, 2004
100 (defimplementation describe-symbol-for-emacs (symbol)
f912c9c New file.
Helmut Eller authored Dec 6, 2003
101 (let ((result '()))
102 (flet ((doc (kind &optional (sym symbol))
103 (or (documentation sym kind) :not-documented))
104 (maybe-push (property value)
105 (when value
106 (setf result (list* property value result)))))
107 (maybe-push
108 :variable (when (boundp symbol)
109 (doc 'variable)))
110 (maybe-push
111 :function (if (fboundp symbol)
112 (doc 'function)))
113 (maybe-push
114 :class (if (find-class symbol nil)
115 (doc 'class)))
116 result)))
117
c2d3f88 Implement changed backend interface and remove references to front en…
Helmut Eller authored Mar 9, 2004
118 (defimplementation describe-definition (symbol namespace)
119 (ecase namespace
120 (:variable
121 (describe symbol))
122 ((:function :generic-function)
123 (describe (symbol-function symbol)))
124 (:class
125 (describe (find-class symbol)))))
72f16c0 Replace defmethod with defimplementation.
Helmut Eller authored Jan 20, 2004
126
fab0b31 Add multiprocessing support.
Helmut Eller authored Jan 16, 2004
127 ;;;; Debugger
128
f912c9c New file.
Helmut Eller authored Dec 6, 2003
129 (defvar *sldb-topframe*)
c9ef56e (create-swank-server): Add support for BACKGROUND and CLOSE argument.
Helmut Eller authored Dec 14, 2003
130
72f16c0 Replace defmethod with defimplementation.
Helmut Eller authored Jan 20, 2004
131 (defimplementation call-with-debugging-environment (debugger-loop-fn)
73e84b5 (process-fspec-for-allegro, toggle-trace): Handle setf functions.
Helmut Eller authored Mar 4, 2005
132 (let ((*sldb-topframe* (find-topframe))
c2d3f88 Implement changed backend interface and remove references to front en…
Helmut Eller authored Mar 9, 2004
133 (excl::*break-hook* nil))
c9ef56e (create-swank-server): Add support for BACKGROUND and CLOSE argument.
Helmut Eller authored Dec 14, 2003
134 (funcall debugger-loop-fn)))
f912c9c New file.
Helmut Eller authored Dec 6, 2003
135
424cc92 (sldb-break-at-start): Implement.
Matthias Koeppe authored Oct 26, 2006
136 (defimplementation sldb-break-at-start (fname)
137 ;; :print-before is kind of mis-used but we just want to stuff our break form
138 ;; somewhere. This does not work for setf, :before and :after methods, which
139 ;; need special syntax in the trace call, see ACL's doc/debugging.htm chapter 10.
140 (eval `(trace (,fname
141 :print-before
142 ((break "Function start breakpoint of ~A" ',fname)))))
143 `(:ok ,(format nil "Set breakpoint at start of ~S" fname)))
144
73e84b5 (process-fspec-for-allegro, toggle-trace): Handle setf functions.
Helmut Eller authored Mar 4, 2005
145 (defun find-topframe ()
83a4ffd @trittweiler * swank-allegro.lisp (find-topframe): Hide SWANK related cruft
trittweiler authored May 12, 2009
146 (let ((magic-symbol (intern (symbol-name :swank-debugger-hook)
147 (find-package :swank)))
148 (top-frame (excl::int-newest-frame)))
149 (loop for frame = top-frame then (next-frame frame)
150 for name = (debugger:frame-name frame)
151 for i from 0
152 when (eq name magic-symbol)
153 return (next-frame frame)
154 until (= i 10) finally (return top-frame))))
73e84b5 (process-fspec-for-allegro, toggle-trace): Handle setf functions.
Helmut Eller authored Mar 4, 2005
155
3dc039d (nth-frame): Skip frames where frame-visible-p is false.
Helmut Eller authored Jun 28, 2004
156 (defun next-frame (frame)
157 (let ((next (excl::int-next-older-frame frame)))
158 (cond ((not next) nil)
159 ((debugger:frame-visible-p next) next)
160 (t (next-frame next)))))
161
f912c9c New file.
Helmut Eller authored Dec 6, 2003
162 (defun nth-frame (index)
3dc039d (nth-frame): Skip frames where frame-visible-p is false.
Helmut Eller authored Jun 28, 2004
163 (do ((frame *sldb-topframe* (next-frame frame))
f912c9c New file.
Helmut Eller authored Dec 6, 2003
164 (i index (1- i)))
165 ((zerop i) frame)))
166
c2d3f88 Implement changed backend interface and remove references to front en…
Helmut Eller authored Mar 9, 2004
167 (defimplementation compute-backtrace (start end)
f912c9c New file.
Helmut Eller authored Dec 6, 2003
168 (let ((end (or end most-positive-fixnum)))
3dc039d (nth-frame): Skip frames where frame-visible-p is false.
Helmut Eller authored Jun 28, 2004
169 (loop for f = (nth-frame start) then (next-frame f)
f912c9c New file.
Helmut Eller authored Dec 6, 2003
170 for i from start below end
954bd86 * swank-backend.lisp (frame-restartable-p): New function.
Helmut Eller authored Oct 17, 2008
171 while f collect f)))
f912c9c New file.
Helmut Eller authored Dec 6, 2003
172
954bd86 * swank-backend.lisp (frame-restartable-p): New function.
Helmut Eller authored Oct 17, 2008
173 (defimplementation print-frame (frame stream)
174 (debugger:output-frame stream frame :moderate))
c9ef56e (create-swank-server): Add support for BACKGROUND and CLOSE argument.
Helmut Eller authored Dec 14, 2003
175
72f16c0 Replace defmethod with defimplementation.
Helmut Eller authored Jan 20, 2004
176 (defimplementation frame-locals (index)
f912c9c New file.
Helmut Eller authored Dec 6, 2003
177 (let ((frame (nth-frame index)))
178 (loop for i from 0 below (debugger:frame-number-vars frame)
de3dd96 See ChangeLog entry 2004-03-05 Marco Baringer
Marco Baringer authored Mar 5, 2004
179 collect (list :name (debugger:frame-var-name frame i)
f912c9c New file.
Helmut Eller authored Dec 6, 2003
180 :id 0
de3dd96 See ChangeLog entry 2004-03-05 Marco Baringer
Marco Baringer authored Mar 5, 2004
181 :value (debugger:frame-var-value frame i)))))
f912c9c New file.
Helmut Eller authored Dec 6, 2003
182
2b0dd28 (frame-var-value): New backend function.
Helmut Eller authored Jun 25, 2004
183 (defimplementation frame-var-value (frame var)
184 (let ((frame (nth-frame frame)))
185 (debugger:frame-var-value frame var)))
f912c9c New file.
Helmut Eller authored Dec 6, 2003
186
8052a9e Minor modifications.
Helmut Eller authored Mar 9, 2004
187 (defimplementation disassemble-frame (index)
188 (disassemble (debugger:frame-function (nth-frame index))))
189
72f16c0 Replace defmethod with defimplementation.
Helmut Eller authored Jan 20, 2004
190 (defimplementation frame-source-location-for-emacs (index)
33236b4 From Matthew Danish:
Luke Gorrie authored Jun 18, 2004
191 (let* ((frame (nth-frame index))
192 (expr (debugger:frame-expression frame))
193 (fspec (first expr)))
194 (second (first (fspec-definition-locations fspec)))))
c9ef56e (create-swank-server): Add support for BACKGROUND and CLOSE argument.
Helmut Eller authored Dec 14, 2003
195
72f16c0 Replace defmethod with defimplementation.
Helmut Eller authored Jan 20, 2004
196 (defimplementation eval-in-frame (form frame-number)
971c7b4 (eval-in-frame): Allegro's eval-form-in-context does nothing special
Helmut Eller authored Apr 1, 2005
197 (let ((frame (nth-frame frame-number)))
198 ;; let-bind lexical variables
199 (let ((vars (loop for i below (debugger:frame-number-vars frame)
200 for name = (debugger:frame-var-name frame i)
201 if (symbolp name)
202 collect `(,name ',(debugger:frame-var-value frame i)))))
203 (debugger:eval-form-in-context
204 `(let* ,vars ,form)
205 (debugger:environment-of-frame frame)))))
72f16c0 Replace defmethod with defimplementation.
Helmut Eller authored Jan 20, 2004
206
4303a24 (return-from-frame, restart-name): Implement interface (partly).
Helmut Eller authored Jan 22, 2004
207 (defimplementation return-from-frame (frame-number form)
208 (let ((frame (nth-frame frame-number)))
209 (multiple-value-call #'debugger:frame-return
210 frame (debugger:eval-form-in-context
c2d3f88 Implement changed backend interface and remove references to front en…
Helmut Eller authored Mar 9, 2004
211 form
212 (debugger:environment-of-frame frame)))))
9f80540 (handle-undefined-functions-warning): Prevent breakage if the
Helmut Eller authored Jan 20, 2005
213
954bd86 * swank-backend.lisp (frame-restartable-p): New function.
Helmut Eller authored Oct 17, 2008
214 (defimplementation frame-restartable-p (frame)
bf67446 * swank-allegro.lisp (frame-restartable-p): Handle errors signaled
Helmut Eller authored Oct 21, 2008
215 (handler-case (debugger:frame-retryable-p frame)
216 (serious-condition (c)
217 (funcall (read-from-string "swank::background-message")
218 "~a ~a" frame (princ-to-string c))
219 nil)))
954bd86 * swank-backend.lisp (frame-restartable-p): New function.
Helmut Eller authored Oct 17, 2008
220
4303a24 (return-from-frame, restart-name): Implement interface (partly).
Helmut Eller authored Jan 22, 2004
221 (defimplementation restart-frame (frame-number)
222 (let ((frame (nth-frame frame-number)))
18204be (restart-frame): Simplify it a little.
Helmut Eller authored Feb 22, 2005
223 (cond ((debugger:frame-retryable-p frame)
224 (apply #'debugger:frame-retry frame (debugger:frame-function frame)
225 (cdr (debugger:frame-expression frame))))
226 (t "Frame is not retryable"))))
9f80540 (handle-undefined-functions-warning): Prevent breakage if the
Helmut Eller authored Jan 20, 2005
227
fab0b31 Add multiprocessing support.
Helmut Eller authored Jan 16, 2004
228 ;;;; Compiler hooks
229
f912c9c New file.
Helmut Eller authored Dec 6, 2003
230 (defvar *buffer-name* nil)
231 (defvar *buffer-start-position*)
232 (defvar *buffer-string*)
aa65d6e Implemented.
Luke Gorrie authored Jun 7, 2004
233 (defvar *compile-filename* nil)
a8fa895 @trittweiler Highlight reader-errors in the source buffers on Allegro.
trittweiler authored May 12, 2009
234 (defvar *temp-file-header-end-position* nil)
f912c9c New file.
Helmut Eller authored Dec 6, 2003
235
358236a (handle-compiler-warning): Handle undefined-functions warnings by
Helmut Eller authored Dec 5, 2004
236 (defun compiler-note-p (object)
237 (member (type-of object) '(excl::compiler-note compiler::compiler-note)))
238
239 (defun compiler-undefined-functions-called-warning-p (object)
240 (typep object 'excl:compiler-undefined-functions-called-warning))
ca9bb1b (set-external-format): New function. Use LF as eol mark.
Helmut Eller authored Nov 24, 2004
241
242 (deftype compiler-note ()
243 `(satisfies compiler-note-p))
244
358236a (handle-compiler-warning): Handle undefined-functions warnings by
Helmut Eller authored Dec 5, 2004
245 (defun signal-compiler-condition (&rest args)
246 (signal (apply #'make-condition 'compiler-condition args)))
247
f912c9c New file.
Helmut Eller authored Dec 6, 2003
248 (defun handle-compiler-warning (condition)
358236a (handle-compiler-warning): Handle undefined-functions warnings by
Helmut Eller authored Dec 5, 2004
249 (declare (optimize (debug 3) (speed 0) (space 0)))
a8fa895 @trittweiler Highlight reader-errors in the source buffers on Allegro.
trittweiler authored May 12, 2009
250 (cond ((and (not *buffer-name*)
358236a (handle-compiler-warning): Handle undefined-functions warnings by
Helmut Eller authored Dec 5, 2004
251 (compiler-undefined-functions-called-warning-p condition))
252 (handle-undefined-functions-warning condition))
253 (t
254 (signal-compiler-condition
255 :original-condition condition
256 :severity (etypecase condition
257 (warning :warning)
a8fa895 @trittweiler Highlight reader-errors in the source buffers on Allegro.
trittweiler authored May 12, 2009
258 (compiler-note :note)
259 (reader-error :read-error))
358236a (handle-compiler-warning): Handle undefined-functions warnings by
Helmut Eller authored Dec 5, 2004
260 :message (format nil "~A" condition)
a8fa895 @trittweiler Highlight reader-errors in the source buffers on Allegro.
trittweiler authored May 12, 2009
261 :location (if (typep condition 'reader-error)
262 (location-for-reader-error condition)
263 (location-for-warning condition))))))
358236a (handle-compiler-warning): Handle undefined-functions warnings by
Helmut Eller authored Dec 5, 2004
264
265 (defun location-for-warning (condition)
f912c9c New file.
Helmut Eller authored Dec 6, 2003
266 (let ((loc (getf (slot-value condition 'excl::plist) :loc)))
358236a (handle-compiler-warning): Handle undefined-functions warnings by
Helmut Eller authored Dec 5, 2004
267 (cond (*buffer-name*
268 (make-location
269 (list :buffer *buffer-name*)
b88eba2 Adjust positions in files with CRLF-style end-on-line markers.
Helmut Eller authored Sep 17, 2008
270 (list :offset *buffer-start-position* 0)))
358236a (handle-compiler-warning): Handle undefined-functions warnings by
Helmut Eller authored Dec 5, 2004
271 (loc
272 (destructuring-bind (file . pos) loc
273 (make-location
274 (list :file (namestring (truename file)))
275 (list :position (1+ pos)))))
276 (t
277 (list :error "No error location available.")))))
278
a8fa895 @trittweiler Highlight reader-errors in the source buffers on Allegro.
trittweiler authored May 12, 2009
279 (defun location-for-reader-error (condition)
280 (let ((pos (car (last (slot-value condition 'excl::format-arguments))))
281 (file (pathname (stream-error-stream condition))))
282 (if (integerp pos)
283 (if *buffer-name*
284 (make-location `(:buffer ,*buffer-name*)
285 `(:offset ,*buffer-start-position*
286 ,(- pos *temp-file-header-end-position* 1)))
287 (make-location `(:file ,(namestring (truename file)))
288 `(:position ,pos)))
289 (list :error "No error location available."))))
290
358236a (handle-compiler-warning): Handle undefined-functions warnings by
Helmut Eller authored Dec 5, 2004
291 (defun handle-undefined-functions-warning (condition)
292 (let ((fargs (slot-value condition 'excl::format-arguments)))
9f80540 (handle-undefined-functions-warning): Prevent breakage if the
Helmut Eller authored Jan 20, 2005
293 (loop for (fname . pos-file) in (car fargs) do
294 (loop for (pos file) in pos-file do
295 (signal-compiler-condition
296 :original-condition condition
297 :severity :warning
298 :message (format nil "Undefined function referenced: ~S"
299 fname)
300 :location (make-location (list :file file)
301 (list :position (1+ pos))))))))
aa65d6e Implemented.
Luke Gorrie authored Jun 7, 2004
302 (defimplementation call-with-compilation-hooks (function)
a8fa895 @trittweiler Highlight reader-errors in the source buffers on Allegro.
trittweiler authored May 12, 2009
303 (handler-bind ((warning #'handle-compiler-warning)
304 (compiler-note #'handle-compiler-warning)
305 (reader-error #'handle-compiler-warning))
aa65d6e Implemented.
Luke Gorrie authored Jun 7, 2004
306 (funcall function)))
307
f761f28 * swank-backend.lisp (swank-compile-file): Take output-file as
Helmut Eller authored Jan 10, 2009
308 (defimplementation swank-compile-file (input-file output-file
309 load-p external-format)
a8fa895 @trittweiler Highlight reader-errors in the source buffers on Allegro.
trittweiler authored May 12, 2009
310 (handler-case
311 (with-compilation-hooks ()
312 (let ((*buffer-name* nil)
313 (*compile-filename* input-file))
314 (compile-file *compile-filename*
315 :output-file output-file
316 :load-after-compile load-p
317 :external-format external-format)))
318 (reader-error () (values nil nil t))))
f912c9c New file.
Helmut Eller authored Dec 6, 2003
319
1a07e24 (swank-compile-string): Use a temporary file and set
Helmut Eller authored Aug 1, 2004
320 (defun call-with-temp-file (fn)
321 (let ((tmpname (system:make-temp-file-name)))
322 (unwind-protect
323 (with-open-file (file tmpname :direction :output :if-exists :error)
324 (funcall fn file tmpname))
325 (delete-file tmpname))))
326
a8fa895 @trittweiler Highlight reader-errors in the source buffers on Allegro.
trittweiler authored May 12, 2009
327 (defun compile-from-temp-file (header string)
1a07e24 (swank-compile-string): Use a temporary file and set
Helmut Eller authored Aug 1, 2004
328 (call-with-temp-file
329 (lambda (stream filename)
a8fa895 @trittweiler Highlight reader-errors in the source buffers on Allegro.
trittweiler authored May 12, 2009
330 (write-string header stream)
331 (let ((*temp-file-header-end-position* (file-position stream)))
1a07e24 (swank-compile-string): Use a temporary file and set
Helmut Eller authored Aug 1, 2004
332 (write-string string stream)
333 (finish-output stream)
601b824 * swank-lispworks.lisp (with-swank-compilation-unit): Return the
Helmut Eller authored Oct 16, 2008
334 (multiple-value-bind (binary-filename warnings? failure?)
a8fa895 @trittweiler Highlight reader-errors in the source buffers on Allegro.
trittweiler authored May 12, 2009
335 (excl:without-redefinition-warnings
601b824 * swank-lispworks.lisp (with-swank-compilation-unit): Return the
Helmut Eller authored Oct 16, 2008
336 ;; Suppress Allegro's redefinition warnings; they are
337 ;; pointless when we are compiling via a temporary
338 ;; file.
339 (compile-file filename :load-after-compile t))
340 (declare (ignore warnings?))
1a07e24 (swank-compile-string): Use a temporary file and set
Helmut Eller authored Aug 1, 2004
341 (when binary-filename
601b824 * swank-lispworks.lisp (with-swank-compilation-unit): Return the
Helmut Eller authored Oct 16, 2008
342 (delete-file binary-filename))
a8fa895 @trittweiler Highlight reader-errors in the source buffers on Allegro.
trittweiler authored May 12, 2009
343 (not failure?))))))
344
345 (defimplementation swank-compile-string (string &key buffer position filename
346 policy)
347 (declare (ignore policy))
348 (handler-case
349 (with-compilation-hooks ()
350 (let ((*buffer-name* buffer)
351 (*buffer-start-position* position)
352 (*buffer-string* string)
353 (*default-pathname-defaults*
354 (if filename
355 (merge-pathnames (pathname filename))
356 *default-pathname-defaults*)))
357 ;; We store the source buffer in excl::*source-pathname* as a
358 ;; string of the form <buffername>;<start-offset>. Quite ugly
359 ;; encoding, but the fasl file is corrupted if we use some
360 ;; other datatype.
361 (compile-from-temp-file
362 (format nil "~S~%~S~%"
363 `(in-package ,(package-name *package*))
364 `(eval-when (:compile-toplevel :load-toplevel)
365 (setq excl::*source-pathname*
366 ',(format nil "~A;~D" buffer position))))
367 string)))
368 (reader-error () (values nil nil t))))
1a07e24 (swank-compile-string): Use a temporary file and set
Helmut Eller authored Aug 1, 2004
369
4314d2e * swank-backend.lisp (swank-compile-string): Pass the
Helmut Eller authored Jan 8, 2009
370 (defimplementation swank-compile-string (string &key buffer position filename
371 policy)
7595969 @trittweiler As of now, `C-u C-c C-c' compiled a function with maximum debug
trittweiler authored Dec 30, 2008
372 (declare (ignore policy))
1a07e24 (swank-compile-string): Use a temporary file and set
Helmut Eller authored Aug 1, 2004
373 ;; We store the source buffer in excl::*source-pathname* as a string
36f4daf (swank-compile-string): Use #\; instead of #\: to separate the
Helmut Eller authored Aug 18, 2004
374 ;; of the form <buffername>;<start-offset>. Quite ugly encoding, but
1a07e24 (swank-compile-string): Use a temporary file and set
Helmut Eller authored Aug 1, 2004
375 ;; the fasl file is corrupted if we use some other datatype.
aa65d6e Implemented.
Luke Gorrie authored Jun 7, 2004
376 (with-compilation-hooks ()
c2d3f88 Implement changed backend interface and remove references to front en…
Helmut Eller authored Mar 9, 2004
377 (let ((*buffer-name* buffer)
f912c9c New file.
Helmut Eller authored Dec 6, 2003
378 (*buffer-start-position* position)
79c38c6 Adding directory argument to swank-compile-string.
Peter Seibel authored Aug 28, 2004
379 (*buffer-string* string)
380 (*default-pathname-defaults*
b4843ef * swank-allegro.lisp (swank-compile-string): Don't use the
Helmut Eller authored Jan 9, 2009
381 (if filename
382 (merge-pathnames (pathname filename))
79c38c6 Adding directory argument to swank-compile-string.
Peter Seibel authored Aug 28, 2004
383 *default-pathname-defaults*)))
1a07e24 (swank-compile-string): Use a temporary file and set
Helmut Eller authored Aug 1, 2004
384 (compile-from-temp-file
385 (format nil "~S ~S~%~A"
386 `(in-package ,(package-name *package*))
387 `(eval-when (:compile-toplevel :load-toplevel)
4314d2e * swank-backend.lisp (swank-compile-string): Pass the
Helmut Eller authored Jan 8, 2009
388 (setq excl::*source-pathname*
b4843ef * swank-allegro.lisp (swank-compile-string): Don't use the
Helmut Eller authored Jan 9, 2009
389 ',(format nil "~A;~D" buffer position)))
1a07e24 (swank-compile-string): Use a temporary file and set
Helmut Eller authored Aug 1, 2004
390 string)))))
f912c9c New file.
Helmut Eller authored Dec 6, 2003
391
fab0b31 Add multiprocessing support.
Helmut Eller authored Jan 16, 2004
392 ;;;; Definition Finding
393
56d2e6d (fspec-primary-name): New function.
Helmut Eller authored May 22, 2004
394 (defun fspec-primary-name (fspec)
395 (etypecase fspec
5bb5d51 (swank-mop:slot-definition-documentation): ACL 7 says documentation
Helmut Eller authored Nov 19, 2004
396 (symbol fspec)
397 (list (fspec-primary-name (second fspec)))))
398
399 ;; If Emacs uses DOS-style eol conventions, \n\r are considered as a
400 ;; single character, but file-position counts them as two. Here we do
401 ;; our own conversion.
402 (defun count-cr (file pos)
403 (let* ((bufsize 256)
984c411 (accept-connection): Accept :external-format as argument.
Helmut Eller authored Nov 19, 2004
404 (type '(unsigned-byte 8))
405 (buf (make-array bufsize :element-type type))
5bb5d51 (swank-mop:slot-definition-documentation): ACL 7 says documentation
Helmut Eller authored Nov 19, 2004
406 (cr-count 0))
984c411 (accept-connection): Accept :external-format as argument.
Helmut Eller authored Nov 19, 2004
407 (with-open-file (stream file :direction :input :element-type type)
408 (loop for bytes-read = (read-sequence buf stream) do
409 (incf cr-count (count (char-code #\return) buf
410 :end (min pos bytes-read)))
411 (decf pos bytes-read)
412 (when (<= pos 0)
413 (return cr-count))))))
5bb5d51 (swank-mop:slot-definition-documentation): ACL 7 says documentation
Helmut Eller authored Nov 19, 2004
414
7544734 (find-definition-in-file)
Matthias Koeppe authored Dec 7, 2005
415 (defun find-definition-in-file (fspec type file top-level)
416 (let* ((part
417 (or (scm::find-definition-in-definition-group
418 fspec type (scm:section-file :file file)
419 :top-level top-level)
420 (scm::find-definition-in-definition-group
421 (fspec-primary-name fspec)
422 type (scm:section-file :file file)
423 :top-level top-level)))
424 (start (and part
425 (scm::source-part-start part)))
2ab1edd (find-fspec-location): excl:source-file can return stuff like
Helmut Eller authored Oct 1, 2004
426 (pos (if start
b88eba2 Adjust positions in files with CRLF-style end-on-line markers.
Helmut Eller authored Sep 17, 2008
427 (list :position (1+ start))
5bb5d51 (swank-mop:slot-definition-documentation): ACL 7 says documentation
Helmut Eller authored Nov 19, 2004
428 (list :function-name (string (fspec-primary-name fspec))))))
429 (make-location (list :file (namestring (truename file)))
430 pos)))
2ab1edd (find-fspec-location): excl:source-file can return stuff like
Helmut Eller authored Oct 1, 2004
431
432 (defun find-definition-in-buffer (filename)
433 (let ((pos (position #\; filename :from-end t)))
434 (make-location
435 (list :buffer (subseq filename 0 pos))
b88eba2 Adjust positions in files with CRLF-style end-on-line markers.
Helmut Eller authored Sep 17, 2008
436 (list :offset (parse-integer (subseq filename (1+ pos))) 0))))
2ab1edd (find-fspec-location): excl:source-file can return stuff like
Helmut Eller authored Oct 1, 2004
437
7544734 (find-definition-in-file)
Matthias Koeppe authored Dec 7, 2005
438 (defun find-fspec-location (fspec type file top-level)
439 (etypecase file
440 (pathname
441 (find-definition-in-file fspec type file top-level))
442 ((member :top-level)
443 (list :error (format nil "Defined at toplevel: ~A"
444 (fspec->string fspec))))
445 (string
446 (find-definition-in-buffer file))))
4902bdb (find-fspec-location): Include the type of the definition in the
Luke Gorrie authored Aug 4, 2004
447
36f4daf (swank-compile-string): Use #\; instead of #\: to separate the
Helmut Eller authored Aug 18, 2004
448 (defun fspec->string (fspec)
4902bdb (find-fspec-location): Include the type of the definition in the
Luke Gorrie authored Aug 4, 2004
449 (etypecase fspec
36f4daf (swank-compile-string): Use #\; instead of #\: to separate the
Helmut Eller authored Aug 18, 2004
450 (symbol (let ((*package* (find-package :keyword)))
451 (prin1-to-string fspec)))
452 (list (format nil "(~A ~A)"
453 (prin1-to-string (first fspec))
454 (let ((*package* (find-package :keyword)))
455 (prin1-to-string (second fspec)))))))
c2d3f88 Implement changed backend interface and remove references to front en…
Helmut Eller authored Mar 9, 2004
456
437f909 Remove stupid conflicts.
Helmut Eller authored Mar 9, 2004
457 (defun fspec-definition-locations (fspec)
b909530 (fspec-definition-locations): Handle
Matthias Koeppe authored May 4, 2006
458 (cond
459 ((and (listp fspec)
460 (eql (car fspec) :top-level-form))
6ac09e6 swank-allegro.lisp (fspec-definition-locations): Allow the
Matthias Koeppe authored Sep 26, 2007
461 (destructuring-bind (top-level-form file &optional position) fspec
0758964 * swank-allegro.lisp (fspec-definition-locations): add declare
Helmut Eller authored Sep 11, 2008
462 (declare (ignore top-level-form))
b909530 (fspec-definition-locations): Handle
Matthias Koeppe authored May 4, 2006
463 (list
464 (list (list nil fspec)
b88eba2 Adjust positions in files with CRLF-style end-on-line markers.
Helmut Eller authored Sep 17, 2008
465 (make-location (list :buffer file) ; FIXME: should use :file
466 (list :position position)
467 (list :align t))))))
d51dbc0 (fspec-definition-locations): Improve handling of (:internal ... n)
Helmut Eller authored Aug 10, 2006
468 ((and (listp fspec) (eq (car fspec) :internal))
469 (destructuring-bind (_internal next _n) fspec
0758964 * swank-allegro.lisp (fspec-definition-locations): add declare
Helmut Eller authored Sep 11, 2008
470 (declare (ignore _internal _n))
d51dbc0 (fspec-definition-locations): Improve handling of (:internal ... n)
Helmut Eller authored Aug 10, 2006
471 (fspec-definition-locations next)))
b909530 (fspec-definition-locations): Handle
Matthias Koeppe authored May 4, 2006
472 (t
473 (let ((defs (excl::find-source-file fspec)))
9987736 @trittweiler * slime-allegro.lisp (fspec-definition-locations): Workaround for
trittweiler authored Jul 4, 2008
474 (when (and (null defs)
475 (listp fspec)
476 (string= (car fspec) '#:method))
477 ;; If methods are defined in a defgeneric form, the source location is
478 ;; recorded for the gf but not for the methods. Therefore fall back to
479 ;; the gf as the likely place of definition.
480 (setq defs (excl::find-source-file (second fspec))))
b909530 (fspec-definition-locations): Handle
Matthias Koeppe authored May 4, 2006
481 (if (null defs)
482 (list
483 (list (list nil fspec)
484 (list :error
485 (format nil "Unknown source location for ~A"
486 (fspec->string fspec)))))
7544734 (find-definition-in-file)
Matthias Koeppe authored Dec 7, 2005
487 (loop for (fspec type file top-level) in defs
b909530 (fspec-definition-locations): Handle
Matthias Koeppe authored May 4, 2006
488 collect (list (list type fspec)
489 (find-fspec-location fspec type file top-level))))))))
8052a9e Minor modifications.
Helmut Eller authored Mar 9, 2004
490
491 (defimplementation find-definitions (symbol)
492 (fspec-definition-locations symbol))
fab0b31 Add multiprocessing support.
Helmut Eller authored Jan 16, 2004
493
c2d3f88 Implement changed backend interface and remove references to front en…
Helmut Eller authored Mar 9, 2004
494 ;;;; XREF
f912c9c New file.
Helmut Eller authored Dec 6, 2003
495
8052a9e Minor modifications.
Helmut Eller authored Mar 9, 2004
496 (defmacro defxref (name relation name1 name2)
497 `(defimplementation ,name (x)
498 (xref-result (xref:get-relation ,relation ,name1 ,name2))))
499
500 (defxref who-calls :calls :wild x)
c9f86e2 (toggle-trace): Update tracing code for new interface.
Helmut Eller authored Feb 28, 2005
501 (defxref calls-who :calls x :wild)
8052a9e Minor modifications.
Helmut Eller authored Mar 9, 2004
502 (defxref who-references :uses :wild x)
503 (defxref who-binds :binds :wild x)
504 (defxref who-macroexpands :macro-calls :wild x)
505 (defxref who-sets :sets :wild x)
506
507 (defun xref-result (fspecs)
508 (loop for fspec in fspecs
509 append (fspec-definition-locations fspec)))
c9ef56e (create-swank-server): Add support for BACKGROUND and CLOSE argument.
Helmut Eller authored Dec 14, 2003
510
1a07e24 (swank-compile-string): Use a temporary file and set
Helmut Eller authored Aug 1, 2004
511 ;; list-callers implemented by groveling through all fbound symbols.
512 ;; Only symbols are considered. Functions in the constant pool are
73e84b5 (process-fspec-for-allegro, toggle-trace): Handle setf functions.
Helmut Eller authored Mar 4, 2005
513 ;; searched recursively. Closure environments are ignored at the
1a07e24 (swank-compile-string): Use a temporary file and set
Helmut Eller authored Aug 1, 2004
514 ;; moment (constants in methods are therefore not found).
515
516 (defun map-function-constants (function fn depth)
517 "Call FN with the elements of FUNCTION's constant pool."
518 (do ((i 0 (1+ i))
519 (max (excl::function-constant-count function)))
520 ((= i max))
521 (let ((c (excl::function-constant function i)))
522 (cond ((and (functionp c)
523 (not (eq c function))
524 (plusp depth))
525 (map-function-constants c fn (1- depth)))
526 (t
527 (funcall fn c))))))
528
ca9bb1b (set-external-format): New function. Use LF as eol mark.
Helmut Eller authored Nov 24, 2004
529 (defun in-constants-p (fun symbol)
530 (map-function-constants fun
531 (lambda (c)
532 (when (eq c symbol)
533 (return-from in-constants-p t)))
534 3))
c9f86e2 (toggle-trace): Update tracing code for new interface.
Helmut Eller authored Feb 28, 2005
535
1a07e24 (swank-compile-string): Use a temporary file and set
Helmut Eller authored Aug 1, 2004
536 (defun function-callers (name)
537 (let ((callers '()))
538 (do-all-symbols (sym)
539 (when (fboundp sym)
540 (let ((fn (fdefinition sym)))
541 (when (in-constants-p fn name)
542 (push sym callers)))))
543 callers))
544
545 (defimplementation list-callers (name)
546 (xref-result (function-callers name)))
547
c9f86e2 (toggle-trace): Update tracing code for new interface.
Helmut Eller authored Feb 28, 2005
548 (defimplementation list-callees (name)
549 (let ((result '()))
550 (map-function-constants (fdefinition name)
551 (lambda (c)
552 (when (fboundp c)
553 (push c result)))
554 2)
555 (xref-result result)))
556
d5c9af3 they are pointless when we are compiling via a temporary file.
Matthias Koeppe authored Mar 14, 2006
557 ;;;; Profiling
558
be83e05 Profiling functions on Allegro (except for profile-package). From
Helmut Eller authored Jul 28, 2006
559 ;; Per-function profiling based on description in
560 ;; http://www.franz.com/support/documentation/8.0/doc/runtime-analyzer.htm#data-collection-control-2
561
562 (defvar *profiled-functions* ())
563 (defvar *profile-depth* 0)
564
565 (defmacro with-redirected-y-or-n-p (&body body)
566 ;; If the profiler is restarted when the data from the previous
567 ;; session is not reported yet, the user is warned via Y-OR-N-P.
568 ;; As the CL:Y-OR-N-P question is (for some reason) not directly
569 ;; sent to the Slime user, the function CL:Y-OR-N-P is temporarily
570 ;; overruled.
571 `(let* ((pkg (find-package "common-lisp"))
572 (saved-pdl (excl::package-definition-lock pkg))
573 (saved-ynp (symbol-function 'cl:y-or-n-p)))
574
575 (setf (excl::package-definition-lock pkg) nil
576 (symbol-function 'cl:y-or-n-p) (symbol-function
577 (find-symbol "y-or-n-p-in-emacs"
578 "swank")))
579 (unwind-protect
580 (progn ,@body)
581
582 (setf (symbol-function 'cl:y-or-n-p) saved-ynp
583 (excl::package-definition-lock pkg) saved-pdl))))
584
585 (defun start-acl-profiler ()
586 (with-redirected-y-or-n-p
587 (prof:start-profiler :type :time :count t
588 :start-sampling-p nil :verbose nil)))
589 (defun acl-profiler-active-p ()
590 (not (eq (prof:profiler-status :verbose nil) :inactive)))
591
592 (defun stop-acl-profiler ()
593 (prof:stop-profiler :verbose nil))
594
595 (excl:def-fwrapper profile-fwrapper (&rest args)
596 ;; Ensures sampling is done during the execution of the function,
597 ;; taking into account recursion.
598 (declare (ignore args))
599 (cond ((zerop *profile-depth*)
600 (let ((*profile-depth* (1+ *profile-depth*)))
601 (prof:start-sampling)
602 (unwind-protect (excl:call-next-fwrapper)
603 (prof:stop-sampling))))
604 (t
605 (excl:call-next-fwrapper))))
606
607 (defimplementation profile (fname)
608 (unless (acl-profiler-active-p)
609 (start-acl-profiler))
610 (excl:fwrap fname 'profile-fwrapper 'profile-fwrapper)
611 (push fname *profiled-functions*))
612
613 (defimplementation profiled-functions ()
614 *profiled-functions*)
615
616 (defimplementation unprofile (fname)
617 (excl:funwrap fname 'profile-fwrapper)
618 (setq *profiled-functions* (remove fname *profiled-functions*)))
619
d5c9af3 they are pointless when we are compiling via a temporary file.
Matthias Koeppe authored Mar 14, 2006
620 (defimplementation profile-report ()
be83e05 Profiling functions on Allegro (except for profile-package). From
Helmut Eller authored Jul 28, 2006
621 (prof:show-flat-profile :verbose nil)
622 (when *profiled-functions*
623 (start-acl-profiler)))
624
625 (defimplementation profile-reset ()
626 (when (acl-profiler-active-p)
627 (stop-acl-profiler)
628 (start-acl-profiler))
629 "Reset profiling counters.")
d5c9af3 they are pointless when we are compiling via a temporary file.
Matthias Koeppe authored Mar 14, 2006
630
aeada84 (thread-alive-p): Add default implementation.
Helmut Eller authored Mar 4, 2004
631 ;;;; Inspecting
632
0758964 * swank-allegro.lisp (fspec-definition-locations): add declare
Helmut Eller authored Sep 11, 2008
633 (excl:without-redefinition-warnings
0c75cea Inspector cleanups.
Helmut Eller authored Feb 9, 2008
634 (defmethod emacs-inspect ((o t))
0758964 * swank-allegro.lisp (fspec-definition-locations): add declare
Helmut Eller authored Sep 11, 2008
635 (allegro-inspect o)))
5bb5d51 (swank-mop:slot-definition-documentation): ACL 7 says documentation
Helmut Eller authored Nov 19, 2004
636
0c75cea Inspector cleanups.
Helmut Eller authored Feb 9, 2008
637 (defmethod emacs-inspect ((o function))
6a300a7 Drop the first return value of emacs-inspect.
Helmut Eller authored Feb 9, 2008
638 (allegro-inspect o))
5bb5d51 (swank-mop:slot-definition-documentation): ACL 7 says documentation
Helmut Eller authored Nov 19, 2004
639
0c75cea Inspector cleanups.
Helmut Eller authored Feb 9, 2008
640 (defmethod emacs-inspect ((o standard-object))
6a300a7 Drop the first return value of emacs-inspect.
Helmut Eller authored Feb 9, 2008
641 (allegro-inspect o))
dc71b6e (inspect-for-emacs): Use the backend specific method to inspect
Helmut Eller authored Feb 10, 2006
642
5bb5d51 (swank-mop:slot-definition-documentation): ACL 7 says documentation
Helmut Eller authored Nov 19, 2004
643 (defun allegro-inspect (o)
644 (loop for (d dd) on (inspect::inspect-ctl o)
971c7b4 (eval-in-frame): Allegro's eval-form-in-context does nothing special
Helmut Eller authored Apr 1, 2005
645 append (frob-allegro-field-def o d)
646 until (eq d dd)))
5bb5d51 (swank-mop:slot-definition-documentation): ACL 7 says documentation
Helmut Eller authored Nov 19, 2004
647
971c7b4 (eval-in-frame): Allegro's eval-form-in-context does nothing special
Helmut Eller authored Apr 1, 2005
648 (defun frob-allegro-field-def (object def)
5bb5d51 (swank-mop:slot-definition-documentation): ACL 7 says documentation
Helmut Eller authored Nov 19, 2004
649 (with-struct (inspect::field-def- name type access) def
971c7b4 (eval-in-frame): Allegro's eval-form-in-context does nothing special
Helmut Eller authored Apr 1, 2005
650 (ecase type
d502794 (find-external-format): Translate :utf-8-unix to :utf8, which Allegro
Helmut Eller authored Oct 10, 2005
651 ((:unsigned-word :unsigned-byte :unsigned-natural
652 :unsigned-long :unsigned-half-long
653 :unsigned-3byte)
971c7b4 (eval-in-frame): Allegro's eval-form-in-context does nothing special
Helmut Eller authored Apr 1, 2005
654 (label-value-line name (inspect::component-ref-v object access type)))
0be4e49 * swank-allegro.lisp (frob-allegro-field-def): There seems to be a
Helmut Eller authored Sep 19, 2008
655 ((:lisp :value :func)
971c7b4 (eval-in-frame): Allegro's eval-form-in-context does nothing special
Helmut Eller authored Apr 1, 2005
656 (label-value-line name (inspect::component-ref object access)))
657 (:indirect
658 (destructuring-bind (prefix count ref set) access
659 (declare (ignore set prefix))
660 (loop for i below (funcall count object)
661 append (label-value-line (format nil "~A-~D" name i)
662 (funcall ref object i))))))))
5bb5d51 (swank-mop:slot-definition-documentation): ACL 7 says documentation
Helmut Eller authored Nov 19, 2004
663
aeada84 (thread-alive-p): Add default implementation.
Helmut Eller authored Mar 4, 2004
664 ;;;; Multithreading
fab0b31 Add multiprocessing support.
Helmut Eller authored Jan 16, 2004
665
344b94e (initialize-multiprocessing): Update for new api.
Marco Baringer authored Oct 20, 2006
666 (defimplementation initialize-multiprocessing (continuation)
667 (mp:start-scheduler)
668 (funcall continuation))
fab0b31 Add multiprocessing support.
Helmut Eller authored Jan 16, 2004
669
72f16c0 Replace defmethod with defimplementation.
Helmut Eller authored Jan 20, 2004
670 (defimplementation spawn (fn &key name)
68dd370 Removed fwrapper-based code for inheriting "swankiness" to newly
Luke Gorrie authored Aug 2, 2004
671 (mp:process-run-function name fn))
fab0b31 Add multiprocessing support.
Helmut Eller authored Jan 16, 2004
672
12da821 (thread-id, find-thread): New backend function.
Helmut Eller authored Jun 27, 2004
673 (defvar *id-lock* (mp:make-process-lock :name "id lock"))
674 (defvar *thread-id-counter* 0)
675
676 (defimplementation thread-id (thread)
677 (mp:with-process-lock (*id-lock*)
678 (or (getf (mp:process-property-list thread) 'id)
679 (setf (getf (mp:process-property-list thread) 'id)
680 (incf *thread-id-counter*)))))
681
682 (defimplementation find-thread (id)
683 (find id mp:*all-processes*
684 :key (lambda (p) (getf (mp:process-property-list p) 'id))))
685
64ff730 Update for modified thread interface.
Helmut Eller authored Feb 7, 2004
686 (defimplementation thread-name (thread)
687 (mp:process-name thread))
fab0b31 Add multiprocessing support.
Helmut Eller authored Jan 16, 2004
688
64ff730 Update for modified thread interface.
Helmut Eller authored Feb 7, 2004
689 (defimplementation thread-status (thread)
690 (format nil "~A ~D" (mp:process-whostate thread)
691 (mp:process-priority thread)))
fab0b31 Add multiprocessing support.
Helmut Eller authored Jan 16, 2004
692
72f16c0 Replace defmethod with defimplementation.
Helmut Eller authored Jan 20, 2004
693 (defimplementation make-lock (&key name)
fab0b31 Add multiprocessing support.
Helmut Eller authored Jan 16, 2004
694 (mp:make-process-lock :name name))
695
72f16c0 Replace defmethod with defimplementation.
Helmut Eller authored Jan 20, 2004
696 (defimplementation call-with-lock-held (lock function)
fab0b31 Add multiprocessing support.
Helmut Eller authored Jan 16, 2004
697 (mp:with-process-lock (lock) (funcall function)))
92d6085 Use signal driven IO for CMUCL and SBCL. Use one thread per request
Helmut Eller authored Jan 31, 2004
698
699 (defimplementation current-thread ()
700 mp:*current-process*)
701
702 (defimplementation all-threads ()
64ff730 Update for modified thread interface.
Helmut Eller authored Feb 7, 2004
703 (copy-list mp:*all-processes*))
92d6085 Use signal driven IO for CMUCL and SBCL. Use one thread per request
Helmut Eller authored Jan 31, 2004
704
705 (defimplementation interrupt-thread (thread fn)
706 (mp:process-interrupt thread fn))
707
52dc1fc (kill-thread): Implemented.
Helmut Eller authored Mar 1, 2004
708 (defimplementation kill-thread (thread)
709 (mp:process-kill thread))
710
92d6085 Use signal driven IO for CMUCL and SBCL. Use one thread per request
Helmut Eller authored Jan 31, 2004
711 (defvar *mailbox-lock* (mp:make-process-lock :name "mailbox lock"))
712
713 (defstruct (mailbox (:conc-name mailbox.))
564f63c * swank-allegro.lisp:(receive-if): Periodically check for interrupts.
Helmut Eller authored Aug 7, 2008
714 (lock (mp:make-process-lock :name "process mailbox"))
715 (queue '() :type list)
5b361b3 Fix typo.
Helmut Eller authored Aug 7, 2008
716 (gate (mp:make-gate nil)))
92d6085 Use signal driven IO for CMUCL and SBCL. Use one thread per request
Helmut Eller authored Jan 31, 2004
717
718 (defun mailbox (thread)
719 "Return THREAD's mailbox."
720 (mp:with-process-lock (*mailbox-lock*)
721 (or (getf (mp:process-property-list thread) 'mailbox)
722 (setf (getf (mp:process-property-list thread) 'mailbox)
723 (make-mailbox)))))
724
725 (defimplementation send (thread message)
564f63c * swank-allegro.lisp:(receive-if): Periodically check for interrupts.
Helmut Eller authored Aug 7, 2008
726 (let* ((mbox (mailbox thread)))
727 (mp:with-process-lock ((mailbox.lock mbox))
728 (setf (mailbox.queue mbox)
729 (nconc (mailbox.queue mbox) (list message)))
730 (mp:open-gate (mailbox.gate mbox)))))
92d6085 Use signal driven IO for CMUCL and SBCL. Use one thread per request
Helmut Eller authored Jan 31, 2004
731
66297c5 * swank-openmcl.lisp (receive-if): Support timeout argument.
Helmut Eller authored Aug 11, 2008
732 (defimplementation receive-if (test &optional timeout)
1812184 Add some flow-control.
Helmut Eller authored Aug 3, 2008
733 (let ((mbox (mailbox mp:*current-process*)))
66297c5 * swank-openmcl.lisp (receive-if): Support timeout argument.
Helmut Eller authored Aug 11, 2008
734 (assert (or (not timeout) (eq timeout t)))
564f63c * swank-allegro.lisp:(receive-if): Periodically check for interrupts.
Helmut Eller authored Aug 7, 2008
735 (loop
736 (check-slime-interrupts)
737 (mp:with-process-lock ((mailbox.lock mbox))
738 (let* ((q (mailbox.queue mbox))
739 (tail (member-if test q)))
740 (when tail
741 (setf (mailbox.queue mbox) (nconc (ldiff q tail) (cdr tail)))
742 (return (car tail)))
743 (mp:close-gate (mailbox.gate mbox))))
66297c5 * swank-openmcl.lisp (receive-if): Support timeout argument.
Helmut Eller authored Aug 11, 2008
744 (when (eq timeout t) (return (values nil t)))
745 (mp:process-wait-with-timeout "receive-if" 0.5
746 #'mp:gate-open-p (mailbox.gate mbox)))))
1812184 Add some flow-control.
Helmut Eller authored Aug 3, 2008
747
bd661cf * swank-backend.lisp (set-default-initial-binding): New function.
Helmut Eller authored Jan 10, 2009
748 (defimplementation set-default-initial-binding (var form)
749 (setq excl:*cl-default-special-bindings*
750 (acons var form excl:*cl-default-special-bindings*)))
751
9decabc See ChangeLog entry 2004-04-06 Marco Baringer
Marco Baringer authored Apr 6, 2004
752 (defimplementation quit-lisp ()
753 (excl:exit 0 :quiet t))
80d90a0 (toggle-trace-generic-function-methods,
Marco Baringer authored Feb 18, 2005
754
18204be (restart-frame): Simplify it a little.
Helmut Eller authored Feb 22, 2005
755
80d90a0 (toggle-trace-generic-function-methods,
Marco Baringer authored Feb 18, 2005
756 ;;Trace implementations
757 ;;In Allegro 7.0, we have:
758 ;; (trace <name>)
759 ;; (trace ((method <name> <qualifier>? (<specializer>+))))
760 ;; (trace ((labels <name> <label-name>)))
761 ;; (trace ((labels (method <name> (<specializer>+)) <label-name>)))
762 ;; <name> can be a normal name or a (setf name)
763
c9f86e2 (toggle-trace): Update tracing code for new interface.
Helmut Eller authored Feb 28, 2005
764 (defimplementation toggle-trace (spec)
b846225 (toggle-trace): Fix from Antonio Menezes Leitao.
Luke Gorrie authored Mar 12, 2005
765 (ecase (car spec)
766 ((setf)
767 (toggle-trace-aux spec))
c9f86e2 (toggle-trace): Update tracing code for new interface.
Helmut Eller authored Feb 28, 2005
768 (:defgeneric (toggle-trace-generic-function-methods (second spec)))
73e84b5 (process-fspec-for-allegro, toggle-trace): Handle setf functions.
Helmut Eller authored Mar 4, 2005
769 ((setf :defmethod :labels :flet)
c9f86e2 (toggle-trace): Update tracing code for new interface.
Helmut Eller authored Feb 28, 2005
770 (toggle-trace-aux (process-fspec-for-allegro spec)))
b846225 (toggle-trace): Fix from Antonio Menezes Leitao.
Luke Gorrie authored Mar 12, 2005
771 (:call
c9f86e2 (toggle-trace): Update tracing code for new interface.
Helmut Eller authored Feb 28, 2005
772 (destructuring-bind (caller callee) (cdr spec)
773 (toggle-trace-aux callee
774 :inside (list (process-fspec-for-allegro caller)))))))
775
776 (defun tracedp (fspec)
73e84b5 (process-fspec-for-allegro, toggle-trace): Handle setf functions.
Helmut Eller authored Mar 4, 2005
777 (member fspec (eval '(trace)) :test #'equal))
c9f86e2 (toggle-trace): Update tracing code for new interface.
Helmut Eller authored Feb 28, 2005
778
779 (defun toggle-trace-aux (fspec &rest args)
780 (cond ((tracedp fspec)
781 (eval `(untrace ,fspec))
782 (format nil "~S is now untraced." fspec))
783 (t
784 (eval `(trace (,fspec ,@args)))
785 (format nil "~S is now traced." fspec))))
786
787 (defun toggle-trace-generic-function-methods (name)
80d90a0 (toggle-trace-generic-function-methods,
Marco Baringer authored Feb 18, 2005
788 (let ((methods (mop:generic-function-methods (fdefinition name))))
c9f86e2 (toggle-trace): Update tracing code for new interface.
Helmut Eller authored Feb 28, 2005
789 (cond ((tracedp name)
80d90a0 (toggle-trace-generic-function-methods,
Marco Baringer authored Feb 18, 2005
790 (eval `(untrace ,name))
791 (dolist (method methods (format nil "~S is now untraced." name))
792 (excl:funtrace (mop:method-function method))))
793 (t
b846225 (toggle-trace): Fix from Antonio Menezes Leitao.
Luke Gorrie authored Mar 12, 2005
794 (eval `(trace (,name)))
c9f86e2 (toggle-trace): Update tracing code for new interface.
Helmut Eller authored Feb 28, 2005
795 (dolist (method methods (format nil "~S is now traced." name))
80d90a0 (toggle-trace-generic-function-methods,
Marco Baringer authored Feb 18, 2005
796 (excl:ftrace (mop:method-function method)))))))
797
798 (defun process-fspec-for-allegro (fspec)
799 (cond ((consp fspec)
800 (ecase (first fspec)
73e84b5 (process-fspec-for-allegro, toggle-trace): Handle setf functions.
Helmut Eller authored Mar 4, 2005
801 ((setf) fspec)
80d90a0 (toggle-trace-generic-function-methods,
Marco Baringer authored Feb 18, 2005
802 ((:defun :defgeneric) (second fspec))
803 ((:defmethod) `(method ,@(rest fspec)))
18204be (restart-frame): Simplify it a little.
Helmut Eller authored Feb 22, 2005
804 ((:labels) `(labels ,(process-fspec-for-allegro (second fspec))
805 ,(third fspec)))
806 ((:flet) `(flet ,(process-fspec-for-allegro (second fspec))
807 ,(third fspec)))))
80d90a0 (toggle-trace-generic-function-methods,
Marco Baringer authored Feb 18, 2005
808 (t
809 fspec)))
b7ebf32 * swank-allegro.lisp (make-weak-key-hash-table): Use ACL's weak
Helmut Eller authored Jul 12, 2006
810
811
812 ;;;; Weak hashtables
813
814 (defimplementation make-weak-key-hash-table (&rest args)
815 (apply #'make-hash-table :weak-keys t args))
816
817 (defimplementation make-weak-value-hash-table (&rest args)
818 (apply #'make-hash-table :values :weak args))
cfdb2c4 (character-completion-set): Implement it.
Matthias Koeppe authored Oct 28, 2006
819
8428f90 Added hash-table-weakness and use it in hash-table-inspecting
Attila Lendvai authored Dec 19, 2006
820 (defimplementation hash-table-weakness (hashtable)
821 (cond ((excl:hash-table-weak-keys hashtable) :key)
822 ((eq (excl:hash-table-values hashtable) :weak) :value)))
823
824
cfdb2c4 (character-completion-set): Implement it.
Matthias Koeppe authored Oct 28, 2006
825
826 ;;;; Character names
827
828 (defimplementation character-completion-set (prefix matchp)
829 (loop for name being the hash-keys of excl::*name-to-char-table*
830 when (funcall matchp prefix name)
831 collect (string-capitalize name)))
Something went wrong with that request. Please try again.