[slime-devel] Temporary maximum debug for compiling defuns
Zach Beane
xach at xach.com
Thu Apr 3 15:22:26 UTC 2008
I don't want to run my whole system with (DEBUG 3), but sometimes I
want to compile an individual function with (DEBUG 3) to e.g. get more
precise source locations in the debugger.
The following is a patch that introduces this to slime, with an
implementation for SBCL: if slime-compile-defun is given a prefix
argument, it passes a request to the backend that the defun be
compiled with maximum debug. The option is ignored on other backends.
Zach
Index: slime.el
===================================================================
RCS file: /project/slime/cvsroot/slime/slime.el,v
retrieving revision 1.913
diff -u -r1.913 slime.el
--- slime.el 24 Feb 2008 16:50:48 -0000 1.913
+++ slime.el 3 Apr 2008 15:16:40 -0000
@@ -3821,6 +3821,9 @@
;;;; Compilation and the creation of compiler-note annotations
+(defvar slime-compile-with-maximum-debug nil
+ "When non-nil compile defuns with maximum debug optimization.")
+
(defvar slime-highlight-compiler-notes t
"*When non-nil annotate buffers with compilation notes etc.")
@@ -3881,10 +3884,11 @@
(slime-rcurry #'slime-compilation-finished (current-buffer)))
(message "Compiling %s..." file)))
-(defun slime-compile-defun ()
+(defun slime-compile-defun (&optional maximum-debug-p)
"Compile the current toplevel form."
- (interactive)
- (apply #'slime-compile-region (slime-region-for-defun-at-point)))
+ (interactive "P")
+ (let ((slime-compile-with-maximum-debug maximum-debug-p))
+ (apply #'slime-compile-region (slime-region-for-defun-at-point))))
(defun slime-compile-region (start end)
"Compile the region."
@@ -3898,7 +3902,8 @@
,string
,(buffer-name)
,start-offset
- ,(if (buffer-file-name) (file-name-directory (buffer-file-name))))
+ ,(if (buffer-file-name) (file-name-directory (buffer-file-name)))
+ ',slime-compile-with-maximum-debug)
(slime-make-compilation-finished-continuation (current-buffer))))
(defun slime-note-count-string (severity count &optional suppress-if-zero)
Index: swank-abcl.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-abcl.lisp,v
retrieving revision 1.48
diff -u -r1.48 swank-abcl.lisp
--- swank-abcl.lisp 22 Feb 2008 14:38:39 -0000 1.48
+++ swank-abcl.lisp 3 Apr 2008 15:16:40 -0000
@@ -341,8 +341,9 @@
(when (and load-p (not fail))
(load fn)))))))
-(defimplementation swank-compile-string (string &key buffer position directory)
- (declare (ignore directory))
+(defimplementation swank-compile-string (string &key buffer position directory
+ debug)
+ (declare (ignore directory debug))
(let ((jvm::*resignal-compiler-warnings* t)
(*abcl-signaled-conditions* nil))
(handler-bind ((warning #'handle-compiler-warning))
Index: swank-allegro.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-allegro.lisp,v
retrieving revision 1.101
diff -u -r1.101 swank-allegro.lisp
--- swank-allegro.lisp 9 Feb 2008 18:47:05 -0000 1.101
+++ swank-allegro.lisp 3 Apr 2008 15:16:40 -0000
@@ -314,7 +314,9 @@
(when binary-filename
(delete-file binary-filename))))))
-(defimplementation swank-compile-string (string &key buffer position directory)
+(defimplementation swank-compile-string (string &key buffer position directory
+ debug)
+ (declare (ignore debug))
;; We store the source buffer in excl::*source-pathname* as a string
;; of the form <buffername>;<start-offset>. Quite ugly encoding, but
;; the fasl file is corrupted if we use some other datatype.
Index: swank-backend.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-backend.lisp,v
retrieving revision 1.129
diff -u -r1.129 swank-backend.lisp
--- swank-backend.lisp 9 Feb 2008 18:47:05 -0000 1.129
+++ swank-backend.lisp 3 Apr 2008 15:16:41 -0000
@@ -333,7 +333,7 @@
(declare (ignore ignore))
`(call-with-compilation-hooks (lambda () (progn , at body))))
-(definterface swank-compile-string (string &key buffer position directory)
+(definterface swank-compile-string (string &key buffer position directory debug)
"Compile source from STRING. During compilation, compiler
conditions must be trapped and resignalled as COMPILER-CONDITIONs.
@@ -344,7 +344,11 @@
If DIRECTORY is specified it may be used by certain implementations to
rebind *DEFAULT-PATHNAME-DEFAULTS* which may improve the recording of
-source information.")
+source information.
+
+If DEBUG is supplied, it may be used by certain implementations to
+compile with maximum debugging information.
+")
(definterface swank-compile-file (filename load-p external-format)
"Compile FILENAME signalling COMPILE-CONDITIONs.
Index: swank-clisp.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-clisp.lisp,v
retrieving revision 1.68
diff -u -r1.68 swank-clisp.lisp
--- swank-clisp.lisp 22 Feb 2008 14:11:52 -0000 1.68
+++ swank-clisp.lisp 3 Apr 2008 15:16:41 -0000
@@ -573,8 +573,9 @@
(load fasl-file))
nil))))
-(defimplementation swank-compile-string (string &key buffer position directory)
- (declare (ignore directory))
+(defimplementation swank-compile-string (string &key buffer position directory
+ debug)
+ (declare (ignore directory debug))
(with-compilation-hooks ()
(let ((*buffer-name* buffer)
(*buffer-offset* position))
Index: swank-cmucl.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-cmucl.lisp,v
retrieving revision 1.178
diff -u -r1.178 swank-cmucl.lisp
--- swank-cmucl.lisp 9 Feb 2008 18:47:05 -0000 1.178
+++ swank-cmucl.lisp 3 Apr 2008 15:16:41 -0000
@@ -347,8 +347,9 @@
(when load-p (load output-file)))
(values output-file warnings-p failure-p)))))
-(defimplementation swank-compile-string (string &key buffer position directory)
- (declare (ignore directory))
+(defimplementation swank-compile-string (string &key buffer position directory
+ debug)
+ (declare (ignore directory debug))
(with-compilation-hooks ()
(let ((*buffer-name* buffer)
(*buffer-start-position* position)
Index: swank-corman.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-corman.lisp,v
retrieving revision 1.15
diff -u -r1.15 swank-corman.lisp
--- swank-corman.lisp 9 Feb 2008 18:47:05 -0000 1.15
+++ swank-corman.lisp 3 Apr 2008 15:16:41 -0000
@@ -373,8 +373,9 @@
(when load-p
(load (compile-file-pathname *compile-filename*))))))
-(defimplementation swank-compile-string (string &key buffer position directory)
- (declare (ignore directory))
+(defimplementation swank-compile-string (string &key buffer position directory
+ debug)
+ (declare (ignore directory debug))
(with-compilation-hooks ()
(let ((*buffer-name* buffer)
(*buffer-position* position)
Index: swank-ecl.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-ecl.lisp,v
retrieving revision 1.14
diff -u -r1.14 swank-ecl.lisp
--- swank-ecl.lisp 9 Feb 2008 18:47:05 -0000 1.14
+++ swank-ecl.lisp 3 Apr 2008 15:16:41 -0000
@@ -129,8 +129,9 @@
(compile-file *compile-filename*)
(when load-p (unless fail (load fn)))))))
-(defimplementation swank-compile-string (string &key buffer position directory)
- (declare (ignore directory))
+(defimplementation swank-compile-string (string &key buffer position directory
+ debug)
+ (declare (ignore directory debug))
(with-compilation-hooks ()
(let ((*buffer-name* buffer)
(*buffer-start-position* position)
Index: swank-lispworks.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-lispworks.lisp,v
retrieving revision 1.97
diff -u -r1.97 swank-lispworks.lisp
--- swank-lispworks.lisp 10 Feb 2008 08:32:04 -0000 1.97
+++ swank-lispworks.lisp 3 Apr 2008 15:16:41 -0000
@@ -558,8 +558,9 @@
nil)))
htab))
-(defimplementation swank-compile-string (string &key buffer position directory)
- (declare (ignore directory))
+(defimplementation swank-compile-string (string &key buffer position directory
+ debug)
+ (declare (ignore directory debug))
(assert buffer)
(assert position)
(let* ((location (list :emacs-buffer buffer position string))
Index: swank-openmcl.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-openmcl.lisp,v
retrieving revision 1.124
diff -u -r1.124 swank-openmcl.lisp
--- swank-openmcl.lisp 9 Feb 2008 18:47:05 -0000 1.124
+++ swank-openmcl.lisp 3 Apr 2008 15:16:41 -0000
@@ -426,8 +426,9 @@
(mapcan 'who-specializes (ccl::%class-direct-subclasses class)))
:test 'equal))
-(defimplementation swank-compile-string (string &key buffer position directory)
- (declare (ignore directory))
+(defimplementation swank-compile-string (string &key buffer position directory
+ debug)
+ (declare (ignore directory debug))
(with-compilation-hooks ()
(let ((*buffer-name* buffer)
(*buffer-offset* position)
Index: swank-sbcl.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-sbcl.lisp,v
retrieving revision 1.191
diff -u -r1.191 swank-sbcl.lisp
--- swank-sbcl.lisp 9 Feb 2008 18:47:05 -0000 1.191
+++ swank-sbcl.lisp 3 Apr 2008 15:16:41 -0000
@@ -435,11 +435,15 @@
"Return a temporary file name to compile strings into."
(concatenate 'string (tmpnam nil) ".lisp"))
-(defimplementation swank-compile-string (string &key buffer position directory)
+(defimplementation swank-compile-string (string &key buffer position directory
+ debug)
(let ((*buffer-name* buffer)
(*buffer-offset* position)
(*buffer-substring* string)
- (filename (temp-file-name)))
+ (filename (temp-file-name))
+ (old-min-debug (assoc 'debug (sb-ext:restrict-compiler-policy))))
+ (when debug
+ (sb-ext:restrict-compiler-policy 'debug 3))
(flet ((compile-it (fn)
(with-compilation-hooks ()
(with-compilation-unit
@@ -455,6 +459,7 @@
(compile-it #'load)
(load (compile-it #'identity)))
(ignore-errors
+ (sb-ext:restrict-compiler-policy 'debug (or old-min-debug 0))
(delete-file filename)
(delete-file (compile-file-pathname filename)))))))
Index: swank-scl.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-scl.lisp,v
retrieving revision 1.18
diff -u -r1.18 swank-scl.lisp
--- swank-scl.lisp 10 Feb 2008 08:32:04 -0000 1.18
+++ swank-scl.lisp 3 Apr 2008 15:16:41 -0000
@@ -391,8 +391,9 @@
(when load-p (load output-file)))
(values output-file warnings-p failure-p)))))
-(defimplementation swank-compile-string (string &key buffer position directory)
- (declare (ignore directory))
+(defimplementation swank-compile-string (string &key buffer position directory
+ debug)
+ (declare (ignore directory debug))
(with-compilation-hooks ()
(let ((*buffer-name* buffer)
(*buffer-start-position* position)
Index: swank.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank.lisp,v
retrieving revision 1.537
diff -u -r1.537 swank.lisp
--- swank.lisp 25 Feb 2008 17:17:56 -0000 1.537
+++ swank.lisp 3 Apr 2008 15:16:41 -0000
@@ -2222,7 +2222,7 @@
(or (guess-external-format filename)
:default)))))))
-(defslimefun compile-string-for-emacs (string buffer position directory)
+(defslimefun compile-string-for-emacs (string buffer position directory debug)
"Compile STRING (exerpted from BUFFER at POSITION).
Record compiler notes signalled as `compiler-condition's."
(with-buffer-syntax ()
@@ -2230,7 +2230,8 @@
(lambda ()
(let ((*compile-print* nil) (*compile-verbose* t))
(swank-compile-string string :buffer buffer :position position
- :directory directory))))))
+ :directory directory
+ :debug debug))))))
(defun file-newer-p (new-file old-file)
"Returns true if NEW-FILE is newer than OLD-FILE."
More information about the slime-devel
mailing list