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.6 1992/08/04 08:24:49 wlott Exp $")
;;; **********************************************************************
;;;
;;; 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)
(:make-load-form-fun :just-dump-it-normally))
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)
(declare (ignore component))
(error "Dynamic statistic collection not implemented for the new-assembler.")
#+nil
(let* ((info (ir2-component-dyncount-info (component-info component)))
(vops (dyncount-info-vops info)))
(when (producing-fasl-file)
(fasl-validate-structure info *compile-object*))
(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)))))
(assem: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))