Changeset 10194


Ignore:
Timestamp:
Jul 24, 2008, 2:37:30 AM (11 years ago)
Author:
gz
Message:

Since I can't make it consistently measure coverage of toplevel forms,
try to consistently NOT measure toplevel forms, so as to make for more
useful statistics.

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

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/lib/macros.lisp

    r10078 r10194  
    748748    `(let* ((,temp (function-to-function-vector ,f)))
    749749      (%svref ,temp (the fixnum (1- (the fixnum (uvsize ,temp))))))))
     750
     751(defmacro lfunloop (for var in function &body loop-body)
     752  "Loop over immediates in function"
     753  (assert (and (or (equal (symbol-name for) "FOR") (equal (symbol-name for) "AS"))
     754               (equal (symbol-name in) "IN")))
     755  (let ((fn (gensym))
     756        (lfv (gensym))
     757        (i (gensym)))
     758    `(loop with ,fn = ,function
     759           with ,lfv = (function-to-function-vector ,fn)
     760           for ,i from #+ppc-target 0 #+x86-target (%function-code-words fn) below (uvsize  ,lfv)
     761           as ,var = (uvref ,lfv ,i)
     762           ,@loop-body)))
    750763
    751764; %Pascal-Functions% Entry
  • branches/working-0711/ccl/lib/nfcomp.lisp

    r10011 r10194  
    477477      (when *compile-code-coverage*
    478478        (fcomp-compile-toplevel-forms env)
    479         (let* ((fns (loop for op in *fcomp-output-list*
    480                          when (consp op)
    481                          nconc (loop for arg in (cdr op) when (functionp arg) collect arg)))
     479        (let* ((fns (fcomp-code-covered-functions))
    482480               (v (nreverse (coerce fns 'vector))))
    483481          (map nil #'fcomp-digest-code-notes v)
     
    489487        (fcomp-output-form $fasl-src env (namestring *compile-file-pathname*)))
    490488      (fcomp-compile-toplevel-forms env))))
     489
     490(defun fcomp-code-covered-functions ()
     491  (loop for op in *fcomp-output-list*
     492        when (consp op)
     493          nconc (if (eq (car op) $fasl-lfuncall)
     494                  ;; Don't collect the toplevel lfun itself, it leads to spurious markings.
     495                  ;; Instead, descend one level and collect any referenced fns.
     496                  (destructuring-bind (fn) (cdr op)
     497                    (lfunloop for imm in fn when (functionp imm) collect imm))
     498                  (loop for arg in (cdr op) when (functionp arg) collect arg))))
     499
    491500
    492501(defun fcomp-output-source-being-compiled (env)
  • branches/working-0711/ccl/library/cover.lisp

    r10001 r10194  
    3939(defun entry-code-note-p (note)
    4040  (gethash note *entry-code-notes*))
    41 
    42 (defmacro lfunloop (for var in function &body loop-body)
    43   (assert (and (memq for '(for as)) (eq in 'in)))
    44   (let ((fn (gensym))
    45         (lfv (gensym))
    46         (i (gensym)))
    47     `(loop with ,fn = ,function
    48            with ,lfv = (function-to-function-vector ,fn)
    49            for ,i from #+ppc-target 0 #+x86-target (%function-code-words fn) below (uvsize  ,lfv)
    50            as ,var = (uvref ,lfv ,i)
    51            ,@loop-body)))
    52 
    5341
    5442(defun map-function-coverage (lfun fn &optional refs)
Note: See TracChangeset for help on using the changeset viewer.