Nov 16, 2008, 3:35:28 PM (13 years ago)

Finish source location and pc -> source mapping support, from working-0711 but with some modifications.


Source location are recorded in CCL:SOURCE-NOTE's, which are objects with accessors CCL:SOURCE-NOTE-FILENAME, CCL:SOURCE-NOTE-START-POS, CCL:SOURCE-NOTE-END-POS and CCL:SOURCE-NOTE-TEXT. The start and end positions are file positions (not character positions). The text will be NIL unless text recording was on at read-time. If the original file is still available, you can force missing source text to be read from the file at runtime via CCL:ENSURE-SOURCE-NOTE-TEXT.

Source-note's are associated with definitions (via record-source-file) and also stored in function objects (including anonymous and nested functions). The former can be retrieved via CCL:FIND-DEFINITION-SOURCES, the latter via CCL:FUNCTION-SOURCE-NOTE.

The recording behavior is controlled by the new variable CCL:*SAVE-SOURCE-LOCATIONS*:

If NIL, don't store source-notes in function objects, and store only the filename for definitions (the latter only if *record-source-file* is true).
If T, store source-notes, including a copy of the original source text, for function objects and definitions (the latter only if *record-source-file* is true).
If :NO-TEXT, store source-notes, but without saved text, for function objects and defintions (the latter only if *record-source-file* is true). This is the default.

PC to source mapping is controlled by the new variable CCL:*RECORD-PC-MAPPING*. If true (the default), functions store a compressed table mapping pc offsets to corresponding source locations. This can be retrieved by (CCL:FIND-SOURCE-NOTE-AT-PC function pc) which returns a source-note for the source at offset pc in the function.

Currently the only thing that makes use of any of this is the disassembler. ILISP and current version of Slime still use backward-compatible functions that deal with filenames only. The plan is to make Slime, and our IDE, use this eventually.

Known bug: most of this only works through the file compiler. Still need to make it work with loading from source (not hard, just haven't gotten to it yet).

This checkin incidentally includes bits and pieces of support for code coverage, which is still
incomplete and untested. Ignore it.

The PPC version is untested. I need to check it in so I can move to a PPC for testing.


18387152 Nov 16 10:00 lx86cl64.image-no-loc-no-pc
19296464 Nov 16 10:11 lx86cl64.image-loc-no-text-no-pc
20517072 Nov 16 09:58 lx86cl64.image-loc-no-text-with-pc [default]
25514192 Nov 16 09:55 lx86cl64.image-loc-with-text-with-pc

1 edited


  • trunk/source/compiler/X86/x86-disassemble.lisp

    r11266 r11373  
    27232723      usual)))
    2726 (defun x86-print-disassembled-instruction (ds instruction seq)
     2725(defvar *previous-source-note*)
     2727(defun x86-print-disassembled-instruction (ds instruction seq function)
    27272728  (let* ((addr (x86-di-address instruction))
    2728          (entry (x86-ds-entry-point ds)))
     2729         (entry (x86-ds-entry-point ds))
     2730         (pc (- addr entry)))
     2731    (let ((source-note (find-source-note-at-pc function pc)))
     2732      (unless (eql (source-note-file-range source-note)
     2733                   (source-note-file-range *previous-source-note*))
     2734        (setf *previous-source-note* source-note)
     2735        (let* ((source-text (source-note-text source-note))
     2736               (text (if source-text
     2737                       (string-sans-most-whitespace source-text 100)
     2738                       "#<no source text>")))
     2739          (format t "~&~%;;; ~A" text))))
    27292740    (when (x86-di-labeled instruction)
    2730       (format t "~&L~d~&" (- addr entry))
     2741      (format t "~&L~d~%" pc)
    27312742      (setq seq 0))
     2743    (format t "~&  [~D]~8T" pc)
    27322744    (dolist (p (x86-di-prefixes instruction))
    27332745      (format t "~&  (~a)~%" p))
    2734     (format t "~&  (~a" (x86-di-mnemonic instruction))
     2746    (format t "  (~a" (x86-di-mnemonic instruction))
    27352747    (let* ((op0 (x86-di-op0 instruction))
    27362748           (op1 (x86-di-op1 instruction))
    27432755            (format t " ~a" (unparse-x86-lap-operand op2 ds))))))
    27442756    (format t ")")
    2745     (unless (zerop seq) ;(when (oddp seq)
    2746       (format t "~50t;[~d]" (- addr entry)))
    27472757    (format t "~%")
    27482758    (1+ seq)))
    2751 (defun x8664-disassemble-xfunction (xfunction &key (symbolic-names
    2752                                                          x8664::*x8664-symbolic-register-names*) (collect-function #'x86-print-disassembled-instruction))
     2760(defun x86-print-disassembled-function-header (function xfunction)
     2761  (declare (ignore xfunction))
     2762  (let ((source-note (function-source-note function)))
     2763    (when source-note
     2764      (format t ";; Source: ~S:~D-~D"
     2765              (source-note-filename source-note)
     2766              (source-note-start-pos source-note)
     2767              (source-note-end-pos source-note))
     2768      ;; Fetch source from file if don't already have it.
     2769      (ensure-source-note-text source-note))))
     2771(defun x8664-disassemble-xfunction (function xfunction
     2772                                    &key (symbolic-names x8664::*x8664-symbolic-register-names*)
     2773                                         (collect-function #'x86-print-disassembled-instruction)
     2774                                         (header-function #'x86-print-disassembled-function-header))
    27532775  (check-type xfunction xfunction)
    27542776  (check-type (uvref xfunction 0) (simple-array (unsigned-byte 8) (*)))
    27682790        (or (x86-dis-find-label lab blocks)
    27692791            (x86-disassemble-new-block ds lab))))
    2770     (let* ((seq 0))
     2792    (when (and blocks (let ((something-to-disassemble nil))
     2793                        (do-dll-nodes (block blocks)
     2794                          (do-dll-nodes (instruction (x86-dis-block-instructions block))
     2795                            (setf something-to-disassemble t)))
     2796                        something-to-disassemble))
     2797      (funcall header-function function xfunction))
     2798    (let* ((seq 0)
     2799           (*previous-source-note* nil))
     2800      (declare (special *previous-source-note*))
    27712801      (do-dll-nodes (block blocks)
    27722802        (do-dll-nodes (instruction (x86-dis-block-instructions block))
    2773           (setq seq (funcall collect-function ds instruction seq)))))))
    2775 (defun x8632-disassemble-xfunction (xfunction &key (symbolic-names
    2776                                                          x8632::*x8632-symbolic-register-names*) (collect-function #'x86-print-disassembled-instruction))
     2803          (setq seq (funcall collect-function ds instruction seq function)))))))
     2805(defun x8632-disassemble-xfunction (function xfunction
     2806                                    &key (symbolic-names x8632::*x8632-symbolic-register-names*)
     2807                                         (collect-function #'x86-print-disassembled-instruction)
     2808                                         (header-function #'x86-print-disassembled-function-header))
    27772809  (check-type xfunction xfunction)
    27782810  (check-type (uvref xfunction 0) (simple-array (unsigned-byte 8) (*)))
    27922824        (or (x86-dis-find-label lab blocks)
    27932825            (x86-disassemble-new-block ds lab))))
    2794     (let* ((seq 0))
     2826    (when (and blocks (let ((something-to-disassemble nil))
     2827                        (do-dll-nodes (block blocks)
     2828                          (do-dll-nodes (instruction (x86-dis-block-instructions block))
     2829                            (setf something-to-disassemble t)))
     2830                        something-to-disassemble))
     2831      (funcall header-function function xfunction))
     2832    (let* ((seq 0)
     2833           (*previous-source-note* nil))
     2834      (declare (special *previous-source-note*))
    27952835      (do-dll-nodes (block blocks)
    27962836        (do-dll-nodes (instruction (x86-dis-block-instructions block))
    2797           (setq seq (funcall collect-function ds instruction seq)))))))
     2837          (setq seq (funcall collect-function ds instruction seq function)))))))
    28002840(defun x8664-xdisassemble (function
    2801                            &optional (collect-function #'x86-print-disassembled-instruction))
     2841                           &optional (collect-function #'x86-print-disassembled-instruction)
     2842                                     (header-function #'x86-print-disassembled-function-header))
    28022843  (let* ((fv (%function-to-function-vector function))
    28032844         (function-size-in-words (uvsize fv))
    28142855          (j 1 (1+ j)))
    28152856         ((= k function-size-in-words)
    2816           (x8664-disassemble-xfunction xfunction
    2817                                        :collect-function collect-function))
     2857          (x8664-disassemble-xfunction function xfunction
     2858                                       :collect-function collect-function
     2859                                       :header-function header-function))
    28182860      (declare (fixnum j k))
    28192861      (setf (uvref xfunction j) (uvref fv k)))))
    2822 (defun x8632-xdisassemble (function &optional (collect-function #'x86-print-disassembled-instruction ))
     2864(defun x8632-xdisassemble (function
     2865                           &optional (collect-function #'x86-print-disassembled-instruction)
     2866                                     (header-function #'x86-print-disassembled-function-header))
    28232867  (let* ((fv (function-to-function-vector function))
    28242868         (function-size-in-words (uvsize fv))
    28352879          (j 1 (1+ j)))
    28362880         ((= k function-size-in-words)
    2837           (x8632-disassemble-xfunction xfunction :collect-function collect-function))
     2881          (x8632-disassemble-xfunction function xfunction
     2882                                       :collect-function collect-function
     2883                                       :header-function header-function))
    28382884      (declare (fixnum j k))
    28392885      (setf (uvref xfunction j) (uvref fv k)))))
    28432889    (#+x8632-target x8632-xdisassemble #+x8664-target x8664-xdisassemble
    28442890     function
    2845      #'(lambda (ds instruction seq)
     2891     #'(lambda (ds instruction seq function)
     2892         (declare (ignore function))
    28462893         (collect ((insn))
    28472894           (let* ((addr (x86-di-address instruction))
Note: See TracChangeset for help on using the changeset viewer.