Ignore:
Timestamp:
Mar 3, 2008, 9:30:29 PM (13 years ago)
Author:
gz
Message:

Assorted code coverage fixes:

  • stop using the 'function-source-note property of lfun-info, conflicts with meta-. and was problematic anyway. Pass function entry note directly through nx1-lambda on.
  • be more careful about tracking macroexpansions/transformations in a number of places, one interesting change being to add note-source-transformation to allow macros to report unusual transformations, and make defgeneric use it for :method's.
  • be more careful about tracking parent/child code note relationships in various ways.
  • Better handling of nested functions.
  • Better handling of inlining (or rather, better avoidance of screws caused by inlining, actual code coverage info for inlining still not available).
  • Assorted fixes in code coverage reporting, account for internal functions, ensure coloring outside-in, default :statistic to T.
File:
1 edited

Legend:

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

    r8576 r8646  
    12791279                                 parent-env
    12801280                                 (policy *default-compiler-policy*)
    1281                                  load-time-eval-token
    1282                                  code-note)
     1281                                 load-time-eval-token)
    12831282  (if q
    12841283     (setf (afunc-parent p) q))
     
    13131312                         (parse-body (%cddr lambda-form) *nx-lexical-environment* t)
    13141313      (setf (afunc-lambdaform p) lambda-form)
    1315       (setf (afunc-acode p) (nx1-lambda (%cadr lambda-form) body decls code-note))
     1314      (setf (afunc-acode p) (nx1-lambda (%cadr lambda-form) body decls))
    13161315      (nx1-transitively-punt-bindings *nx-punted-vars*)
    13171316      (setf (afunc-blocks p) *nx-blocks*)
     
    13361335
    13371336
    1338 (defun nx1-lambda (ll body decls &optional code-note &aux (l ll) methvar)
    1339   (when code-note
    1340     (setf (afunc-lfun-info *nx-current-function*)
    1341           (list* 'function-source-note code-note (afunc-lfun-info *nx-current-function*))))
     1337(defun nx1-lambda (ll body decls &aux (l ll) methvar)
    13421338  (let* ((old-env *nx-lexical-environment*)
    1343          (*nx-bound-vars* *nx-bound-vars*)
    1344          (*nx-current-code-note* (and (or *compile-code-coverage* *record-pc-mapping*) code-note)))
    1345 
     1339         (*nx-bound-vars* *nx-bound-vars*))
    13461340    (with-nx-declarations (pending)
    13471341      (let* ((*nx-parsing-lambda-decls* t))
     
    13921386                   (%ilsl $fbitnextmethp 1)
    13931387                   (afunc-bits *nx-current-function*)))))
    1394         (make-acode
    1395          (%nx1-operator lambda-list)
    1396          req
    1397          opt
    1398          (if lexpr (list rest) rest)
    1399          keys
    1400          auxen
    1401          body
    1402          *nx-new-p2decls*)))))
     1388        (make-acode
     1389         (%nx1-operator lambda-list)
     1390         req
     1391         opt
     1392         (if lexpr (list rest) rest)
     1393         keys
     1394         auxen
     1395         body
     1396         *nx-new-p2decls*
     1397         *nx-current-code-note*)))))
    14031398
    14041399(defun nx-parse-simple-lambda-list (pending ll &aux
     
    21672162          (gethash original *form-source-note-map*))))
    21682163
    2169 (defun nx-transform (form &optional (environment *nx-lexical-environment*))
    2170   (let* (sym transforms lexdefs changed enabled macro-function compiler-macro source)
    2171     (when (or (null *nx-source-note-map*) (gethash form *nx-source-note-map*))
    2172       (setq source t))
     2164(defun nx-note-source-transformation (original new)
     2165  (when (and *nx-source-note-map*
     2166             (gethash original *nx-source-note-map*)
     2167             (not (gethash new *nx-source-note-map*)))
     2168    (setf (gethash new *nx-source-note-map*)
     2169          (gethash original *nx-source-note-map*)))
     2170  (record-form-source-equivalent original new))
     2171
     2172(defun nx-transform (form &optional (environment *nx-lexical-environment*) (source-note-map *nx-source-note-map*))
     2173  (let* (sym transforms lexdefs changed enabled macro-function compiler-macro (source t))
     2174    (when source-note-map
     2175      (setq source (gethash form source-note-map)))
    21732176    (tagbody
    21742177       (go START)
    21752178     LOOP
    2176        (unless source (setq source (gethash form *nx-source-note-map*)))
     2179       (unless source (setq source (gethash form source-note-map)))
    21772180       (setq changed t)
    21782181       (when (and (consp form)
     
    21972200             (multiple-value-bind (newform win) (nx-transform thing environment)
    21982201               (when win
    2199                  (unless source (setq source (gethash newform *nx-source-note-map*)))
     2202                 (unless source (setq source (gethash newform source-note-map)))
    22002203                 (setq changed t)
    22012204                 (if (and (self-evaluating-p newform)
     
    22172220         (let* ((win nil))
    22182221           (when (and enabled (functionp (fboundp sym)))
    2219              (multiple-value-setq (form win) (nx-transform-arglist form environment))
     2222             (multiple-value-setq (form win) (nx-transform-arglist form environment source-note-map))
    22202223             (when win
    2221                (unless source (setq source (gethash form *nx-source-note-map*)))
     2224               (unless source (setq source (gethash form source-note-map)))
    22222225               (setq changed t)))))
    22232226       (when (and enabled
     
    22262229           (when folded
    22272230             (setq form value changed t)
    2228              (unless source (setq source (gethash form *nx-source-note-map*)))
     2231             (unless source (setq source (gethash form source-note-map)))
    22292232             (unless (and (consp form) (eq (car form) sym)) (go START))))
    22302233         (when compiler-macro
     
    22452248                                           (gethash sym %structure-refs%))))
    22462249             (setq form (defstruct-ref-transform transforms (%cdr form)) changed t)
    2247              (unless source (setq source (gethash form *nx-source-note-map*)))
     2250             (unless source (setq source (gethash form source-note-map)))
    22482251             (go START))
    22492252           (when (setq transforms (assq sym *nx-synonyms*))
     
    22552258         (nx-record-xref-info :macro-calls (function-name macro-function))
    22562259         (setq form (macroexpand-1 form environment) changed t)
    2257          (unless source (setq source (gethash form *nx-source-note-map*)))
     2260         (unless source (setq source (gethash form source-note-map)))
    22582261         (go START))
    22592262     DONE)
    2260     (when (and source (neq source t) (not (gethash form *nx-source-note-map*)))
    2261       ;; Neither the initial nor final form has source, but somewhere in the middle we encountered one.
    2262       (setf (gethash form *nx-source-note-map*) source))
     2263    (when (and source (neq source t) (not (gethash form source-note-map)))
     2264      (unless (and (consp form)
     2265                   (eq (%car form) 'the)
     2266                   (eq source (gethash (caddr form) source-note-map)))
     2267        (setf (gethash form source-note-map) source)))
    22632268    (values form changed)))
    22642269
     
    22672272; call form unchanged.
    22682273
    2269 (defun nx-transform-arglist (callform env)
     2274(defun nx-transform-arglist (callform env &optional source-note-map)
    22702275    (let* ((any-wins nil)
    22712276           (transformed-call (cons (car callform) nil))
     
    22742279      (declare (type cons ptr))
    22752280      (dolist (form (cdr callform) (if any-wins (values (copy-list transformed-call) t) (values callform nil)))
    2276         (rplacd ptr (setq ptr (cons (multiple-value-setq (form win) (nx-transform form env)) nil)))
     2281        (multiple-value-setq (form win)
     2282          (nx-transform form env source-note-map))
     2283        (rplacd ptr (setq ptr (cons form nil)))
    22772284        (if win (setq any-wins t)))))
    22782285
Note: See TracChangeset for help on using the changeset viewer.