Mercurial > hg > xemacs-beta

comparison lisp/ilisp/ild.mail @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children b82b59fe008d
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 From @yonge.csri.toronto.edu:qobi@csri.toronto.edu Sun Jul 3 00:43:43 1994
2 From: Jeffrey Mark Siskind <qobi@csri.toronto.edu>
3 To: rfb@lehman.com (Rick Busdiecker)
4 Cc: marcoxa@cs.NYU.EDU
5 In-Reply-To: rfb@lehman.com's message of Wed, 29 Jun 1994 19:21:41 GMT
6 Subject: ILISP
7 Reply-To: Qobi@CS.Toronto.EDU
8 Date: Sun, 3 Jul 1994 00:43:19 -0400
9
10 I think it is great that you are willing to maintain ILisp. ILisp is the most
11 viable Lisp development environment available. I use it many hours a day.
12
13 I'd like to contribute an addition to ILisp. I wrote a package that uses a
14 standard set of single-keystroke bindings to interface with a variety of
15 different debuggers. It is vaguely modelled after the Symbolics debugger. It
16 provides two key advantages: single keystrokes for moving up and down the
17 stack, and a uniform interface to different debuggers. I find that useful
18 since I often work simultaneously with different Lisps and can never remember
19 the particulars of each one's debugger.
20
21 Anyway, I think that it would be of great use to others. It shouldn't take you
22 very long to `officially' integrate it with ILisp. It basically works already
23 with Lucid, Allegro, CMUCL, and AKCL and is fairly reliable. I've used it for
24 years already. Not all debugger commands are available in all implementations.
25 Some are but I didn't know how to get them to work. These are noted in the
26 code. If you know how to fix them that would be great.
27
28 I also have written an improved debugger for use with Scheme->C along with an
29 interface between that debugger and ILD. There are still some problems that I
30 have to iron out though before I release that code.
31
32 I hereby give you permission to distribute this code to anyone subject to the
33 restrictions that it is available on an as is basis with no guarantee of its
34 correctness of suitability for any purpose, that I am not held liable for
35 damages resulting from its use, and that I be given credit by name for this
36 contribution.
37 Jeff (home page http://www.cdf.toronto.edu:/DCS/Personal/Siskind.html)
38 -------------------------------------------------------------------------------
39 ;;; ILD: A common Common Lisp debugger user interface for ILisp.
40 ;;; ---Jeffrey Mark Siskind
41
42 ;;; Keystroke c-u? What it does
43 ;;; ---------------------------------------------------------
44 ;;; m-a Abort
45 ;;; m-c Continue
46 ;;; c-m-n * Next stack frame
47 ;;; c-m-p * Previous stack frame
48 ;;; c-c < Top stack frame
49 ;;; c-c > Bottom stack frame
50 ;;; m-b Backtrace
51 ;;; c-m-d Display all locals
52 ;;; c-m-l * Display particular local
53 ;;; c-c r Return
54 ;;; c-m-r Retry
55 ;;; c-x t Trap on exit
56 ;;; c-c L Select Lisp interaction buffer
57 ;;; c-z c-s Sets compiler options for maximally debuggablity
58 ;;; c-z c-f Sets compiler options for fastest but least debuggable code
59
60 (require 'ilisp)
61
62 (deflocal ild-abort-string nil)
63 (deflocal ild-continue-string nil)
64 (deflocal ild-next-string nil)
65 (deflocal ild-next-string-arg nil)
66 (deflocal ild-previous-string nil)
67 (deflocal ild-previous-string-arg nil)
68 (deflocal ild-top-string nil)
69 (deflocal ild-bottom-string nil)
70 (deflocal ild-backtrace-string nil)
71 (deflocal ild-locals-string nil)
72 (deflocal ild-local-string-arg nil)
73 (deflocal ild-return-string nil)
74 (deflocal ild-retry-string nil)
75 (deflocal ild-trap-on-exit-string nil)
76
77 (defun ild-debugger-command (string)
78 (process-send-string (get-buffer-process (current-buffer))
79 (format "%s\n" string)))
80
81 (defun ild-prompt ()
82 (save-excursion
83 (beginning-of-line)
84 (comint-skip-prompt)
85 (eobp)))
86
87 (defun ild-abort ()
88 (interactive)
89 (if ild-abort-string
90 (ild-debugger-command ild-abort-string)
91 (beep)))
92
93 (defun ild-continue (&optional arg)
94 (interactive "P")
95 (if (ild-prompt)
96 (if ild-continue-string
97 (ild-debugger-command ild-continue-string)
98 (beep))
99 (if arg (capitalize-word arg) (capitalize-word 1))))
100
101 (defun ild-next (&optional arg)
102 (interactive "P")
103 (if arg
104 (if ild-next-string-arg
105 (ild-debugger-command (format ild-next-string-arg arg))
106 (beep))
107 (if ild-next-string
108 (ild-debugger-command ild-next-string)
109 (beep))))
110
111 (defun ild-previous (&optional arg)
112 (interactive "P")
113 (if arg
114 (if ild-previous-string-arg
115 (ild-debugger-command (format ild-previous-string-arg arg))
116 (beep))
117 (if ild-previous-string
118 (ild-debugger-command ild-previous-string)
119 (beep))))
120
121 (defun ild-top (&optional arg)
122 (interactive "P")
123 (if ild-top-string
124 (ild-debugger-command ild-top-string)
125 (beep)))
126
127 (defun ild-bottom (&optional arg)
128 (interactive "P")
129 (if ild-bottom-string
130 (ild-debugger-command ild-bottom-string)
131 (beep)))
132
133 (defun ild-backtrace (&optional arg)
134 (interactive "P")
135 (if (ild-prompt)
136 (if ild-backtrace-string
137 (ild-debugger-command ild-backtrace-string)
138 (beep))
139 (if arg (backward-word arg) (backward-word 1))))
140
141 (defun ild-locals (&optional arg)
142 (interactive "P")
143 (if ild-locals-string
144 (ild-debugger-command ild-locals-string)
145 (beep)))
146
147 (defun ild-local (&optional arg)
148 (interactive "P")
149 (if arg
150 (if ild-local-string-arg
151 (ild-debugger-command (format ild-local-string-arg arg))
152 (beep))
153 (if ild-locals-string
154 (ild-debugger-command ild-locals-string)
155 (beep))))
156
157 (defun ild-return ()
158 (interactive)
159 (if ild-return-string
160 (ild-debugger-command ild-return-string)
161 (beep)))
162
163 (defun ild-retry ()
164 (interactive)
165 (if ild-retry-string
166 (ild-debugger-command ild-retry-string)
167 (beep)))
168
169 (defun ild-trap-on-exit (&optional arg)
170 (interactive "P")
171 (if ild-trap-on-exit-string
172 (ild-debugger-command ild-trap-on-exit-string)
173 (beep)))
174
175 (defun fast-lisp ()
176 "Use the production compiler."
177 (interactive)
178 (ilisp-send "(progn (proclaim '(optimize (speed 3) (safety 0) (space 0) (compilation-speed 0) (debug 0))) #+akcl (use-fast-links t))"))
179
180 (defun slow-lisp ()
181 "Use the development compiler."
182 (interactive)
183 (ilisp-send "(progn (proclaim '(optimize (speed 0) (safety 3) (space 3) (compilation-speed 3) (debug 3))) #+akcl (use-fast-links nil))"))
184
185 (defun select-lisp ()
186 "Select the lisp buffer in one window mode"
187 (interactive)
188 (cond ((and (lisp-mem ilisp-buffer
189 (buffer-list)
190 (function (lambda (x y) (equal x (buffer-name y)))))
191 (get-buffer-process (get-buffer ilisp-buffer)))
192 (delete-other-windows)
193 (switch-to-buffer ilisp-buffer))
194 (t (lucid) ;put your favorite Lisp here
195 (delete-other-windows))))
196
197 (defun select-ilisp (arg)
198 "Select the current ILISP buffer."
199 (interactive "P")
200 (if (and (not arg)
201 (lisp-mem
202 (buffer-name (current-buffer))
203 ilisp-buffers
204 (function (lambda (x y) (equal x (format "*%s*" (car y)))))))
205 (setq ilisp-buffer (buffer-name (current-buffer)))
206 (let ((new (completing-read
207 (if ilisp-buffer
208 (format "Buffer [%s]: "
209 (substring ilisp-buffer 1
210 (1- (length ilisp-buffer))))
211 "Buffer: ")
212 ilisp-buffers nil t)))
213 (if (not (zerop (length new)))
214 (setq ilisp-buffer (format "*%s*" new))))))
215
216 ;;; This fixes a bug in ILISP 4.1
217
218 (defun defkey-ilisp (key command &optional inferior-only)
219 "Define KEY as COMMAND in ilisp-mode-map and lisp-mode-map unless
220 optional INFERIOR-ONLY is T. If the maps do not exist they will be
221 created. This should only be called after ilisp-prefix is set to the
222 desired prefix."
223 (if (not ilisp-mode-map) (ilisp-bindings))
224 (define-key ilisp-mode-map key command)
225 (if (not inferior-only) (define-key lisp-mode-map key command)))
226
227 ;;; This is a convenient command since c-Z c-W doesn't default to the whole
228 ;;; buffer if there is no region
229
230 (defun compile-buffer ()
231 "Compile the current buffer"
232 (interactive)
233 (compile-region-and-go-lisp (point-min) (point-max)))
234
235 (defkey-ilisp "\M-a" 'ild-abort t)
236 (defkey-ilisp "\M-c" 'ild-continue t)
237 (defkey-ilisp "\C-\M-n" 'ild-next t)
238 (defkey-ilisp "\C-\M-p" 'ild-previous t)
239 (defkey-ilisp "\C-c<" 'ild-top t)
240 (defkey-ilisp "\C-c>" 'ild-bottom t)
241 (defkey-ilisp "\M-b" 'ild-backtrace t)
242 (defkey-ilisp "\C-\M-d" 'ild-locals t)
243 (defkey-ilisp "\C-\M-l" 'ild-local t)
244 (defkey-ilisp "\C-cr" 'ild-return t)
245 (defkey-ilisp "\C-\M-r" 'ild-retry t)
246 (defkey-ilisp "\C-xt" 'ild-trap-on-exit t)
247 (define-key global-map "\C-cL" 'select-lisp)
248 (ilisp-defkey lisp-mode-map "\C-f" 'fast-lisp)
249 (ilisp-defkey ilisp-mode-map "\C-f" 'fast-lisp)
250 (ilisp-defkey lisp-mode-map "\C-s" 'slow-lisp)
251 (ilisp-defkey ilisp-mode-map "\C-s" 'slow-lisp)
252
253 (defdialect clisp "Common LISP" ilisp
254 (setq ilisp-load-or-send-command
255 "(or (and (load \"%s\" :if-does-not-exist nil) t)
256 (and (load \"%s\" :if-does-not-exist nil) t))")
257 (ilisp-load-init 'clisp "clisp")
258 (setq ilisp-package-regexp "^[ \t]*(in-package[ \t\n]*"
259 ilisp-package-command "(let ((*package* *package*)) %s (package-name *package*))"
260 ilisp-package-name-command "(package-name *package*)"
261 ilisp-in-package-command "(in-package \"%s\")"
262 ilisp-last-command "*"
263 ilisp-save-command "(progn (ILISP:ilisp-save) %s\n)"
264 ilisp-restore-command "(ILISP:ilisp-restore)"
265 ilisp-block-command "(progn %s\n)"
266 ilisp-eval-command "(ILISP:ilisp-eval \"%s\" \"%s\" \"%s\")"
267 ilisp-defvar-regexp "(defvar[ \t\n]")
268 (setq ilisp-defvar-command
269 "(ILISP:ilisp-eval \"(let ((form '%s)) (progn (makunbound (second form)) (eval form)))\" \"%s\" \"%s\")")
270 (setq ilisp-compile-command "(ILISP:ilisp-compile \"%s\" \"%s\" \"%s\")"
271 ilisp-describe-command "(ILISP:ilisp-describe \"%s\" \"%s\")"
272 ilisp-inspect-command "(ILISP:ilisp-inspect \"%s\" \"%s\")"
273 ilisp-arglist-command "(ILISP:ilisp-arglist \"%s\" \"%s\")")
274 (setq ilisp-documentation-types
275 '(("function") ("variable")
276 ("structure") ("type")
277 ("setf") ("class")
278 ("(qualifiers* (class ...))")))
279 (setq ilisp-documentation-command
280 "(ILISP:ilisp-documentation \"%s\" \"%s\" \"%s\")")
281 (setq ilisp-macroexpand-1-command
282 "(ILISP:ilisp-macroexpand-1 \"%s\" \"%s\")")
283 (setq ilisp-macroexpand-command "(ILISP:ilisp-macroexpand \"%s\" \"%s\")")
284 (setq ilisp-complete-command
285 "(ILISP:ilisp-matching-symbols \"%s\" \"%s\" %s %s %s)")
286 (setq ilisp-locator 'lisp-locate-clisp)
287 (setq ilisp-source-types
288 '(("function") ("macro") ("variable")
289 ("structure") ("type")
290 ("setf") ("class")
291 ("(qualifiers* (class ...))")))
292 (setq ilisp-callers-command "(ILISP:ilisp-callers \"%s\" \"%s\")"
293 ilisp-trace-command "(ILISP:ilisp-trace \"%s\" \"%s\" \"%s\")"
294 ilisp-untrace-command "(ILISP:ilisp-untrace \"%s\" \"%s\")")
295 (setq ilisp-directory-command "(namestring *default-pathname-defaults*)"
296 ilisp-set-directory-command
297 "(setq *default-pathname-defaults* (parse-namestring \"%s\"))")
298 (setq ilisp-load-command "(load \"%s\")")
299 (setq ilisp-compile-file-command
300 "(ILISP:ilisp-compile-file \"%s\" \"%s\")"))
301
302 (defdialect lucid "Lucid Common LISP" clisp
303 (ilisp-load-init 'lucid "lucid")
304 (setq comint-prompt-regexp "^\\(->\\)+ \\|^[^> ]*> "
305 comint-fix-error ":a"
306 ilisp-reset ":a :t"
307 comint-continue ":c"
308 comint-interrupt-regexp ">>Break: Keyboard interrupt"
309 comint-prompt-status
310 (function (lambda (old line)
311 (comint-prompt-status old line 'lucid-check-prompt))))
312 (setq ilisp-error-regexp "ILISP:[^\"]*\\|>>[^\n]*")
313 (setq ilisp-source-types (append ilisp-source-types '(("any"))))
314 (setq ilisp-find-source-command
315 "(ILISP:ilisp-source-files \"%s\" \"%s\" \"%s\")")
316 (setq ilisp-binary-command
317 "(first (last lucid::*load-binary-pathname-types*))")
318 (setq ild-abort-string ":A"
319 ild-continue-string ":C"
320 ild-next-string ":N"
321 ild-next-string-arg ":N %s"
322 ild-previous-string ":P"
323 ild-previous-string-arg ":P %s"
324 ild-top-string ":<"
325 ild-bottom-string ":>"
326 ild-backtrace-string ":B"
327 ild-locals-string ":V"
328 ild-local-string-arg ":L %s"
329 ild-return-string ":R"
330 ild-retry-string ":F"
331 ild-trap-on-exit-string ":X T"))
332 (setq lucid-program "lisp")
333
334 (defdialect allegro "Allegro Common LISP" clisp
335 (ilisp-load-init 'allegro "allegro")
336 (setq comint-fix-error ":pop"
337 ilisp-reset ":reset"
338 comint-continue ":cont"
339 comint-interrupt-regexp "Error: [^\n]* interrupt\)")
340 (setq comint-prompt-status
341 (function (lambda (old line)
342 (comint-prompt-status old line 'allegro-check-prompt))))
343 ;; <cl> or package> at top-level
344 ;; [0-9c] <cl> or package> in error
345 ;; (setq comint-prompt-regexp "^\\(\\[[0-9]*c*\\] \\|\\)\\(<\\|\\)[^>]*> ")
346 (setq comint-prompt-regexp "^\\(\\[[0-9]+i?c?\\] \\|\\[step\\] \\)?\\(<?[-A-Za-z]* ?[0-9]*?>\\|[-A-Za-z0-9]+([0-9]+):\\) ")
347 (setq ilisp-error-regexp
348 "\\(ILISP:[^\"]*\\)\\|\\(Error:[^\n]*\\)\\|\\(Break:[^\n]*\\)")
349
350 (setq ilisp-binary-command "excl:*fasl-default-type*")
351 (setq ilisp-source-types (append ilisp-source-types '(("any"))))
352 (setq ilisp-find-source-command
353 "(ILISP:ilisp-source-files \"%s\" \"%s\" \"%s\")")
354 (setq ilisp-init-binary-command
355 "(let ((ext (or #+m68k \"68fasl\"
356 #+sparc \"sfasl\"
357 #+iris4d \"ifasl\"
358 #+dec3100 \"pfasl\"
359 excl:*fasl-default-type*)))
360 #+allegro-v4.0 (setq ext (concatenate 'string ext \"4\"))
361 ext)")
362 (setq ild-abort-string ":pop"
363 ild-continue-string ":cont"
364 ild-next-string ":dn"
365 ild-next-string-arg ":dn %s"
366 ild-previous-string ":up"
367 ild-previous-string-arg ":up %s"
368 ild-top-string ":to"
369 ild-bottom-string ":bo"
370 ild-backtrace-string ":bt"
371 ild-locals-string ":local"
372 ild-local-string-arg ":local %s"
373 ild-return-string nil ;needs work
374 ild-retry-string ":rest"
375 ild-trap-on-exit-string ":boe"))
376 (setq allegro-program "cl")
377
378 (defdialect akcl "Austin Kyoto Common LISP" kcl
379 (setq comint-prompt-regexp "^[-A-Z]*>+")
380 (setq ild-abort-string ":q"
381 ild-continue-string ":r"
382 ild-next-string ":up"
383 ild-next-string-arg ":up %s"
384 ild-previous-string ":down"
385 ild-previous-string-arg ":down %s"
386 ild-top-string ":down 1000000"
387 ild-bottom-string ":up 1000000"
388 ild-backtrace-string ":bt"
389 ild-locals-string ":fr"
390 ild-local-string-arg ":loc %s"
391 ild-return-string ":r"
392 ild-retry-string nil ;needs work
393 ild-trap-on-exit-string nil)) ;needs work
394 (setq akcl-program "akcl")
395
396 (defdialect cmulisp "CMU Common LISP" clisp
397 (ilisp-load-init 'cmu "cmulisp")
398 (if cmulisp-local-source-directory
399 (setq ilisp-source-directory-fixup-alist
400 (list
401 (cons cmulisp-source-directory-regexp
402 cmulisp-local-source-directory)))
403 (message "cmulisp-local-source-directory not set."))
404 (setq comint-prompt-regexp "^\\([0-9]+\\]+\\|\\*\\) "
405 ilisp-trace-command "(ILISP:cmulisp-trace \"%s\" \"%s\" \"%s\")"
406 comint-prompt-status
407 (function (lambda (old line)
408 (comint-prompt-status old line 'cmulisp-check-prompt)))
409 ilisp-error-regexp "ILISP:[^\"]*\\|Error [^\n]*"
410 ilisp-arglist-command "(ILISP:arglist \"%s\" \"%s\")"
411 ilisp-find-source-command "(ILISP:source-file \"%s\" \"%s\" \"%s\")"
412 comint-fix-error ":pop"
413 comint-continue ":go"
414 ilisp-reset ":q"
415 comint-interrupt-regexp "Interrupted at"
416 ilisp-binary-extension "sparcf")
417 (setq ild-abort-string ":abort"
418 ild-continue-string ":go"
419 ild-next-string ":down"
420 ild-next-string-arg nil ;needs work
421 ild-previous-string ":up"
422 ild-previous-string-arg nil ;needs work
423 ild-top-string ":bottom"
424 ild-bottom-string ":top"
425 ild-backtrace-string ":backtrace"
426 ild-locals-string ":l"
427 ild-local-string-arg "(debug:arg %s)"
428 ild-return-string nil ;needs work (debug:debug-return x)
429 ild-retry-string nil ;needs work
430 ild-trap-on-exit-string nil)) ;needs work
431 (setq cmulisp-program "cmucl")
432
433