home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / pcl / src-16f.lha / compiler / statcount.lisp < prev    next >
Encoding:
Text File  |  1991-11-06  |  5.0 KB  |  163 lines
  1. ;;; -*- Package: C; Log: C.Log -*-
  2. ;;;
  3. ;;; **********************************************************************
  4. ;;; This code was written as part of the CMU Common Lisp project at
  5. ;;; Carnegie Mellon University, and has been placed in the public domain.
  6. ;;; If you want to use this code or any part of CMU Common Lisp, please contact
  7. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
  8. ;;;
  9. (ext:file-comment
  10.   "$Header: statcount.lisp,v 1.3 91/05/24 19:39:59 wlott Exp $")
  11. ;;;
  12. ;;; **********************************************************************
  13. ;;;
  14. ;;; $Header: statcount.lisp,v 1.3 91/05/24 19:39:59 wlott Exp $
  15. ;;;
  16. ;;; Functions and utilities for collecting statistics on static vop usages.
  17. ;;;
  18. ;;; Written by William Lott
  19. ;;;
  20. (in-package "C")
  21.  
  22. (export '(*count-vop-usages*))
  23.  
  24.  
  25.  
  26. ;;;; Vop counting utilities
  27.  
  28. ;;; T if we should count the number of times we use each vop and the number
  29. ;;; of instructions that come from each.
  30. ;;; 
  31. (defvar *count-vop-usages* nil)
  32.  
  33. ;;; Hash table containing all the current counts.  The key is the name of the
  34. ;;; vop, and the value is a 3 element simple-vector.  The elements are:
  35. ;;;   0 - the name of the vop.
  36. ;;;   1 - the number of times this vop was emitted.
  37. ;;;   2 - the number of normal instructions emitted due to this vop.
  38. ;;;   3 - the number of elsewhere instructions emitted due to this vop.
  39. ;;; 
  40. (defvar *vop-counts* (make-hash-table :test #'eq))
  41.  
  42. ;;; COUNT-VOPS  --  internal interface.
  43. ;;;
  44. ;;; COUNT-VOPS is called by COMPILE-COMPONENT to count the vop usages in
  45. ;;; component.
  46. ;;; 
  47. (defun count-vops (component)
  48.   (flet ((vop-entry (vop)
  49.        (let* ((name (vop-info-name (vop-info vop)))
  50.           (entry (gethash name *vop-counts*)))
  51.          (the (simple-vector 4)
  52.           (or entry
  53.               (let ((new (make-array 4 :initial-element 0)))
  54.             (setf (svref new 0) name)
  55.             (setf (gethash name *vop-counts*) new)
  56.             new))))))
  57.     (do-ir2-blocks (block component)
  58.       (do ((vop (ir2-block-start-vop block) (vop-next vop)))
  59.       ((null vop))
  60.     (incf (svref (vop-entry vop) 1))))
  61.     (count-instructions #'(lambda (vop count elsewherep)
  62.                 (incf (svref (vop-entry vop)
  63.                      (if elsewherep 3 2))
  64.                   count))
  65.             *code-segment*
  66.             *elsewhere*
  67.             :size))
  68.   (undefined-value))
  69.  
  70.  
  71. ;;;; Stuff for using the statistics.
  72.  
  73. ;;; Clear-Vop-Counts -- interface
  74. ;;; 
  75. (defun clear-vop-counts ()
  76.   (clrhash *vop-counts*)
  77.   nil)
  78.  
  79. ;;; Report-Vop-Counts -- interface
  80. ;;;
  81. (defun report-vop-counts (&key (cut-off 15) (sort-by :size))
  82.   (declare (type (or null unsigned-byte) cut-off)
  83.        (type (member :size :count :name) sort-by))
  84.   (let ((results nil)
  85.     (total-count 0)
  86.     (total-size 0)
  87.     (w/o-elsewhere-size 0))
  88.     (maphash #'(lambda (key value)
  89.          (declare (ignore key))
  90.          (push value results)
  91.          (incf total-count (svref value 1))
  92.          (incf total-size (+ (svref value 2) (svref value 3)))
  93.          (incf w/o-elsewhere-size (svref value 2)))
  94.          *vop-counts*)
  95.     (format t "~18<Vop ~> ~17:@<Count~> ~17:@<Bytes~> ~
  96.               ~17:@<W/o elsewhere~> Ave Sz~%")
  97.     (let ((total-count (coerce total-count 'double-float))
  98.       (total-size (coerce total-size 'double-float))
  99.       (w/o-elsewhere-size (coerce w/o-elsewhere-size 'double-float)))
  100.       (dolist (info (sort results
  101.               (ecase sort-by
  102.                 (:name #'(lambda (name-1 name-2)
  103.                        (string< (symbol-name name-1)
  104.                         (symbol-name name-2))))
  105.                 ((:count :size) #'>))
  106.               :key (ecase sort-by
  107.                  (:name #'(lambda (x) (svref x 0)))
  108.                  (:count #'(lambda (x) (svref x 1)))
  109.                  (:size #'(lambda (x)
  110.                         (+ (svref x 2)
  111.                            (svref x 3)))))))
  112.     (when cut-off
  113.       (if (zerop cut-off)
  114.           (return)
  115.           (decf cut-off)))
  116.     (let* ((name (symbol-name (svref info 0)))
  117.            (name-len (length name))
  118.            (count (svref info 1))
  119.            (count-len (truncate (truncate (rational (log count 10))) 3/4))
  120.            (w/o-elsewhere (svref info 2))
  121.            (size (+ w/o-elsewhere (svref info 3))))
  122.       (if (> (+ name-len count-len) 24)
  123.           (format t "~A:~%~18T~9:D" name count)
  124.           (format t "~VT~A:~VT~:D"
  125.               (max (- 18 name-len) 0)
  126.               name
  127.               (- 26 count-len)
  128.               count))
  129.       (format t " (~4,1,2F%) ~9:D (~4,1,2F%) ~9:D (~4,1,2F%) ~3D ~3D~%"
  130.           (/ (coerce count 'double-float) total-count)
  131.           size
  132.           (/ (coerce size 'double-float) total-size)
  133.           w/o-elsewhere
  134.           (/ (coerce w/o-elsewhere 'double-float) w/o-elsewhere-size)
  135.           (round size count)
  136.           (round w/o-elsewhere count))))))
  137.   (values))
  138.  
  139. (defun save-vop-counts (filename)
  140.   (with-open-file (stream filename :direction :output :if-exists :supersede)
  141.     (maphash #'(lambda (key value)
  142.          (declare (ignore key))
  143.          (prin1 value stream)
  144.          (terpri stream))
  145.          *vop-counts*)))
  146.  
  147. (defun augment-vop-counts (filename)
  148.   (with-open-file (stream filename)
  149.     (loop
  150.       (let ((stuff (read stream nil :eof)))
  151.     (when (eq stuff :eof)
  152.       (return))
  153.     (multiple-value-bind
  154.         (entry found)
  155.         (gethash (svref stuff 0) *vop-counts*)
  156.       (cond (found
  157.          (incf (svref entry 1) (svref stuff 1))
  158.          (incf (svref entry 2) (svref stuff 3))
  159.          (incf (svref entry 3) (svref stuff 2)))
  160.         (t
  161.          (setf (gethash (svref stuff 0) *vop-counts*) stuff))))))))
  162.  
  163.