Index: /branches/working-0711/ccl/compiler/X86/x86-disassemble.lisp =================================================================== --- /branches/working-0711/ccl/compiler/X86/x86-disassemble.lisp (revision 8434) +++ /branches/working-0711/ccl/compiler/X86/x86-disassemble.lisp (revision 8435) @@ -2731,5 +2731,5 @@ (text (if source-info (string-sans-most-whitespace - (subseq (getf source-note :text) + (subseq (%fast-uncompact (getf source-note :%text)) (car (getf source-info :source-text-range)) (cdr (getf source-info :source-text-range))) Index: /branches/working-0711/ccl/compiler/X86/x862.lisp =================================================================== --- /branches/working-0711/ccl/compiler/X86/x862.lisp (revision 8434) +++ /branches/working-0711/ccl/compiler/X86/x862.lisp (revision 8435) @@ -661,19 +661,63 @@ (setf (%svref v i) ref-fun))))))))) +(defun pc-source-map-pc-start (source-mapping) + (etypecase source-mapping + (integer (ldb (byte 15 0) source-mapping)) + (vector (aref source-mapping 0)))) + +(defun pc-source-map-pc-end (source-mapping) + (etypecase source-mapping + (integer (ldb (byte 15 15) source-mapping)) + (vector (aref source-mapping 1)))) + +(defun pc-source-map-text-start (source-mapping) + (etypecase source-mapping + (integer (ldb (byte 15 30) source-mapping)) + (vector (aref source-mapping 2)))) + +(defun pc-source-map-text-end (source-mapping) + (etypecase source-mapping + (integer (ldb (byte 15 45) source-mapping)) + (vector (aref source-mapping 3)))) + +(defun small-positive-integer-p (number &optional (biggest-small-value (ash 1 15))) + (< 0 number biggest-small-value)) + +(defun generate-pc-source-mapping (pc-start pc-end text-start text-end) + (if (every #'small-positive-integer-p + (list pc-start pc-end text-start text-end)) + (let ((mapping 0)) + (setf (ldb (byte 15 0) mapping) pc-start + (ldb (byte 15 15) mapping) pc-end + (ldb (byte 15 30) mapping) text-start + (ldb (byte 15 45) mapping) text-end) + mapping) + (vector pc-start pc-end text-start text-end))) + +(defstruct (pc-source-mapping (:type vector)) + pc-start + pc-end + text-start + text-end) + (defun x862-generate-pc-source-map (definition-source-note emitted-source-notes) (when *compiler-record-source* - (let ((def-start (source-note-start definition-source-note))) - (mapcar (lambda (start) - (list :pc-range (cons (x862-vinsn-note-label-address - start - t) - (x862-vinsn-note-label-address - (vinsn-note-peer start) - nil)) - :source-text-range (cons (- (source-note-start (aref (vinsn-note-info start) 0)) - def-start) - (- (source-note-end (aref (vinsn-note-info start) 0)) - def-start)))) - emitted-source-notes)))) + (let ((def-start (source-note-start definition-source-note)) + (vec (make-array (length emitted-source-notes)))) + (flet ((pc-start (note) (aref note )))) + (map-into vec + (lambda (start) + (make-pc-source-mapping :pc-start (x862-vinsn-note-label-address + start + t) + :pc-end (x862-vinsn-note-label-address + (vinsn-note-peer start) + nil) + :text-start (- (source-note-start (aref (vinsn-note-info start) 0)) + def-start) + :text-end (- (source-note-end (aref (vinsn-note-info start) 0)) + def-start))) + emitted-source-notes) + vec))) (defun x862-vinsn-note-label-address (note &optional start-p sym) Index: /branches/working-0711/ccl/compiler/nx0.lisp =================================================================== --- /branches/working-0711/ccl/compiler/nx0.lisp (revision 8434) +++ /branches/working-0711/ccl/compiler/nx0.lisp (revision 8435) @@ -1593,4 +1593,22 @@ string))))) +(defun %fast-compact (string) + (let ((vec (make-array (length string) :element-type '(unsigned-byte 8)))) + (loop + for char across string + for index upfrom 0 + if (<= 0 (char-code char) 255) + do (setf (aref vec index) (char-code char)) + else + do (return-from %fast-compact string)) + vec)) + +(defun %fast-uncompact (data) + (if (stringp data) + data + (let ((string (make-array (length data) :element-type 'character))) + (map-into string #'code-char data) + string))) + (defun record-source-location-on-stream-p (stream) (and *compiler-record-source* @@ -1602,5 +1620,5 @@ start end - text + %text form children) @@ -1612,7 +1630,13 @@ :start (+ start (or *compile-file-original-buffer-offset* 0)) :end (+ end (or *compile-file-original-buffer-offset* 0)) - :text (or text (substream stream start end)) + :%text (%fast-compact (or text (substream stream start end))) :form form :children children))) + +(defmethod source-note-text ((source-note source-note)) + (%fast-uncompact (source-note-%text source-note))) + +(defmethod (setf source-note-text) (text (source-note source-note)) + (setf (source-note-%text source-note) (%fast-compact text))) ;;; we don't actually store source-note structs in the fasl since that runs into problems dumping @@ -1622,5 +1646,5 @@ (append (when start (list :start (source-note-start note))) (when end (list :end (source-note-end note))) - (when text (list :text (source-note-text note))) + (when text (list :%text (source-note-%text note))) (when form (list :form (source-note-form note))) (when children (list :children (source-note-children note))) @@ -1668,17 +1692,18 @@ (let* ((best-guess nil) (best-length nil)) - (dolist (pc-map pc-source-map) - (let ((pc-start (car (getf pc-map :pc-range))) - (pc-end (cdr (getf pc-map :pc-range)))) - (when (<= pc-start pc pc-end) - ;; possible match, see if it's the better than best-guess - (when (or (null best-guess) - (< (- pc-end pc-start) best-length)) - (setf best-guess pc-map - best-length (- pc-end pc-start)))))) - + (loop + for pc-map across pc-source-map + for pc-start = (aref pc-map 0) + for pc-end = (aref pc-map 1) + do (when (and (<= pc-start pc pc-end) + (or (null best-guess) + (< (- pc-end pc-start) best-length))) + (setf best-guess pc-map + best-length (- pc-end pc-start)))) (when best-guess - (list :pc-range (getf best-guess :pc-range) - :source-text-range (getf best-guess :source-text-range) + (list :pc-range (cons (aref best-guess 0) + (aref best-guess 1)) + :source-text-range (cons (aref best-guess 2) + (aref best-guess 3)) :file-name (getf function-source-note :file-name) :text (getf function-source-note :text)))))))