/[gcl]/gcl/lsp/gcl_profile.lsp
ViewVC logotype

Diff of /gcl/lsp/gcl_profile.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by camm, Sun Sep 14 02:30:35 2003 UTC revision 1.2 by camm, Sun Sep 14 02:43:06 2003 UTC
# Line 0  Line 1 
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      

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26