Newer
Older
;;; -*- Package: C; Log: C.Log -*-
;;;
;;; **********************************************************************
;;; This code was written as part of the CMU Common Lisp project at
;;; Carnegie Mellon University, and has been placed in the public domain.
;;; If you want to use this code or any part of CMU Common Lisp, please contact
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dyncount.lisp,v 1.3 1991/02/20 14:57:14 ram Exp $")
;;;
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
;;; **********************************************************************
;;;
;;; This file contains support for collecting dynamic vop statistics.
;;;
(in-package "C")
(export '(*collect-dynamic-statistics*))
(export '(count-me))
(defvar *collect-dynamic-statistics* nil
"When T, emit extra code to collect dynamic statistics about vop usages.")
(defvar *dynamic-counts-tn* nil
"Holds the TN for the counts vector.")
(defstruct (dyncount-info
(:print-function %print-dyncount-info))
for
(counts (required-argument) :type (simple-array (unsigned-byte 32) (*)))
(vops (required-argument) :type simple-vector))
(defprinter dyncount-info
for
counts
vops)
(defun setup-dynamic-count-info (component)
(let* ((info (ir2-component-dyncount-info (component-info component)))
(vops (dyncount-info-vops info)))
(do-ir2-blocks (block component)
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
(let* ((start-vop (ir2-block-start-vop block))
(1block (ir2-block-block block))
(block-number (block-number 1block)))
(when (and start-vop block-number)
(let* ((index (1- block-number))
(counts (svref vops index))
(length (length counts)))
(do ((vop start-vop (vop-next vop)))
((null vop))
(let ((vop-name (vop-info-name (vop-info vop))))
(do ((i 0 (+ i 4)))
((or (>= i length) (eq (svref counts i) vop-name))
(when (>= i length)
(incf length 4)
(let ((new-counts
(make-array length :initial-element 0)))
(when counts
(replace new-counts counts))
(setf counts new-counts))
(setf (svref counts i) vop-name))
(incf (svref counts (1+ i)))))))
(setf (svref vops index) counts)))))
(count-instructions
#'(lambda (vop bytes elsewherep)
(let ((block-number (block-number (ir2-block-block (vop-block vop)))))
(when block-number
(let* ((name (vop-info-name (vop-info vop)))
(counts (svref vops (1- block-number)))
(length (length counts)))
(do ((i 0 (+ i 4)))
((>= i length)
(error "VOP ~S didn't exist earlier!~% counts=~S"
name counts))
(when (eq (svref counts i) name)
(incf (svref counts (+ i (if elsewherep 3 2))) bytes)
(return)))))))
*code-segment*
*elsewhere*)
(undefined-value)))