Changeset 8444


Ignore:
Timestamp:
Feb 8, 2008, 10:22:24 AM (12 years ago)
Author:
mb
Message:

More source location optimizations (and one bug fix)

Moved the binding of *definition-source-note* to compile-named-function. This ensures that when emitting source notes
the current value *definition-source-note* is the same one for the code we're compiling (it was not before). This
change also almost halves the number of times we call x862-generate-pc-mapping since we no longer call it for
note-function-info forms generated by defuns.

Merged the helper functions directly into x862-generate-pc-source-map.

Removed the unused generic functions source-note-text and (setf source-note-text).

There is still a bug in substream, or somewhere, where we're getting garbage (#\Z chars) in our text streams, made
%fast-compress ignore these chars.

Location:
branches/working-0711/ccl
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/compiler/X86/x862.lisp

    r8439 r8444  
    610610                                        (list 'function-debugging-info lambda-form))
    611611                                      (when (and *compiler-record-source* *definition-source-note*)
    612                                         (list 'function-source-note
     612                                        (list 'function-source-note 
    613613                                              (source-note-for-%lfun-info *definition-source-note* :form nil :children nil)))
    614614                                      (when *x862-recorded-symbols*
     
    617617                                                 *x862-emitted-source-notes*
    618618                                                 *definition-source-note*)
    619                                         (list 'pc-source-map
     619                                        (list 'pc-source-map 
    620620                                              (x862-generate-pc-source-map *definition-source-note* *x862-emitted-source-notes*)))))
    621621                         (setf bits (logior (ash 1 $lfbits-info-bit) bits)))
     
    681681    (vector (aref source-mapping 3))))
    682682
    683 (defun small-positive-integer-p (number &optional (biggest-small-value (ash 1 15)))
    684   (< 0 number biggest-small-value))
    685 
    686 (defun generate-pc-source-mapping (pc-start pc-end text-start text-end)
    687   (cond
    688     ((every #'small-positive-integer-p (list pc-start pc-end text-start text-end))
    689       (let ((mapping 0))
    690         (setf (ldb (byte 15 0) mapping)  pc-start
    691               (ldb (byte 15 15) mapping) pc-end
    692               (ldb (byte 15 30) mapping) text-start
    693               (ldb (byte 15 45) mapping) text-end)
    694         mapping))
    695     ((every #'plusp (list pc-start pc-end text-start text-end))
    696      (vector pc-start pc-end text-start text-end))
    697     (t nil)))
    698 
    699683(defun x862-generate-pc-source-map (definition-source-note emitted-source-notes)
    700684  (when *compiler-record-source*
    701685    (let ((def-start (source-note-start definition-source-note))
    702           (vec (make-array (length emitted-source-notes) :fill-pointer 0)))
     686          (vec (make-array (length emitted-source-notes))))
    703687      (loop
    704688        for start in emitted-source-notes
    705         for mapping = (generate-pc-source-mapping (x862-vinsn-note-label-address
    706                                                        start
    707                                                        t)
    708                                                   (x862-vinsn-note-label-address
    709                                                    (vinsn-note-peer start)
    710                                                        nil)
    711                                                   (- (source-note-start (aref (vinsn-note-info start) 0))
    712                                                             def-start)
    713                                                   (- (source-note-end (aref (vinsn-note-info start) 0))
    714                                                             def-start))
    715         when mapping
    716           do (vector-push-extend mapping vec))
    717       (let ((simple-vec (make-array (length vec))))
    718         (map-into simple-vec #'identity vec)
    719         simple-vec))))
     689        for pc-start = (x862-vinsn-note-label-address start t)
     690        for pc-end   = (x862-vinsn-note-label-address (vinsn-note-peer start) nil)
     691        for text-start = (- (source-note-start (aref (vinsn-note-info start) 0)) def-start)
     692        for text-end = (- (source-note-end (aref (vinsn-note-info start) 0)) def-start)
     693        for index upfrom 0
     694        for mapping = (cond
     695                        ((and (<= 0 pc-start   #x8000)
     696                              (<= 0 pc-end     #x8000)
     697                              (<= 0 text-start #x8000)
     698                              (<= 0 text-end   #x8000))
     699                         (let ((mapping 0))
     700                           (setf (ldb (byte 15 0) mapping)  pc-start
     701                                 (ldb (byte 15 15) mapping) pc-end
     702                                 (ldb (byte 15 30) mapping) text-start
     703                                 (ldb (byte 15 45) mapping) text-end)
     704                           mapping))
     705                        ((and (plusp pc-start) (plusp pc-end) (plusp text-start) (plusp text-end))
     706                         (vector pc-start pc-end text-start text-end))
     707                        (t nil))
     708        do (setf (aref vec index) mapping))
     709      vec)))
    720710
    721711(defun x862-vinsn-note-label-address (note &optional start-p sym)
  • branches/working-0711/ccl/compiler/nx.lisp

    r8421 r8444  
    154154   definition
    155155   (let ((*load-time-eval-token* load-time-eval-token)
    156          (env (new-lexical-environment env)))
     156         (env (new-lexical-environment env))
     157         (*definition-source-note* (and *form-source-note-map* (gethash definition *form-source-note-map*))))
    157158     (setf (lexenv.variables env) 'barrier)
    158159       (let* ((*target-backend* (or (if target (find-backend target)) *host-backend*))
  • branches/working-0711/ccl/compiler/nx0.lisp

    r8439 r8444  
    16011601         do (setf (aref vec index) (char-code char))
    16021602      else
    1603         do (return-from %fast-compact string))
     1603        do (warn "Can't %fast-compact ~C in ~S." char string)
     1604        and do (setf (aref vec index) (char-code #\?)))
    16041605    vec))
    16051606
     
    16241625  children)
    16251626
    1626 (defun make-source-note (&key stream start end text form children)
     1627(defun make-source-note (&key stream start end %text form children)
    16271628  (when (record-source-location-on-stream-p stream)
    16281629    (%make-source-note :file-name (or *compile-file-original-truename*
     
    16301631                       :start (+ start (or *compile-file-original-buffer-offset* 0))
    16311632                       :end (+ end (or *compile-file-original-buffer-offset* 0))
    1632                        :%text text
     1633                       :%text %text
    16331634                       :form form
    16341635                       :children children)))
    1635 
    1636 (defmethod source-note-text ((source-note source-note))
    1637   (%fast-uncompact (source-note-%text source-note)))
    1638 
    1639 (defmethod (setf source-note-text) (text (source-note source-note))
    1640   (setf (source-note-%text source-note) (%fast-compact text)))
    16411636
    16421637;;; we don't actually store source-note structs in the fasl since that runs into problems dumping
     
    16751670    map))
    16761671
    1677 (defun compute-children-text (source-note stream)
    1678   (unless (source-note-%text source-note)
    1679     (setf (source-note-%text source-note)
    1680           (substream stream (source-note-start source-note) (source-note-end source-note))))
    1681   (dolist (nested (source-note-children source-note))
    1682     (when nested
    1683       (unless (source-note-%text nested)
    1684         (setf (source-note-%text nested)
    1685               (make-array (- (source-note-end nested) (source-note-start nested))
    1686                           :displaced-to (source-note-%text source-note)
    1687                           :displaced-index-offset (- (source-note-start nested)
    1688                                                      (source-note-start source-note)))))
    1689       (compute-children-text nested nil)))
     1672(defun compute-children-text (source-note stream source-note-map)
     1673  (when source-note
     1674    (unless (source-note-%text source-note)
     1675      (setf (source-note-%text source-note)
     1676            (substream stream (source-note-start source-note) (source-note-end source-note))))
     1677    (dolist (nested (source-note-children source-note))
     1678      (when nested
     1679        (unless (source-note-%text nested)
     1680          (setf (source-note-%text nested)
     1681                (make-array (- (source-note-end nested) (source-note-start nested))
     1682                            :displaced-to (source-note-%text source-note)
     1683                            :displaced-index-offset (- (source-note-start nested)
     1684                                                       (source-note-start source-note)))))
     1685        (setf (gethash (source-note-form nested) source-note-map) nested)
     1686        (compute-children-text nested nil source-note-map))))
    16901687  source-note)
    16911688
  • branches/working-0711/ccl/level-1/l1-reader.lisp

    r8440 r8444  
    25072507                                 (record-source-location-on-stream-p stream))
    25082508                        ;; mb 2008-02-07: sometime the nested-source-notes end with t, don't know
    2509                         ;; why. don't really care here.                       
     2509                        ;; why. don't really care here.
    25102510                        (make-source-note :stream stream
    25112511                                          :start (1- start)
     
    25162516                                                        (when (atom (cdr last))
    25172517                                                          ;; dotted list.
    2518                                                           (setf (cdr last) (list (cdr last)))))
     2518                                                          (setf (cdr last) (list (cdr last))))
     2519                                                        nested-source-notes)
    25192520                                                      '()))))))))))
    25202521
  • branches/working-0711/ccl/lib/nfcomp.lisp

    r8439 r8444  
    407407        (loop
    408408          (let* ((*fcomp-stream-position* (file-position *fcomp-stream*))
    409                  (*definition-source-note* *definition-source-note*)
    410409                 form)
    411410            (unless (eq read-package *package*)
     
    425424                      (return))
    426425                    (setf form -form
    427                           *definition-source-note* (compute-children-text source-note *fcomp-stream*)
    428                           *form-source-note-map* (make-source-note-form-map *definition-source-note*
    429                                                                             *form-source-note-map*))))))
     426                          *form-source-note-map* (make-source-note-form-map
     427                                                  (compute-children-text source-note *fcomp-stream* (make-hash-table :test 'eq))))))))           
    430428            (fcomp-form form env processing-mode)
    431429            (setq *fcomp-previous-position* *fcomp-stream-position*))))
     
    530528            ((%defparameter) (fcomp-load-%defparameter form env))
    531529            ((%defvar %defvar-init) (fcomp-load-defvar form env))
    532             ((%defun)
    533                (let ((*definition-source-note* (gethash form *form-source-note-map*)))
    534                  (fcomp-load-%defun form env)))
     530            ((%defun) (fcomp-load-%defun form env))
    535531            ((set-package %define-package)
    536532             (fcomp-random-toplevel-form form env)
Note: See TracChangeset for help on using the changeset viewer.