[slime-cvs] CVS update: slime/ChangeLog slime/swank-cmucl.lisp slime/swank-loader.lisp slime/swank-sbcl.lisp slime/b0rk.lisp
Dan Barlow
dbarlow at common-lisp.net
Fri Dec 12 03:22:36 UTC 2003
Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv9576
Modified Files:
ChangeLog swank-cmucl.lisp swank-loader.lisp swank-sbcl.lisp
Removed Files:
b0rk.lisp
Log Message:
* swank-source-path-parser.lisp: new file, excerpting part of
swank-cmucl.lisp to where SBCL can find it as well.
Date: Thu Dec 11 22:22:36 2003
Author: dbarlow
Index: slime/ChangeLog
diff -u slime/ChangeLog:1.153 slime/ChangeLog:1.154
--- slime/ChangeLog:1.153 Thu Dec 11 20:51:29 2003
+++ slime/ChangeLog Thu Dec 11 22:22:36 2003
@@ -1,3 +1,8 @@
+2003-12-12 Daniel Barlow <dan at telent.net>
+
+ * swank-source-path-parser.lisp: new file, excerpting part of
+ swank-cmucl.lisp to where SBCL can find it as well.
+
2003-12-11 Luke Gorrie <luke at bluetail.com>
* slime.el (slime-one-line-ify): New function to convert
Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.38 slime/swank-cmucl.lisp:1.39
--- slime/swank-cmucl.lisp:1.38 Wed Dec 10 21:19:51 2003
+++ slime/swank-cmucl.lisp Thu Dec 11 22:22:36 2003
@@ -848,108 +848,8 @@
(setf *default-pathname-defaults* (pathname (ext:default-directory)))
(namestring (ext:default-directory)))
-
-;;;; Source-paths
-
-;;; CMUCL uses a data structure called "source-path" to locate
-;;; subforms. The compiler assigns a source-path to each form in a
-;;; compilation unit. Compiler notes usually contain the source-path
-;;; of the error location.
-;;;
-;;; Compiled code objects don't contain source paths, only the
-;;; "toplevel-form-number" and the (sub-) "form-number". To get from
-;;; the form-number to the source-path we need the entire toplevel-form
-;;; (i.e. we have to read the source code). CMUCL has already some
-;;; utilities to do this translation, but we use some extended
-;;; versions, because we need more exact position info. Apparently
-;;; Hemlock is happy with the position of the toplevel-form; we also
-;;; need the position of subforms.
-;;;
-;;; We use a special readtable to get the positions of the subforms.
-;;; The readtable stores the start and end position for each subform in
-;;; hashtable for later retrieval.
-
-(defun make-source-recorder (fn source-map)
- "Return a macro character function that does the same as FN, but
-additionally stores the result together with the stream positions
-before and after of calling FN in the hashtable SOURCE-MAP."
- (lambda (stream char)
- (let ((start (file-position stream))
- (values (multiple-value-list (funcall fn stream char)))
- (end (file-position stream)))
- #+(or) (format t "~&[~D ~{~A~^, ~} ~D]~%" start values end)
- (unless (null values)
- (push (cons start end) (gethash (car values) source-map)))
- (values-list values))))
-
-(defun make-source-recording-readtable (readtable source-map)
- "Return a source position recording copy of READTABLE.
-The source locations are stored in SOURCE-MAP."
- (let* ((tab (copy-readtable readtable))
- (*readtable* tab))
- (dotimes (code char-code-limit)
- (let ((char (code-char code)))
- (multiple-value-bind (fn term) (get-macro-character char tab)
- (when fn
- (set-macro-character char (make-source-recorder fn source-map)
- term tab)))))
- tab))
-
-(defun make-source-map ()
- (make-hash-table :test #'eq))
-
-(defvar *source-map* (make-source-map)
- "The hashtable table used for source position recording.")
-
-(defvar *recording-readtable-cache* '()
- "An alist of (READTABLE . RECORDING-READTABLE) pairs.")
-
-(defun lookup-recording-readtable (readtable)
- "Find a cached or create a new recording readtable for READTABLE."
- (or (cdr (assoc readtable *recording-readtable-cache*))
- (let ((table (make-source-recording-readtable readtable *source-map*)))
- (push (cons readtable table) *recording-readtable-cache*)
- table)))
-
-(defun read-and-record-source-map (stream)
- "Read the next object from STREAM.
-Return the object together with a hashtable that maps
-subexpressions of the object to stream positions."
- (let ((*readtable* (lookup-recording-readtable *readtable*)))
- (clrhash *source-map*)
- (values (read stream) *source-map*)))
-
-(defun source-path-stream-position (path stream)
- "Search the source-path PATH in STREAM and return its position."
- (destructuring-bind (tlf-number . path) path
- (let ((*read-suppress* t))
- (dotimes (i tlf-number) (read stream))
- (multiple-value-bind (form source-map)
- (read-and-record-source-map stream)
- (source-path-source-position (cons 0 path) form source-map)))))
-
-(defun source-path-string-position (path string)
- (with-input-from-string (s string)
- (source-path-stream-position path s)))
-
-(defun source-path-file-position (path filename)
- (with-open-file (file filename)
- (source-path-stream-position path file)))
-
-(defun source-path-source-position (path form source-map)
- "Return the start position of PATH form FORM and SOURCE-MAP. All
-subforms along the path are considered and the start and end position
-of deepest (i.e. smallest) possible form is returned."
- ;; compute all subforms along path
- (let ((forms (loop for n in path
- for f = form then (nth n f)
- collect f)))
- ;; select the first subform present in source-map
- (loop for form in (reverse forms)
- for positions = (gethash form source-map)
- until (and positions (null (cdr positions)))
- finally (destructuring-bind ((start . end)) positions
- (return (values (1- start) end))))))
+;;; source-path-{stream,file,string,etc}-position moved into
+;;; swank-source-path-parser
(defun code-location-stream-position (code-location stream)
"Return the byte offset of CODE-LOCATION in STREAM. Extract the
Index: slime/swank-loader.lisp
diff -u slime/swank-loader.lisp:1.7 slime/swank-loader.lisp:1.8
--- slime/swank-loader.lisp:1.7 Sat Dec 6 08:08:52 2003
+++ slime/swank-loader.lisp Thu Dec 11 22:22:36 2003
@@ -7,7 +7,7 @@
;;; This code has been placed in the Public Domain. All warranties
;;; are disclaimed.
;;;
-;;; $Id: swank-loader.lisp,v 1.7 2003/12/06 13:08:52 heller Exp $
+;;; $Id: swank-loader.lisp,v 1.8 2003/12/12 03:22:36 dbarlow Exp $
;;;
(defpackage :swank-loader
@@ -27,8 +27,8 @@
(defparameter *sysdep-pathnames*
(mapcar #'make-swank-pathname
- #+cmu '("swank-cmucl")
- #+sbcl '("swank-sbcl" "swank-gray")
+ #+cmu '("swank-cmucl" "swank-source-path-parser")
+ #+sbcl '("swank-sbcl" "swank-source-path-parser" "swank-gray")
#+openmcl '("swank-openmcl" "swank-gray")
#+lispworks '("swank-lispworks" "swank-gray")
#+allegro '("swank-allegro" "swank-gray")
Index: slime/swank-sbcl.lisp
diff -u slime/swank-sbcl.lisp:1.43 slime/swank-sbcl.lisp:1.44
--- slime/swank-sbcl.lisp:1.43 Thu Dec 11 12:08:55 2003
+++ slime/swank-sbcl.lisp Thu Dec 11 22:22:36 2003
@@ -188,6 +188,8 @@
:message (brief-compiler-message-for-emacs condition context)
:location (compiler-note-location context))))
+
+
(defun compiler-note-location (context)
(cond (context
(resolve-note-location
@@ -207,7 +209,6 @@
`(:file ,(namestring (truename f)))
`(:position ,(1+ (source-path-file-position path f)))))
-;;; FIXME this one's broken: no source-path-string-position
(defmethod resolve-note-location ((b string) (f (eql :stream)) pos path source)
(make-location
`(:buffer ,b)
@@ -505,14 +506,7 @@
(path (code-location-source-path code-location)))
(source-path-file-position path filename)))
-(defun source-path-file-position (path filename)
- (let ((*read-suppress* t))
- (with-open-file (file filename)
- (dolist (n path)
- (dotimes (i n)
- (read file))
- (read-delimited-list #\( file))
- (file-position file))))
+;;; source-path-file-position and friends are in swank-source-path-parser
(defun debug-source-info-from-emacs-buffer-p (debug-source)
(let ((info (sb-c::debug-source-info debug-source)))
More information about the slime-cvs
mailing list