Changeset 14300 for branches


Ignore:
Timestamp:
Sep 23, 2010, 3:49:36 PM (9 years ago)
Author:
gz
Message:

r14299 from trunk (encode acode strings)

Location:
branches/qres/ccl
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • branches/qres/ccl

  • branches/qres/ccl/compiler/nx-basic.lisp

    r14259 r14300  
    784784             (record (afunc)
    785785               (let* ((*nx-acode-inner-refs* nil);; filled in by stringify.
    786                       (string (stringify (afunc-acode afunc))))
    787                  (setf (getf (afunc-lfun-info afunc) '%function-acode-string) string)
     786                      (string (stringify (afunc-acode afunc)))
     787                      ;; Can't use with-output-to-vector directly above because we
     788                      ;; want the recorded positions to be relative to the string.
     789                      (vec (encode-string-to-octets string :external-format :utf-8)))
     790                 (setf (getf (afunc-lfun-info afunc) '%function-acode-string) vec)
    788791                 (loop for ref in *nx-acode-inner-refs* as fn = (acode-afunc-ref-afunc ref)
    789792                       do (dbg-assert (null (getf (afunc-lfun-info fn) '%function-acode-string)))
    790                        do (setf (getf (afunc-lfun-info fn) '%function-acode-string) string)))))
     793                       do (setf (getf (afunc-lfun-info fn) '%function-acode-string) vec)))))
    791794      (if (getf (afunc-lfun-info afunc) '%function-source-note)
    792795        (record afunc)
  • branches/qres/ccl/library/cover.lisp

    r14110 r14300  
    5656(defparameter *emitted-code-notes* (make-hash-table :test #'eq))
    5757(defparameter *entry-code-notes* (make-hash-table :test #'eq))
    58 (defparameter *code-note-acode-strings* (make-hash-table :test #'eq))
    5958
    6059(defstruct (coverage-state (:conc-name "%COVERAGE-STATE-"))
     
    8483(defun entry-code-note-p (note)
    8584  (gethash note *entry-code-notes*))
    86 
    87 (defun code-note-acode-string (note)
    88   (and *code-note-acode-strings*
    89        (gethash note *code-note-acode-strings*)))
    9085
    9186(defun map-function-coverage (lfun fn &optional refs)
     
    10297  (let ((entry (function-entry-code-note fn))
    10398        (refs (cons fn refs))
    104         (acode (%function-acode-string fn))
    10599        (source (function-source-form-note fn)))
    106100    (declare (dynamic-extent refs))
    107101    (when entry
    108102      (assert (eq fn (gethash entry *entry-code-notes* fn)))
    109       (setf (gethash entry *entry-code-notes*) fn)
    110       (when acode
    111         (setf (gethash entry *code-note-acode-strings*) acode)))
     103      (setf (gethash entry *entry-code-notes*) fn))
    112104    (nconc
    113105     (and entry (list fn))
    114106     (lfunloop for imm in fn
    115107       when (code-note-p imm)
    116        do (progn
    117             (setf (gethash imm *emitted-code-notes*) t)
    118             (when acode
    119               (setf (gethash imm *code-note-acode-strings*) acode)))
     108       do (setf (gethash imm *emitted-code-notes*) t)
    120109       when (and (functionp imm)
    121110                 (not (memq imm refs))
     
    146135  (clrhash *emitted-code-notes*)
    147136  (clrhash *entry-code-notes*)
    148   (when *code-note-acode-strings* (clrhash *code-note-acode-strings*))
    149137  (loop for data in *code-covered-functions*
    150138        do (let* ((file (code-covered-info.file data))
     
    462450         (*coverage-subnotes* (make-hash-table :test #'eq :shared nil))
    463451         (*emitted-code-notes* (make-hash-table :test #'eq :shared nil))
    464          (*entry-code-notes* (make-hash-table :test #'eq :shared nil))
    465          (*code-note-acode-strings* nil))
     452         (*entry-code-notes* (make-hash-table :test #'eq :shared nil)))
    466453    (get-coverage)
    467454    (loop for coverage in *file-coverage*
     
    509496         (*emitted-code-notes* (make-hash-table :test #'eq :shared nil))
    510497         (*entry-code-notes* (make-hash-table :test #'eq :shared nil))
    511          (*code-note-acode-strings* (make-hash-table :test #'eq :shared nil))
    512498         (index-file (and html (merge-pathnames output-file "index.html")))
    513499         (stats-file (and statistics (merge-pathnames (if (or (stringp statistics)
     
    691677         (range (and note (code-note-acode-range note))))
    692678    (when (and acode range)
    693       (let ((styles (or (gethash acode acode-styles)
    694                         (setf (gethash acode acode-styles)
    695                               (make-array (length acode)
    696                                           :initial-element $no-style
    697                                           :element-type '(unsigned-byte 2))))))
     679      (let* ((cell (or (gethash acode acode-styles)
     680                       (setf (gethash acode acode-styles)
     681                             (let ((string (decode-string-from-octets acode :external-format :utf-8)))
     682                               (cons string
     683                                     (make-array (length string)
     684                                                 :initial-element $no-style
     685                                                 :element-type '(unsigned-byte 2)))))))
     686             (styles (cdr cell)))
    698687        (iterate update ((note note))
    699688          (multiple-value-bind (start end) (decode-file-range (code-note-acode-range note))
     
    777766              (format html-stream "<a href=javascript:swap('~d')><span class='toggle' id='p~:*~d'>Show expansion</span></a>~%~
    778767                                   <div class='acode' id='a~:*~d'><code>" pos)
    779               (loop for acode in strings as styles = (gethash acode acode-styles)
    780                     do (assert styles)
    781                     do (when styles (output-styled html-stream acode styles))
     768              (loop for acode in strings as (string . styles) = (gethash acode acode-styles)
     769                    do (output-styled html-stream string styles)
    782770                    do (fresh-line html-stream))
    783771              (format html-stream "</code></div><hr/>~%")
  • branches/qres/ccl/lisp-kernel

    • Property svn:mergeinfo changed (with no actual effect on merging)
Note: See TracChangeset for help on using the changeset viewer.