1 |
|
|
2 |
|
(in-package 'si) |
3 |
|
(use-package "SLOOP") |
4 |
|
|
5 |
|
;; Sample Usage: |
6 |
|
;; (si::set-up-profile 1000000) (si::prof 0 90) |
7 |
|
;; run program |
8 |
|
;; (si::display-prof) |
9 |
|
;; (si::clear-profile) |
10 |
|
;; profile can be stopped with (si::prof 0 0) and restarted with |
11 |
|
;;start-address will correspond to the beginning of the profile array, and |
12 |
|
;;the scale will mean that 256 bytes of code correspond to scale bytes in the |
13 |
|
;;profile array. |
14 |
|
;;Thus if the profile array is 1,000,000 bytes long and the code segment is |
15 |
|
;;5 megabytes long you can profile the whole thing using a scale of 50 |
16 |
|
;;Note that long runs may result in overflow, and so an understating of the |
17 |
|
;;time in a function. With a scale of 128 it takes 6,000,000 times through |
18 |
|
;;a loop to overflow the sampling in one part of the code. |
19 |
|
|
20 |
|
|
21 |
|
|
22 |
|
;(defun sort-funs (package) |
23 |
|
; (sloop for v in-package package with tem |
24 |
|
; when (and (fboundp v) (compiled-function-p |
25 |
|
; (setq tem (symbol-function v)))) |
26 |
|
; collect (cons (function-start v) v) into all |
27 |
|
; finally (loop-return (sort all #'(lambda (x y) |
28 |
|
; (< (the fixnum (car x)) |
29 |
|
; (the fixnum (car y)))))))) |
30 |
|
(defvar si::*profile-array* |
31 |
|
(make-array 20000 :element-type 'string-char |
32 |
|
:static t |
33 |
|
:initial-element |
34 |
|
(code-char 0))) |
35 |
|
|
36 |
|
(defun create-profile-array (&optional (n 100000)) |
37 |
|
(if *profile-array* (profile 0 0)) |
38 |
|
(setq *profile-array* (make-array n :element-type 'string-char |
39 |
|
:static t |
40 |
|
:initial-element |
41 |
|
(code-char 0))) |
42 |
|
n |
43 |
|
) |
44 |
|
|
45 |
|
|
46 |
|
(defvar *current-profile* nil) |
47 |
|
|
48 |
|
(defun pr (&optional n) |
49 |
|
(sloop |
50 |
|
with ar = si::*profile-array* declare (string ar) |
51 |
|
for i below (if n (min n (array-total-size ar)) (array-total-size ar)) |
52 |
|
|
53 |
|
do |
54 |
|
(cond ((not (= 0 i))(if (= 0 (mod i 20)) (terpri)))) |
55 |
|
(princ (char-code (aref ar i))) (princ " ")) |
56 |
|
(values)) |
57 |
|
|
58 |
|
(defun fprofile(fun &optional (fract 1000) offset) |
59 |
|
(setq *current-profile* (list (+ (function-start (symbol-function fun)) |
60 |
|
(or offset 0)) |
61 |
|
fract)) |
62 |
|
(apply 'profile *current-profile* )) |
63 |
|
|
64 |
|
;(defun foo (n) (sloop for i below n do nil)) |
65 |
|
|
66 |
|
;;problem: the counter will wrap around at 256, so that it really is not valid |
67 |
|
;;for long runs if the functions are heavily used. This means that |
68 |
|
;;Remove all previous ticks from the profile array. |
69 |
|
|
70 |
|
(defun clear-profile () (sloop with ar = *profile-array* |
71 |
|
declare (string ar) |
72 |
|
for i below (array-total-size ar) |
73 |
|
do (setf (aref ar i) (code-char 0)))) |
74 |
|
|
75 |
|
|
76 |
|
(defun prof-offset (addr) (* (/ (float (cadr *current-profile*)) #x10000) |
77 |
|
(- addr (car *current-profile*)))) |
78 |
|
|
79 |
|
(defun prof (a b) |
80 |
|
(setf *current-profile* (list a b)) |
81 |
|
(profile a b)) |
82 |
|
|
83 |
|
(defun display-prof() |
84 |
|
(profile 0 0) |
85 |
|
(apply 'display-profile *current-profile*) |
86 |
|
(apply 'profile *current-profile*)) |
87 |
|
|
88 |
|
|
89 |
|
(defun set-up-profile (&optional (array-size 100000)(max-funs 6000) |
90 |
|
; (name "saved_kcl")(dir *system-directory*)&aux sym |
91 |
|
) |
92 |
|
; (compiler::safe-system (format nil "(cd ~a ; rsym ~a \"#sym\")" dir name)) |
93 |
|
; (or (probe-file (setq sym (format nil "~a#sym" dir))) (error "could not find ~a" sym)) |
94 |
|
; (read-externals sym) |
95 |
|
(set-up-combined max-funs) |
96 |
|
(unless (and *profile-array* |
97 |
|
(>= (array-total-size *profile-array*) array-size)) |
98 |
|
(print "making new array") |
99 |
|
(setq *profile-array* (make-array array-size |
100 |
|
:element-type 'string-char |
101 |
|
:static t |
102 |
|
:initial-element |
103 |
|
(code-char 0)))) |
104 |
|
(format t "~%Loaded c and other function addresses~ |
105 |
|
~%Using profile-array length ~a ~ |
106 |
|
~%Use (si::prof 0 90) to start and (prof 0 0) to stop:~ |
107 |
|
~%This starts monitoring at address 0 ~ |
108 |
|
~%thru byte (256/90)*(length *profile-array*)~ |
109 |
|
~%(si::display-prof) displays the results" (length *profile-array*))) |
110 |
|
|