/usr/lib/gcl-2.6.10/lsp/gcl_profile.lsp is in gcl 2.6.10-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 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 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 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 | (in-package 'si)
(use-package "SLOOP")
;; Sample Usage:
;; (si::set-up-profile 1000000) (si::prof 0 90)
;; run program
;; (si::display-prof)
;; (si::clear-profile)
;; profile can be stopped with (si::prof 0 0) and restarted with
;;start-address will correspond to the beginning of the profile array, and
;;the scale will mean that 256 bytes of code correspond to scale bytes in the
;;profile array.
;;Thus if the profile array is 1,000,000 bytes long and the code segment is
;;5 megabytes long you can profile the whole thing using a scale of 50
;;Note that long runs may result in overflow, and so an understating of the
;;time in a function. With a scale of 128 it takes 6,000,000 times through
;;a loop to overflow the sampling in one part of the code.
;(defun sort-funs (package)
; (sloop for v in-package package with tem
; when (and (fboundp v) (compiled-function-p
; (setq tem (symbol-function v))))
; collect (cons (function-start v) v) into all
; finally (loop-return (sort all #'(lambda (x y)
; (< (the fixnum (car x))
; (the fixnum (car y))))))))
(defvar si::*profile-array*
(make-array 20000 :element-type 'string-char
:static t
:initial-element
(code-char 0)))
(defun create-profile-array (&optional (n 100000))
(if *profile-array* (profile 0 0))
(setq *profile-array* (make-array n :element-type 'string-char
:static t
:initial-element
(code-char 0)))
n
)
(defvar *current-profile* nil)
(defun pr (&optional n)
(sloop
with ar = si::*profile-array* declare (string ar)
for i below (if n (min n (array-total-size ar)) (array-total-size ar))
do
(cond ((not (= 0 i))(if (= 0 (mod i 20)) (terpri))))
(princ (char-code (aref ar i))) (princ " "))
(values))
(defun fprofile(fun &optional (fract 1000) offset)
(setq *current-profile* (list (+ (function-start (symbol-function fun))
(or offset 0))
fract))
(apply 'profile *current-profile* ))
;(defun foo (n) (sloop for i below n do nil))
;;problem: the counter will wrap around at 256, so that it really is not valid
;;for long runs if the functions are heavily used. This means that
;;Remove all previous ticks from the profile array.
(defun clear-profile () (sloop with ar = *profile-array*
declare (string ar)
for i below (array-total-size ar)
do (setf (aref ar i) (code-char 0))))
(defun prof-offset (addr) (* (/ (float (cadr *current-profile*)) #x10000)
(- addr (car *current-profile*))))
(defun prof (a b)
(setf *current-profile* (list a b))
(profile a b))
(defun display-prof()
(profile 0 0)
(apply 'display-profile *current-profile*)
(apply 'profile *current-profile*))
(defun set-up-profile (&optional (array-size 100000)(max-funs 6000)
; (name "saved_kcl")(dir *system-directory*)&aux sym
)
; (compiler::safe-system (format nil "(cd ~a ; rsym ~a \"#sym\")" dir name))
; (or (probe-file (setq sym (format nil "~a#sym" dir))) (error "could not find ~a" sym))
; (read-externals sym)
(set-up-combined max-funs)
(unless (and *profile-array*
(>= (array-total-size *profile-array*) array-size))
(print "making new array")
(setq *profile-array* (make-array array-size
:element-type 'string-char
:static t
:initial-element
(code-char 0))))
(format t "~%Loaded c and other function addresses~
~%Using profile-array length ~a ~
~%Use (si::prof 0 90) to start and (prof 0 0) to stop:~
~%This starts monitoring at address 0 ~
~%thru byte (256/90)*(length *profile-array*)~
~%(si::display-prof) displays the results" (length *profile-array*)))
|