diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index 968de7c..a5cc4b6 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -75,6 +75,16 @@ \index{#1!defvar}} %% +%% defstruct marks a struct definition and adds it to the index +%% +\newcommand{\defstruct}[1]{% e.g. \defstruct{varname} +\subsection{defstruct \${#1}}% +\label{#1}% +\index{#1}% +\index{defstruct!#1}% +\index{#1!defstruct}} + +%% %% defdollar marks a var definition (with leading $) and adds it to the index %% \newcommand{\defdollar}[1]{% e.g. \defdollar{functionname} @@ -9862,7 +9872,7 @@ The \verb|$msgdbPrims| variable is set to: \calls{displayModemap}{formatSignature} <>= (defun |displayModemap| (v val giveVariableIfNil) - (local + (labels ( (g (v mm giveVariableIfNil) (let (local signature fn varPart prefix) (setq local (caar mm)) @@ -9872,7 +9882,7 @@ The \verb|$msgdbPrims| variable is set to: (spadlet varPart (unless giveVariableIfNil (cons " of" (|bright| v)))) (spadlet prefix (cons '| Compiled function type| (append varPart (cons '|: | nil)))) - (|sayBrightly| (|concat| prefix (|formatSignature| signature)))))) + (|sayBrightly| (|concat| prefix (|formatSignature| signature))))))) (mapcar #'(lambda (x) (g v x giveVariableIfNil)) val))) @ @@ -23604,7 +23614,7 @@ synonyms at the current user level. \usesdollar{getSystemCommandLine}{currentLine} <>= (defun |getSystemCommandLine| () - (let (p maxIndex index line) + (let (p line) (declare (special |$currentLine|)) (setq p (strpos ")" |$currentLine| 0 nil)) (if p @@ -31000,7 +31010,7 @@ appropriate entries in the browser database. The legal values for arg are \calls{stringMatches?}{basicMatch?} <>= (defun |stringMatches?| (pattern subject) - (when fixp (|basicMatch?| pattern subject) t)) + (when (fixp (|basicMatch?| pattern subject)) t)) @ @@ -31580,6 +31590,948 @@ See Steele Common Lisp 1990 pp305-307 @ +\chapter{Monitoring execution} +\begin{verbatim} +MONITOR + +This file contains a set of function for monitoring the execution +of the functions in a file. It constructs a hash table that contains +the function name as the key and monitor-data structures as the value + +The technique is to use a :cond parameter on trace to call the +monitor-incr function to incr the count every time a function is called + +*monitor-table* HASH TABLE + is the monitor table containing the hash entries +*monitor-nrlibs* LIST of STRING + list of nrlib filenames that are monitored +*monitor-domains* LIST of STRING + list of domains to monitor-report (default is all exposed domains) +monitor-data STRUCTURE + is the defstruct name of records in the table + name is the first field and is the name of the monitored function + count contains a count of times the function was called + monitorp is a flag that skips counting if nil, counts otherwise + sourcefile is the name of the file that contains the source code + + ***** SETUP, SHUTDOWN **** + +monitor-inittable () FUNCTION + creates the hashtable and sets *monitor-table* + note that it is called every time this file is loaded +monitor-end () FUNCTION + unhooks all of the trace hooks + + ***** TRACE, UNTRACE ***** + +monitor-add (name &optional sourcefile) FUNCTION + sets up the trace and adds the function to the table +monitor-delete (fn) FUNCTION + untraces a function and removes it from the table +monitor-enable (&optional fn) FUNCTION + starts tracing for all (or optionally one) functions that + are in the table +monitor-disable (&optional fn) FUNCTION + stops tracing for all (or optionally one) functions that + are in the table + +***** COUNTING, RECORDING ***** + +monitor-reset (&optional fn) FUNCTION + reset the table count for the table (or optionally, for a function) +monitor-incr (fn) FUNCTION + increments the count information for a function + it is called by trace to increment the count +monitor-decr (fn) FUNCTION + decrements the count information for a function +monitor-info (fn) FUNCTION + returns the monitor-data structure for a function + +***** FILE IO ***** + +monitor-write (items file) FUNCTION + writes a list of symbols or structures to a file +monitor-file (file) FUNCTION + will read a file, scan for defuns, monitor each defun + NOTE: monitor-file assumes that the file has been loaded + +***** RESULTS ***** + +monitor-results () FUNCTION + returns a list of the monitor-data structures +monitor-untested () FUNCTION + returns a list of files that have zero counts +monitor-tested (&optional delete) FUNCTION + returns a list of files that have nonzero counts + optionally calling monitor-delete on those functions + +***** CHECKPOINT/RESTORE ***** +monitor-checkpoint (file) FUNCTION + save the *monitor-table* in a loadable form +monitor-restore (file) FUNCTION + restore a checkpointed file so that everything is monitored + +***** ALGEBRA ***** +monitor-autoload () FUNCTION + traces autoload of algebra to monitor corresponding source files + NOTE: this requires the /spad/int/algebra directory +monitor-dirname (args) FUNCTION + expects a list of 1 libstream (loadvol's arglist) and monitors the source + this is a function called by monitor-autoload +monitor-nrlib (nrlib) FUNCTION + takes an nrlib name as a string (eg POLY) and returns a list of + monitor-data structures from that source file +monitor-report () FUNCTION + generate a report of the monitored activity for domains in + *monitor-domains* +monitor-spadfile (name) FUNCTION + given a spad file, report all nrlibs it creates + this adds each nrlib name to *monitor-domains* but does not + trace the functions from those domains +monitor-percent () FUNCTION + ratio of (functions executed)/(functions traced) +monitor-apropos (str) FUNCTION + given a string, find all monitored symbols containing the string + the search is case-insensitive. returns a list of monitor-data items + +for example: + suppose we have a file "/u/daly/testmon.lisp" that contains: + (defun foo1 () (print 'foo1)) + (defun foo2 () (print 'foo2)) + (defun foo3 () (foo1) (foo2) (print 'foo3)) + (defun foo4 () (print 'foo4)) + + an example session is: + + ; FIRST WE LOAD THE FILE (WHICH INITS *monitor-table*) + + >(load "/u/daly/monitor.lisp") + Loading /u/daly/monitor.lisp + Finished loading /u/daly/monitor.lisp + T + + ; SECOND WE LOAD THE TESTMON FILE + >(load "/u/daly/testmon.lisp") + T + + ; THIRD WE MONITOR THE FILE + >(monitor-file "/u/daly/testmon.lisp") + monitoring "/u/daly/testmon.lisp" + NIL + + ; FOURTH WE CALL A FUNCTION FROM THE FILE (BUMP ITS COUNT) + >(foo1) + + FOO1 + FOO1 + + ; AND ANOTHER FUNCTION (BUMP ITS COUNT) + >(foo2) + + FOO2 + FOO2 + + ; AND A THIRD FUNCTION THAT CALLS THE OTHER TWO (BUMP ALL THREE) + >(foo3) + + FOO1 + FOO2 + FOO3 + FOO3 + + ; CHECK THAT THE RESULTS ARE CORRECT + + >(monitor-results) + (#S(MONITOR-DATA NAME FOO1 COUNT 2 MONITORP T SOURCEFILE + "/u/daly/testmon.lisp") + #S(MONITOR-DATA NAME FOO2 COUNT 2 MONITORP T SOURCEFILE + "/u/daly/testmon.lisp") + #S(MONITOR-DATA NAME FOO3 COUNT 1 MONITORP T SOURCEFILE + "/u/daly/testmon.lisp")) + #S(MONITOR-DATA NAME FOO4 COUNT 0 MONITORP T SOURCEFILE + "/u/daly/testmon.lisp")) + + ; STOP COUNTING CALLS TO FOO2 + + >(monitor-disable 'foo2) + NIL + + ; INVOKE FOO2 THRU FOO3 + + >(foo3) + + FOO1 + FOO2 + FOO3 + FOO3 + + ; NOTICE THAT FOO1 AND FOO3 WERE BUMPED BUT NOT FOO2 + >(monitor-results) + (#S(MONITOR-DATA NAME FOO1 COUNT 3 MONITORP T SOURCEFILE + "/u/daly/testmon.lisp") + #S(MONITOR-DATA NAME FOO2 COUNT 2 MONITORP NIL SOURCEFILE + "/u/daly/testmon.lisp") + #S(MONITOR-DATA NAME FOO3 COUNT 2 MONITORP T SOURCEFILE + "/u/daly/testmon.lisp")) + #S(MONITOR-DATA NAME FOO4 COUNT 0 MONITORP T SOURCEFILE + "/u/daly/testmon.lisp")) + + ; TEMPORARILY STOP ALL MONITORING + + >(monitor-disable) + NIL + + ; CHECK THAT NOTHING CHANGES + + >(foo3) + + FOO1 + FOO2 + FOO3 + FOO3 + + ; NO COUNT HAS CHANGED + + >(monitor-results) + (#S(MONITOR-DATA NAME FOO1 COUNT 3 MONITORP NIL SOURCEFILE + "/u/daly/testmon.lisp") + #S(MONITOR-DATA NAME FOO2 COUNT 2 MONITORP NIL SOURCEFILE + "/u/daly/testmon.lisp") + #S(MONITOR-DATA NAME FOO3 COUNT 2 MONITORP NIL SOURCEFILE + "/u/daly/testmon.lisp")) + #S(MONITOR-DATA NAME FOO4 COUNT 0 MONITORP T SOURCEFILE + "/u/daly/testmon.lisp")) + + ; MONITOR ONLY CALLS TO FOO1 + + >(monitor-enable 'foo1) + T + + ; FOO3 CALLS FOO1 + + >(foo3) + + FOO1 + FOO2 + FOO3 + FOO3 + + ; FOO1 HAS CHANGED BUT NOT FOO2 OR FOO3 + + >(monitor-results) + (#S(MONITOR-DATA NAME FOO1 COUNT 4 MONITORP T SOURCEFILE + "/u/daly/testmon.lisp") + #S(MONITOR-DATA NAME FOO2 COUNT 2 MONITORP NIL SOURCEFILE + "/u/daly/testmon.lisp") + #S(MONITOR-DATA NAME FOO3 COUNT 2 MONITORP NIL SOURCEFILE + "/u/daly/testmon.lisp")) + #S(MONITOR-DATA NAME FOO4 COUNT 0 MONITORP T SOURCEFILE + "/u/daly/testmon.lisp")) + + ; MONITOR EVERYBODY + + >(monitor-enable) + NIL + + ; CHECK THAT EVERYBODY CHANGES + + >(foo3) + + FOO1 + FOO2 + FOO3 + FOO3 + + ; EVERYBODY WAS BUMPED + + >(monitor-results) + (#S(MONITOR-DATA NAME FOO1 COUNT 5 MONITORP T SOURCEFILE + "/u/daly/testmon.lisp") + #S(MONITOR-DATA NAME FOO2 COUNT 3 MONITORP T SOURCEFILE + "/u/daly/testmon.lisp") + #S(MONITOR-DATA NAME FOO3 COUNT 3 MONITORP T SOURCEFILE + "/u/daly/testmon.lisp")) + #S(MONITOR-DATA NAME FOO4 COUNT 0 MONITORP T SOURCEFILE + "/u/daly/testmon.lisp")) + + ; WHAT FUNCTIONS WERE TESTED? + + >(monitor-tested) + (FOO1 FOO2 FOO3) + + ; WHAT FUNCTIONS WERE NOT TESTED? + + >(monitor-untested) + (FOO4) + + ; UNTRACE THE WHOLE WORLD, MONITORING CANNOT RESTART + + >(monitor-end) + NIL + + ; CHECK THE RESULTS + + >(monitor-results) + (#S(MONITOR-DATA NAME FOO1 COUNT 5 MONITORP T SOURCEFILE + "/u/daly/testmon.lisp") + #S(MONITOR-DATA NAME FOO2 COUNT 3 MONITORP T SOURCEFILE + "/u/daly/testmon.lisp") + #S(MONITOR-DATA NAME FOO3 COUNT 3 MONITORP T SOURCEFILE + "/u/daly/testmon.lisp")) + #S(MONITOR-DATA NAME FOO4 COUNT 0 MONITORP T SOURCEFILE + "/u/daly/testmon.lisp")) + + ; CHECK THAT THE FUNCTIONS STILL WORK + + >(foo3) + + FOO1 + FOO2 + FOO3 + FOO3 + + ; CHECK THAT MONITORING IS NOT OCCURING + + >(monitor-results) + (#S(MONITOR-DATA NAME FOO1 COUNT 5 MONITORP T SOURCEFILE + "/u/daly/testmon.lisp") + #S(MONITOR-DATA NAME FOO2 COUNT 3 MONITORP T SOURCEFILE + "/u/daly/testmon.lisp") + #S(MONITOR-DATA NAME FOO3 COUNT 3 MONITORP T SOURCEFILE + "/u/daly/testmon.lisp")) + #S(MONITOR-DATA NAME FOO4 COUNT 0 MONITORP T SOURCEFILE + "/u/daly/testmon.lisp")) + +\end{verbatim} + +\defvar{*monitor-domains*} +<>= +(defvar *monitor-domains* nil "a list of domains to report") + +@ + +\defvar{*monitor-nrlibs*} +<>= +(defvar *monitor-nrlibs* nil "a list of nrlibs that have been traced") + +@ + +\defvar{*monitor-table*} +<>= +(defvar *monitor-table* nil "a table of all of the monitored data") + +@ + +<>= +(eval-when (eval load) + (unless *monitor-table* (monitor-inittable))) + +@ + +\defstruct{monitor-data} +<>= +(defstruct monitor-data name count monitorp sourcefile) + +@ + +\defstruct{libstream} +<>= +(defstruct libstream mode dirname (indextable nil) (indexstream nil)) + +@ + +\defun{monitor-inittable}{Initialize the monitor statistics hashtable} +\uses{monitor-inittable}{*monitor-table*} +<>= +(defun monitor-inittable () + "initialize the monitor statistics hashtable" + (declare (special *monitor-table*)) + (setq *monitor-table* (make-hash-table))) + +@ + +\defun{monitor-end}{End the monitoring process, we cannot restart} +\uses{monitor-end}{*monitor-table*} +<>= +(defun monitor-end () + "End the monitoring process. we cannot restart" + (declare (special *monitor-table*)) + (maphash + #'(lambda (key value) + (declare (ignore value)) + (eval `(untrace ,key))) + *monitor-table*)) + +@ + +\defun{monitor-results}{Return a list of the monitor-data structures} +\uses{monitor-results}{*monitor-table*} +<>= +(defun monitor-results () + "return a list of the monitor-data structures" + (let (result) + (declare (special *monitor-table*)) + (maphash + #'(lambda (key value) + (declare (ignore key)) + (push value result)) + *monitor-table*) + (mapcar #'(lambda (x) (pprint x)) result))) + +@ + +\defun{monitor-add}{Add a function to be monitored} +\calls{monitor-add}{monitor-delete} +\calls{monitor-add}{make-monitor-data} +\uses{monitor-add}{*monitor-table*} +<>= +(defun monitor-add (name &optional sourcefile) + "add a function to be monitored" + (declare (special *monitor-table*)) + (unless (fboundp name) (load sourcefile)) + (when (gethash name *monitor-table*) + (monitor-delete name)) + (eval `(trace (,name :cond (progn (monitor-incr ',name) nil)))) + (setf (gethash name *monitor-table*) + (make-monitor-data + :name name :count 0 :monitorp t :sourcefile sourcefile))))) + +@ + +\defun{monitor-delete}{Remove a function being monitored} +\uses{monitor-delete}{*monitor-table*} +<>= +(defun monitor-delete (fn) + "Remove a function being monitored" + (declare (special *monitor-table*)) + (eval `(untrace ,fn)) + (remhash fn *monitor-table*)) + +@ + +\defun{monitor-enable}{Enable all (or optionally one) function for monitoring} +\uses{monitor-enable}{*monitor-table*} +<>= +(defun monitor-enable (&optional fn) + "enable all (or optionally one) function for monitoring" + (declare (special *monitor-table*)) + (if fn + (progn + (eval `(trace (,fn :cond (progn (monitor-incr ',fn) nil)))) + (setf (monitor-data-monitorp (gethash fn *monitor-table*)) t)) + (maphash + #'(lambda (key value) + (declare (ignore value)) + (eval `(trace (,key :cond (progn (monitor-incr ',key) nil)))) + (setf (monitor-data-monitorp (gethash key *monitor-table*)) t)) + *monitor-table*))) + +@ + +\defun{monitor-disable}{Disable all (optionally one) function for monitoring} +\uses{monitor-disable}{*monitor-table*} +<>= +(defun monitor-disable (&optional fn) + "disable all (optionally one) function for monitoring" + (declare (special *monitor-table*)) + (if fn + (progn + (eval `(untrace ,fn)) + (setf (monitor-data-monitorp (gethash fn *monitor-table*)) nil)) + (maphash + #'(lambda (key value) + (declare (ignore value)) + (eval `(untrace ,key)) + (setf (monitor-data-monitorp (gethash key *monitor-table*)) nil)) + *monitor-table*))) + +@ + +\defun{monitor-reset}{Reset the table count for the table (or a function)} +\uses{monitor-reset}{*monitor-table*} +<>= +(defun monitor-reset (&optional fn) + "reset the table count for the table (or a function)" + (declare (special *monitor-table*)) + (if fn + (setf (monitor-data-count (gethash fn *monitor-table*)) 0) + (maphash + #'(lambda (key value) + (declare (ignore value)) + (setf (monitor-data-count (gethash key *monitor-table*)) 0)) + *monitor-table*))) + +@ + +\defun{monitor-incr}{Incr the count of fn by 1} +\uses{monitor-incr}{*monitor-table*} +<>= +(defun monitor-incr (fn) + "incr the count of fn by 1" + (let (data) + (declare (special *monitor-table*)) + (setq data (gethash fn *monitor-table*)) + (if data + (incf (monitor-data-count data)) ;; change table entry by side-effect + (warn "~s is monitored but not in table..do (untrace ~s)~%" fn fn)))) + +@ + +\defun{monitor-decr}{Decr the count of fn by 1} +\uses{monitor-decr}{*monitor-table*} +<>= +(defun monitor-decr (fn) + "decr the count of fn by 1" + (let (data) + (declare (special *monitor-table*)) + (setq data (gethash fn *monitor-table*)) + (if data + (decf (monitor-data-count data)) ;; change table entry by side-effect + (warn "~s is monitored but not in table..do (untrace ~s)~%" fn fn)))) + +@ + +\defun{monitor-info}{Return the monitor information for a function} +\uses{monitor-info}{*monitor-table*} +<>= +(defun monitor-info (fn) + "return the monitor information for a function" + (declare (special *monitor-table*)) + (gethash fn *monitor-table*)) + +@ + +\defun{monitor-file}{Hang a monitor call on all of the defuns in a file} +\calls{monitor-file}{monitor-add} +<>= +(defun monitor-file (file) + "hang a monitor call on all of the defuns in a file" + (let (expr (package "BOOT")) + (format t "monitoring ~s~%" file) + (with-open-file (in file) + (catch 'done + (loop + (setq expr (read in nil 'done)) + (when (eq expr 'done) (throw 'done nil)) + (if (and (consp expr) (eq (car expr) 'in-package)) + (if (and (consp (second expr)) (eq (first (second expr)) 'quote)) + (setq package (string (second (second expr)))) + (setq package (second expr))) + (when (and (consp expr) (eq (car expr) 'defun)) + (monitor-add (intern (string (second expr)) package) file)))))))) + +@ + +\defun{monitor-untested}{Return a list of the functions with zero count fields} +\uses{monitor-untested}{*monitor-table*} +<>= +(defun monitor-untested () + "return a list of the functions with zero count fields" + (let (result) + (declare (special *monitor-table*)) + (maphash + #'(lambda (key value) + (if (and (monitor-data-monitorp value) (= (monitor-data-count value) 0)) + (push key result))) + *monitor-table*) + result)) + +@ + +\defun{monitor-tested}{Return a list of functions with non-zero counts} +\calls{monitor-tested}{monitor-delete} +\uses{monitor-tested}{*monitor-table*)} +<>= +(defun monitor-tested (&optional delete) + "return a list of functions with non-zero counts, optionally deleting them" + (let (result) + (declare (special *monitor-table*)) + (maphash + #'(lambda (key value) + (when (and (monitor-data-monitorp value) + (> (monitor-data-count value) 0)) + (when delete (monitor-delete key)) + (push key result))) + *monitor-table*) + result)) + +@ + +\defun{}{Write out a list of symbols or structures to a file} +<>= +(defun monitor-write (items file) + "write out a list of symbols or structures to a file" + (with-open-file (out file :direction :output) + (dolist (item items) + (if (symbolp item) + (format out "~s~%" item) + (format out "~s~50t~s~100t~s~%" + (monitor-data-sourcefile item) + (monitor-data-name item) + (monitor-data-count item)))))) + +@ + +\defun{monitor-checkpoint}{Save the *monitor-table* in loadable form} +\uses{monitor-checkpoint}{*monitor-table*} +\uses{monitor-checkpoint}{*print-package*} +<>= +(defun monitor-checkpoint (file) + "save the *monitor-table* in loadable form" + (let ((*print-package* t)) + (declare (special *print-package* *monitor-table*)) + (with-open-file (out file :direction :output) + (format out "(in-package \"BOOT\")~%") + (format out "(monitor-inittable)~%") + (dolist (data (monitor-results)) + (format out "(monitor-add '~s ~s)~%" + (monitor-data-name data) + (monitor-data-sourcefile data)) + (format out "(setf (gethash '~s *monitor-table*) + (make-monitor-data :name '~s :count ~s :monitorp ~s + :sourcefile ~s))~%" + (monitor-data-name data) + (monitor-data-name data) + (monitor-data-count data) + (monitor-data-monitorp data) + (monitor-data-sourcefile data)))))) + +@ + +\defun{monitor-restore}{restore a checkpointed file} +<>= +(defun monitor-restore (file) + "restore a checkpointed file" + (load file)) + +@ + +\defun{monitor-help}{Printing help documentation} +<>= +(defun monitor-help () + (format t "~% +;;; MONITOR +;;; +;;; This file contains a set of function for monitoring the execution +;;; of the functions in a file. It constructs a hash table that contains +;;; the function name as the key and monitor-data structures as the value +;;; +;;; The technique is to use a :cond parameter on trace to call the +;;; monitor-incr function to incr the count every time a function is called +;;; +;;; *monitor-table* HASH TABLE +;;; is the monitor table containing the hash entries +;;; *monitor-nrlibs* LIST of STRING +;;; list of nrlib filenames that are monitored +;;; *monitor-domains* LIST of STRING +;;; list of domains to monitor-report (default is all exposed domains) +;;; monitor-data STRUCTURE +;;; is the defstruct name of records in the table +;;; name is the first field and is the name of the monitored function +;;; count contains a count of times the function was called +;;; monitorp is a flag that skips counting if nil, counts otherwise +;;; sourcefile is the name of the file that contains the source code +;;; +;;; ***** SETUP, SHUTDOWN **** +;;; +;;; monitor-inittable () FUNCTION +;;; creates the hashtable and sets *monitor-table* +;;; note that it is called every time this file is loaded +;;; monitor-end () FUNCTION +;;; unhooks all of the trace hooks +;;; +;;; ***** TRACE, UNTRACE ***** +;;; +;;; monitor-add (name &optional sourcefile) FUNCTION +;;; sets up the trace and adds the function to the table +;;; monitor-delete (fn) FUNCTION +;;; untraces a function and removes it from the table +;;; monitor-enable (&optional fn) FUNCTION +;;; starts tracing for all (or optionally one) functions that +;;; are in the table +;;; monitor-disable (&optional fn) FUNCTION +;;; stops tracing for all (or optionally one) functions that +;;; are in the table +;;; +;;; ***** COUNTING, RECORDING ***** +;;; +;;; monitor-reset (&optional fn) FUNCTION +;;; reset the table count for the table (or optionally, for a function) +;;; monitor-incr (fn) FUNCTION +;;; increments the count information for a function +;;; it is called by trace to increment the count +;;; monitor-decr (fn) FUNCTION +;;; decrements the count information for a function +;;; monitor-info (fn) FUNCTION +;;; returns the monitor-data structure for a function +;;; +;;; ***** FILE IO ***** +;;; +;;; monitor-write (items file) FUNCTION +;;; writes a list of symbols or structures to a file +;;; monitor-file (file) FUNCTION +;;; will read a file, scan for defuns, monitor each defun +;;; NOTE: monitor-file assumes that the file has been loaded +;;; +;;; ***** RESULTS ***** +;;; +;;; monitor-results () FUNCTION +;;; returns a list of the monitor-data structures +;;; monitor-untested () FUNCTION +;;; returns a list of files that have zero counts +;;; monitor-tested (&optional delete) FUNCTION +;;; returns a list of files that have nonzero counts +;;; optionally calling monitor-delete on those functions +;;; +;;; ***** CHECKPOINT/RESTORE ***** +;;; +;;; monitor-checkpoint (file) FUNCTION +;;; save the *monitor-table* in a loadable form +;;; monitor-restore (file) FUNCTION +;;; restore a checkpointed file so that everything is monitored +;;; +;;; ***** ALGEBRA ***** +;;; +;;; monitor-autoload () FUNCTION +;;; traces autoload of algebra to monitor corresponding source files +;;; NOTE: this requires the /spad/int/algebra directory +;;; monitor-dirname (args) FUNCTION +;;; expects a list of 1 libstream (loadvol's arglist) and monitors the source +;;; this is a function called by monitor-autoload +;;; monitor-nrlib (nrlib) FUNCTION +;;; takes an nrlib name as a string (eg POLY) and returns a list of +;;; monitor-data structures from that source file +;;; monitor-report () FUNCTION +;;; generate a report of the monitored activity for domains in +;;; *monitor-domains* +;;; monitor-spadfile (name) FUNCTION +;;; given a spad file, report all nrlibs it creates +;;; this adds each nrlib name to *monitor-domains* but does not +;;; trace the functions from those domains +;;; monitor-percent () FUNCTION +;;; ratio of (functions executed)/(functions traced) +;;; monitor-apropos (str) FUNCTION +;;; given a string, find all monitored symbols containing the string +;;; the search is case-insensitive. returns a list of monitor-data items +") nil) + + +@ + +\subsection{Monitoring algebra files} +\defun{monitor-dirname}{Monitoring algebra code.lsp files} +\uses{monitor-dirname}{*monitor-nrlibs*} +<>= +(defun monitor-dirname (args) + "expects a list of 1 libstream (loadvol's arglist) and monitors the source" + (let (name) + (declare (special *monitor-nrlibs*)) + (setq name (libstream-dirname (car args))) + (setq name (file-namestring name)) + (setq name (concatenate 'string "/spad/int/algebra/" name "/code.lsp")) + (when (probe-file name) + (push name *monitor-nrlibs*) + (monitor-file name)))) + +@ + +\defun{monitor-autoload}{Monitor autoloaded files} +<>= +(defun monitor-autoload () + "traces autoload of algebra to monitor corresponding source files" + (trace (vmlisp::loadvol + :entrycond nil + :exitcond (progn (monitor-dirname system::arglist) nil)))) + +@ + +\defun{monitor-nrlib}{Monitor an nrlib} +\uses{monitor-nrlib}{*monitor-table*} +<>= +(defun monitor-nrlib (nrlib) + "takes an nrlib name as a string (eg POLY) and returns a list of + monitor-data structures from that source file" + (let (result) + (declare (special *monitor-table*)) + (maphash + #'(lambda (k v) + (declare (ignore k)) + (when (string= nrlib + (pathname-name (car (last + (pathname-directory (monitor-data-sourcefile v)))))) + (push v result))) + *monitor-table*) + result)) + +@ + +\defun{monitor-libname}{Given a monitor-data item, extract the nrlib name} +<>= +(defun monitor-libname (item) + "given a monitor-data item, extract the nrlib name" + (pathname-name (car (last + (pathname-directory (monitor-data-sourcefile item)))))) + +@ + +\defun{monitor-exposedp}{Is this an exposed algebra function?} +<>= +(defun monitor-exposedp (fn) + "exposed functions have more than 1 semicolon. given a symbol, count them" + (> (count #\; (symbol-name fn)) 1)) + +@ + +\defun{monitor-readinterp}{Monitor exposed domains} +\tpdhere{note that the file interp.exposed no longer exists.} +The exposure information is now in bookvol5. +This needs to work off the internal exposure list, not the file. +\uses{monitor-readinterp}{*monitor-domains*} +<>= +(defun monitor-readinterp () + "read interp.exposed to initialize *monitor-domains* to exposed domains. + this is the default action. adding or deleting domains from the list + will change the report results" + (let (skip expr name) + (declare (special *monitor-domains*)) + (setq *monitor-domains* nil) + (with-open-file (in "/spad/src/algebra/interp.exposed") + (read-line in) + (read-line in) + (read-line in) + (read-line in) + (catch 'done + (loop + (setq expr (read-line in nil "done")) + (when (string= expr "done") (throw 'done nil)) + (cond + ((string= expr "basic") (setq skip nil)) + ((string= expr "categories") (setq skip t)) + ((string= expr "hidden") (setq skip t)) + ((string= expr "defaults") (setq skip nil))) + (when (and (not skip) (> (length expr) 58)) + (setq name (subseq expr 58 (length expr))) + (setq name (string-right-trim '(#\space) name)) + (when (> (length name) 0) + (push name *monitor-domains*)))))))) + +@ + +\defun{monitor-report}{Generate a report of the monitored domains} +\calls{monitor-report}{monitor-readinterp} +\uses{monitor-report}{*monitor-domains*} +<>= +(defun monitor-report () + "generate a report of the monitored activity for domains in *monitor-domains*" + (let (nrlibs nonzero total) + (declare (special *monitor-domains*)) + (unless *monitor-domains* (monitor-readinterp)) + (setq nonzero 0) + (setq total 0) + (maphash + #'(lambda (k v) + (declare (ignore k)) + (let (nextlib point) + (when (> (monitor-data-count v) 0) (incf nonzero)) + (incf total) + (setq nextlib (monitor-libname v)) + (setq point (member nextlib nrlibs :test #'string= :key #'car)) + (if point + (setf (cdr (first point)) (cons v (cdr (first point)))) + (push (cons nextlib (list v)) nrlibs)))) + *monitor-table*) + (format t "~d of ~d (~d percent) tested~%" nonzero total + (round (/ (* 100.0 nonzero) total))) + (setq nrlibs (sort nrlibs #'string< :key #'car)) + (dolist (pair nrlibs) + (let ((exposedcount 0) (testcount 0)) + (when (member (car pair) *monitor-domains* :test #'string=) + (format t "for library ~s~%" (car pair)) + (dolist (item (sort (cdr pair) #'> :key #'monitor-data-count)) + (when (monitor-exposedp (monitor-data-name item)) + (incf exposedcount) + (when (> (monitor-data-count item) 0) (incf testcount)) + (format t "~5d ~s~%" + (monitor-data-count item) + (monitor-data-name item)))) + (if (= exposedcount testcount) + (format t "~a has all exposed functions tested~%" (car pair)) + (format t "Daly bug:~a has untested exposed functions~%" (car pair)))))) + nil)) + +@ + +\defun{monitor-parse}{Parse an )abbrev expression for the domain name} +<>= +(defun monitor-parse (expr) + (let (point1 point2) + (setq point1 (position #\space expr :test #'char=)) + (setq point1 (position #\space expr :start point1 :test-not #'char=)) + (setq point1 (position #\space expr :start point1 :test #'char=)) + (setq point1 (position #\space expr :start point1 :test-not #'char=)) + (setq point2 (position #\space expr :start point1 :test #'char=)) + (subseq expr point1 point2))) + +@ + +\defun{monitor-spadfile}{Given a spad file, report all nrlibs it creates} +\calls{monitor-spadfile}{monitor-parse} +\uses{monitor-spadfile}{*monitor-domains*} +<>= +(defun monitor-spadfile (name) + "given a spad file, report all nrlibs it creates" + (let (expr) + (declare (special *monitor-domains*)) + (with-open-file (in name) + (catch 'done + (loop + (setq expr (read-line in nil 'done)) + (when (eq expr 'done) (throw 'done nil)) + (when (and (> (length expr) 4) (string= (subseq expr 0 4) ")abb")) + (setq *monitor-domains* + (adjoin (monitor-parse expr) *monitor-domains* :test #'string=)))))))) + +@ + +\defun{monitor-percent}{Print percent of functions tested} +\uses{monitor-percent}{*monitor-table*} +<>= +(defun monitor-percent () + "Print percent of functions tested" + (let (nonzero total) + (declare (special *monitor-table*)) + (setq nonzero 0) + (setq total 0) + (maphash + #'(lambda (k v) + (declare (ignore k)) + (when (> (monitor-data-count v) 0) (incf nonzero)) + (incf total)) + *monitor-table*) + (format t "~d of ~d (~d percent) tested~%" nonzero total + (round (/ (* 100.0 nonzero) total))))) + +@ + +\defun{monitor-apropos}{Find all monitored symbols containing the string} +\uses{monitor-apropos}{*monitor-table*} +<>= +(defun monitor-apropos (str) + "given a string, find all monitored symbols containing the string + the search is case-insensitive. returns a list of monitor-data items" + (let (result) + (maphash + #'(lambda (k v) + (when + (search (string-upcase str) + (string-upcase (symbol-name k)) + :test #'string=) + (push v result))) + *monitor-table*) + result)) + +@ + \chapter{The Interpreter} <>= (in-package "BOOT") @@ -32039,6 +32991,35 @@ See Steele Common Lisp 1990 pp305-307 <> <> <> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> <> <> <> diff --git a/changelog b/changelog index 557de00..fe26a10 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,9 @@ +20100203 tpd src/axiom-website/patches.html 20100203.01.tpd.patch +20100203 tpd src/interp/Makefile remove monitor.lisp +20100203 tpd src/interp/monitor.lisp removed +20100203 tpd src/input/Makefile add monitortest +20100203 tpd src/input/monitortest.input.pamphlet unit test monitor code +20100203 tpd books/bookvol5 merge and remove monitor.lisp 20100202 tpd src/axiom-website/patches.html 20100202.01.tpd.patch 20100202 tpd src/interp/varini.lisp pick up functions from intint 20100202 tpd src/interp/pf2sex.lisp pick up functions from intint diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index c7c1e84..cf65fd3 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -2437,5 +2437,7 @@ books/bookvol8 redefine R1 in view3D for ARM processor
books/bookvol5 merge and remove compat.lisp
20100202.01.tpd.patch books/bookvol5 merge and remove intint.lisp
+20100203.01.tpd.patch +books/bookvol5 merge and remove monitor.lisp
diff --git a/src/input/Makefile.pamphlet b/src/input/Makefile.pamphlet index ac909c8..9bb11f9 100644 --- a/src/input/Makefile.pamphlet +++ b/src/input/Makefile.pamphlet @@ -350,7 +350,8 @@ REGRES= ackermann.regress \ macros.regress magma.regress mapleok.regress \ matbug.regress mathml.regress \ matrix1.regress matrix22.regress matrix.regress \ - mfinfact.regress mkfunc.regress mpoly.regress mset2.regress \ + mfinfact.regress mkfunc.regress monitortest.regress \ + mpoly.regress mset2.regress \ mset.regress multfact.regress multiple.regress ndftip.regress \ negfloats.regress nepip.regress newlodo.regress newton.regress \ newtonlisp.regress numericgamma.regress \ @@ -646,7 +647,8 @@ FILES= ${OUT}/ackermann.input \ ${OUT}/mapleok.input ${OUT}/matbug.input \ ${OUT}/mathml.input \ ${OUT}/matrix22.input ${OUT}/matrix.input ${OUT}/matrix1.input \ - ${OUT}/mfinfact.input ${OUT}/mkfunc.input ${OUT}/mountain.input \ + ${OUT}/mfinfact.input ${OUT}/mkfunc.input ${OUT}/monitortest.input \ + ${OUT}/mountain.input \ ${OUT}/mpoly.input ${OUT}/mset.input ${OUT}/mset2.input \ ${OUT}/multfact.input ${OUT}/multknot.input ${OUT}/mult3d.input \ ${OUT}/multiple.input \ @@ -974,7 +976,8 @@ DOCFILES= \ ${DOC}/matops.as.dvi ${DOC}/matrix1.input.dvi \ ${DOC}/matrix22.input.dvi ${DOC}/matrix.input.dvi \ ${DOC}/matrox.input.dvi ${DOC}/mfinfact.input.dvi \ - ${DOC}/mkfunc.input.dvi ${DOC}/mountain.input.dvi \ + ${DOC}/mkfunc.input.dvi ${DOC}/monitortest.input.dvi \ + ${DOC}/mountain.input.dvi \ ${DOC}/mpoly.input.dvi ${DOC}/mset2.input.dvi \ ${DOC}/mset.input.dvi ${DOC}/mult2d.input.dvi \ ${DOC}/mult3d.input.dvi ${DOC}/multfact.input.dvi \ diff --git a/src/input/monitortest.input.pamphlet b/src/input/monitortest.input.pamphlet new file mode 100644 index 0000000..bed61c0 --- /dev/null +++ b/src/input/monitortest.input.pamphlet @@ -0,0 +1,366 @@ +\documentclass{article} +\usepackage{axiom} +\begin{document} +\title{\$SPAD/src/input monitortest.input} +\author{Timothy Daly} +\maketitle +\begin{abstract} +\end{abstract} +\eject +\tableofcontents +\eject + +\begin{chunk}{testmon.lisp} +(defun foo1 () (print 'foo1)) +(defun foo2 () (print 'foo2)) +(defun foo3 () (foo1) (foo2) (print 'foo3)) +(defun foo4 () (print 'foo4)) +\end{chunk} + +\begin{chunk}{*} +)set break resume +)sys rm -f testmon.lisp +)sys rm -f monitortest.output +)spool monitortest.output +)set message test on +)set message auto off +)clear all + +\begin{chunk}{*} +--S 1 of 26 +)sys cp ../../src/input/monitortest.input.pamphlet . +--R +--E 1 + +\end{chunk}{*} + +\begin{chunk}{*} +--S 2 of 26 +)lisp (tangle "monitortest.input.pamphlet" "testmon.lisp" "testmon.lisp") +--R +--RValue = NIL +--E 2 + +\end{chunk}{*} + +First we load the file containing the code we would like to monitor. +\begin{chunk}{*} +--S 3 of 26 +)lisp (load "testmon.lisp") +--R +--RValue = T +--E 3 + +\end{chunk}{*} + +Next we monitor the file +\begin{chunk}{*} +--S 4 of 26 +)lisp (monitor-file "testmon.lisp") +--R +--Rmonitoring "testmon.lisp" +--RValue = NIL +--E 4 + +\end{chunk}{*} + +Now we call a function from the file and bump its count +\begin{chunk}{*} +--S 5 of 26 +)lisp (foo1) +--R +--R +--RFOO1 +--RValue = FOO1 +--E 5 + +\end{chunk}{*} + +and call another function to bump its count +\begin{chunk}{*} +--S 6 of 26 +)lisp (foo2) +--R +--R +--RFOO2 +--RValue = FOO2 +--E 6 + +\end{chunk}{*} + +and a third function that calls the other two (bump all three counts) +\begin{chunk}{*} +--S 7 of 26 +)lisp (foo3) +--R +--R +--RFOO1 +--RFOO2 +--RFOO3 +--RValue = FOO3 +--E 7 + +\end{chunk}{*} + +Now we check that the results are correct +\begin{chunk}{*} +--S 8 of 26 +)lisp (monitor-results) +--R +--R +--R#S(MONITOR-DATA NAME FOO1 COUNT 2 MONITORP T SOURCEFILE "testmon.lisp") +--R#S(MONITOR-DATA NAME FOO2 COUNT 2 MONITORP T SOURCEFILE "testmon.lisp") +--R#S(MONITOR-DATA NAME FOO3 COUNT 1 MONITORP T SOURCEFILE "testmon.lisp") +--R#S(MONITOR-DATA NAME FOO4 COUNT 0 MONITORP T SOURCEFILE "testmon.lisp") +--RValue = (NIL NIL NIL NIL) +--E 8 + +\end{chunk}{*} + +Stop counting calls to foo2 +\begin{chunk}{*} +--S 9 of 26 +)lisp (monitor-disable 'foo2) +--R +--RValue = NIL +--E 9 + +\end{chunk}{*} + +Invoke foo2 thru foo3 +\begin{chunk}{*} +--S 10 of 26 +)lisp (foo3) +--R +--R +--RFOO1 +--RFOO2 +--RFOO3 +--RValue = FOO3 +--E 10 + +\end{chunk}{*} + +Notice that foo1 and foo3 were bumped but not foo2 +\begin{chunk}{*} +--S 11 of 26 +)lisp (monitor-results) +--R +--R +--R#S(MONITOR-DATA NAME FOO1 COUNT 3 MONITORP T SOURCEFILE "testmon.lisp") +--R#S(MONITOR-DATA NAME FOO2 COUNT 2 MONITORP NIL SOURCEFILE +--R "testmon.lisp") +--R#S(MONITOR-DATA NAME FOO3 COUNT 2 MONITORP T SOURCEFILE "testmon.lisp") +--R#S(MONITOR-DATA NAME FOO4 COUNT 0 MONITORP T SOURCEFILE "testmon.lisp") +--RValue = (NIL NIL NIL NIL) +--E 11 + +\end{chunk}{*} + +Temporarily stop all monitoring +\begin{chunk}{*} +--S 12 of 26 +)lisp (monitor-disable) +--R +--RThe function FOO2 is not traced. +--RValue = NIL +--E 12 + +\end{chunk}{*} + +Check that nothing changes +\begin{chunk}{*} +--S 13 of 26 +)lisp (foo3) +--R +--R +--RFOO1 +--RFOO2 +--RFOO3 +--RValue = FOO3 +--E 13 + +\end{chunk}{*} + +No count has changed +\begin{chunk}{*} +--S 14 of 26 +)lisp (monitor-results) +--R +--R +--R#S(MONITOR-DATA NAME FOO1 COUNT 3 MONITORP NIL SOURCEFILE +--R "testmon.lisp") +--R#S(MONITOR-DATA NAME FOO2 COUNT 2 MONITORP NIL SOURCEFILE +--R "testmon.lisp") +--R#S(MONITOR-DATA NAME FOO3 COUNT 2 MONITORP NIL SOURCEFILE +--R "testmon.lisp") +--R#S(MONITOR-DATA NAME FOO4 COUNT 0 MONITORP NIL SOURCEFILE +--R "testmon.lisp") +--RValue = (NIL NIL NIL NIL) +--E 14 + +\end{chunk}{*} + +Monitor only calls to foo1 +\begin{chunk}{*} +--S 15 of 26 +)lisp (monitor-enable 'foo1) +--R +--RValue = T +--E 15 + +\end{chunk}{*} + +foo3 calls foo1 +\begin{chunk}{*} +--S 16 of 26 +)lisp (foo3) +--R +--R +--RFOO1 +--RFOO2 +--RFOO3 +--RValue = FOO3 +--E 16 + +\end{chunk}{*} + +foo1 has changed but not foo2 or foo3 +\begin{chunk}{*} +--S 17 of 26 +)lisp (monitor-results) +--R +--R +--R#S(MONITOR-DATA NAME FOO1 COUNT 4 MONITORP T SOURCEFILE "testmon.lisp") +--R#S(MONITOR-DATA NAME FOO2 COUNT 2 MONITORP NIL SOURCEFILE +--R "testmon.lisp") +--R#S(MONITOR-DATA NAME FOO3 COUNT 2 MONITORP NIL SOURCEFILE +--R "testmon.lisp") +--R#S(MONITOR-DATA NAME FOO4 COUNT 0 MONITORP NIL SOURCEFILE +--R "testmon.lisp") +--RValue = (NIL NIL NIL NIL) +--E 17 + +\end{chunk}{*} + +Monitor everybody +\begin{chunk}{*} +--S 18 of 26 +)lisp (monitor-enable) +--R +--RValue = NIL +--E 18 + +\end{chunk}{*} + +Check that everybody changes +\begin{chunk}{*} +--S 19 of 26 +)lisp (foo3) +--R +--R +--RFOO1 +--RFOO2 +--RFOO3 +--RValue = FOO3 +--E 19 + +\end{chunk}{*} + +Everybody was bumped +\begin{chunk}{*} +--S 20 of 26 +)lisp (monitor-results) +--R +--R +--R#S(MONITOR-DATA NAME FOO1 COUNT 5 MONITORP T SOURCEFILE "testmon.lisp") +--R#S(MONITOR-DATA NAME FOO2 COUNT 3 MONITORP T SOURCEFILE "testmon.lisp") +--R#S(MONITOR-DATA NAME FOO3 COUNT 3 MONITORP T SOURCEFILE "testmon.lisp") +--R#S(MONITOR-DATA NAME FOO4 COUNT 0 MONITORP T SOURCEFILE "testmon.lisp") +--RValue = (NIL NIL NIL NIL) +--E 20 + +\end{chunk}{*} + +What functions were tested? +\begin{chunk}{*} +--S 21 of 26 +)lisp (monitor-tested) +--R +--RValue = (FOO1 FOO2 FOO3) +--E 21 + +\end{chunk}{*} + +What functions were not tested? +\begin{chunk}{*} +--S 22 of 26 +)lisp (monitor-untested) +--R +--RValue = (FOO4) +--E 22 + +\end{chunk}{*} + +Untrace the whole world, monitoring cannot restart +\begin{chunk}{*} +--S 23 of 26 +)lisp (monitor-end) +--R +--RValue = NIL +--E 23 + +\end{chunk}{*} + +\begin{chunk}{*} +--S 24 of 26 +)lisp (monitor-results) +--R +--R +--R#S(MONITOR-DATA NAME FOO1 COUNT 5 MONITORP T SOURCEFILE "testmon.lisp") +--R#S(MONITOR-DATA NAME FOO2 COUNT 3 MONITORP T SOURCEFILE "testmon.lisp") +--R#S(MONITOR-DATA NAME FOO3 COUNT 3 MONITORP T SOURCEFILE "testmon.lisp") +--R#S(MONITOR-DATA NAME FOO4 COUNT 0 MONITORP T SOURCEFILE "testmon.lisp") +--RValue = (NIL NIL NIL NIL) +--E 24 + +\end{chunk}{*} + +Check that the functions still work +\begin{chunk}{*} +--S 25 of 26 +)lisp (foo3) +--R +--R +--RFOO1 +--RFOO2 +--RFOO3 +--RValue = FOO3 +--E 25 + +\end{chunk}{*} + +Check that monitoring is not occurring +\begin{chunk}{*} +--S 26 of 26 +)lisp (monitor-results) +--R +--R +--R#S(MONITOR-DATA NAME FOO1 COUNT 5 MONITORP T SOURCEFILE "testmon.lisp") +--R#S(MONITOR-DATA NAME FOO2 COUNT 2 MONITORP T SOURCEFILE "testmon.lisp") +--R#S(MONITOR-DATA NAME FOO3 COUNT 2 MONITORP T SOURCEFILE "testmon.lisp") +--R#S(MONITOR-DATA NAME FOO4 COUNT 0 MONITORP T SOURCEFILE "testmon.lisp") +--RValue = (NIL NIL NIL NIL) +--E 26 + +\end{chunk}{*} + +)spool +)lisp (bye) + +\end{chunk} +\eject +\begin{thebibliography}{99} +\bibitem{1} nothing +\end{thebibliography} +\end{document} diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index aefa4e7..56a2525 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -164,7 +164,6 @@ OBJS= ${OUT}/vmlisp.${O} \ ${OUT}/i-util.${O} \ ${OUT}/lisplib.${O} ${OUT}/macex.${O} \ ${OUT}/match.${O} \ - ${OUT}/monitor.${O} \ ${OUT}/msgdb.${O} ${OUT}/nci.${O} \ ${OUT}/newaux.${O} ${OUT}/newfort.${O} \ ${OUT}/nrunfast.${O} \ @@ -915,29 +914,6 @@ ${MID}/hypertex.lisp: ${IN}/hypertex.lisp.pamphlet @ -\subsection{monitor.lisp \cite{24}} -<>= -${OUT}/monitor.${O}: ${MID}/monitor.lisp - @ echo 76 making ${OUT}/monitor.${O} from ${MID}/monitor.lisp - @ ( cd ${MID} ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/monitor.lisp"' \ - ':output-file "${OUT}/monitor.${O}") (${BYE}))' | ${DEPSYS} ; \ - else \ - echo '(progn (compile-file "${MID}/monitor.lisp"' \ - ':output-file "${OUT}/monitor.${O}") (${BYE}))' | ${DEPSYS} \ - >${TMP}/trace ; \ - fi ) - -@ -<>= -${MID}/monitor.lisp: ${IN}/monitor.lisp.pamphlet - @ echo 77 making ${MID}/monitor.lisp from ${IN}/monitor.lisp.pamphlet - @ (cd ${MID} ; \ - ${TANGLE} ${IN}/monitor.lisp.pamphlet >monitor.lisp ) - -@ - \subsection{newaux.lisp \cite{25}} <>= ${OUT}/newaux.${O}: ${MID}/newaux.lisp @@ -3858,9 +3834,6 @@ clean: <> <> -<> -<> - <> <> diff --git a/src/interp/monitor.lisp.pamphlet b/src/interp/monitor.lisp.pamphlet deleted file mode 100644 index 8cab43c..0000000 --- a/src/interp/monitor.lisp.pamphlet +++ /dev/null @@ -1,809 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp monitor.lisp} -\author{Timothy Daly} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\begin{verbatim} -MONITOR - -This file contains a set of function for monitoring the execution -of the functions in a file. It constructs a hash table that contains -the function name as the key and monitor-data structures as the value - -The technique is to use a :cond parameter on trace to call the -monitor-incr function to incr the count every time a function is called - -*monitor-table* HASH TABLE - is the monitor table containing the hash entries -*monitor-nrlibs* LIST of STRING - list of nrlib filenames that are monitored -*monitor-domains* LIST of STRING - list of domains to monitor-report (default is all exposed domains) -monitor-data STRUCTURE - is the defstruct name of records in the table - name is the first field and is the name of the monitored function - count contains a count of times the function was called - monitorp is a flag that skips counting if nil, counts otherwise - sourcefile is the name of the file that contains the source code - - ***** SETUP, SHUTDOWN **** - -monitor-inittable () FUNCTION - creates the hashtable and sets *monitor-table* - note that it is called every time this file is loaded -monitor-end () FUNCTION - unhooks all of the trace hooks - - ***** TRACE, UNTRACE ***** - -monitor-add (name &optional sourcefile) FUNCTION - sets up the trace and adds the function to the table -monitor-delete (fn) FUNCTION - untraces a function and removes it from the table -monitor-enable (&optional fn) FUNCTION - starts tracing for all (or optionally one) functions that - are in the table -monitor-disable (&optional fn) FUNCTION - stops tracing for all (or optionally one) functions that - are in the table - -***** COUNTING, RECORDING ***** - -monitor-reset (&optional fn) FUNCTION - reset the table count for the table (or optionally, for a function) -monitor-incr (fn) FUNCTION - increments the count information for a function - it is called by trace to increment the count -monitor-decr (fn) FUNCTION - decrements the count information for a function -monitor-info (fn) FUNCTION - returns the monitor-data structure for a function - -***** FILE IO ***** - -monitor-write (items file) FUNCTION - writes a list of symbols or structures to a file -monitor-file (file) FUNCTION - will read a file, scan for defuns, monitor each defun - NOTE: monitor-file assumes that the file has been loaded - -***** RESULTS ***** - -monitor-results () FUNCTION - returns a list of the monitor-data structures -monitor-untested () FUNCTION - returns a list of files that have zero counts -monitor-tested (&optional delete) FUNCTION - returns a list of files that have nonzero counts - optionally calling monitor-delete on those functions - -***** CHECKPOINT/RESTORE ***** -monitor-checkpoint (file) FUNCTION - save the *monitor-table* in a loadable form -monitor-restore (file) FUNCTION - restore a checkpointed file so that everything is monitored - -***** ALGEBRA ***** -monitor-autoload () FUNCTION - traces autoload of algebra to monitor corresponding source files - NOTE: this requires the /spad/int/algebra directory -monitor-dirname (args) FUNCTION - expects a list of 1 libstream (loadvol's arglist) and monitors the source - this is a function called by monitor-autoload -monitor-nrlib (nrlib) FUNCTION - takes an nrlib name as a string (eg POLY) and returns a list of - monitor-data structures from that source file -monitor-report () FUNCTION - generate a report of the monitored activity for domains in - *monitor-domains* -monitor-spadfile (name) FUNCTION - given a spad file, report all nrlibs it creates - this adds each nrlib name to *monitor-domains* but does not - trace the functions from those domains -monitor-percent () FUNCTION - ratio of (functions executed)/(functions traced) -monitor-apropos (str) FUNCTION - given a string, find all monitored symbols containing the string - the search is case-insensitive. returns a list of monitor-data items - -for example: - suppose we have a file "/u/daly/testmon.lisp" that contains: - (defun foo1 () (print 'foo1)) - (defun foo2 () (print 'foo2)) - (defun foo3 () (foo1) (foo2) (print 'foo3)) - (defun foo4 () (print 'foo4)) - - an example session is: - - ; FIRST WE LOAD THE FILE (WHICH INITS *monitor-table*) - - >(load "/u/daly/monitor.lisp") - Loading /u/daly/monitor.lisp - Finished loading /u/daly/monitor.lisp - T - - ; SECOND WE LOAD THE TESTMON FILE - >(load "/u/daly/testmon.lisp") - T - - ; THIRD WE MONITOR THE FILE - >(monitor-file "/u/daly/testmon.lisp") - monitoring "/u/daly/testmon.lisp" - NIL - - ; FOURTH WE CALL A FUNCTION FROM THE FILE (BUMP ITS COUNT) - >(foo1) - - FOO1 - FOO1 - - ; AND ANOTHER FUNCTION (BUMP ITS COUNT) - >(foo2) - - FOO2 - FOO2 - - ; AND A THIRD FUNCTION THAT CALLS THE OTHER TWO (BUMP ALL THREE) - >(foo3) - - FOO1 - FOO2 - FOO3 - FOO3 - - ; CHECK THAT THE RESULTS ARE CORRECT - - >(monitor-results) - (#S(MONITOR-DATA NAME FOO1 COUNT 2 MONITORP T SOURCEFILE - "/u/daly/testmon.lisp") - #S(MONITOR-DATA NAME FOO2 COUNT 2 MONITORP T SOURCEFILE - "/u/daly/testmon.lisp") - #S(MONITOR-DATA NAME FOO3 COUNT 1 MONITORP T SOURCEFILE - "/u/daly/testmon.lisp")) - #S(MONITOR-DATA NAME FOO4 COUNT 0 MONITORP T SOURCEFILE - "/u/daly/testmon.lisp")) - - ; STOP COUNTING CALLS TO FOO2 - - >(monitor-disable 'foo2) - NIL - - ; INVOKE FOO2 THRU FOO3 - - >(foo3) - - FOO1 - FOO2 - FOO3 - FOO3 - - ; NOTICE THAT FOO1 AND FOO3 WERE BUMPED BUT NOT FOO2 - >(monitor-results) - (#S(MONITOR-DATA NAME FOO1 COUNT 3 MONITORP T SOURCEFILE - "/u/daly/testmon.lisp") - #S(MONITOR-DATA NAME FOO2 COUNT 2 MONITORP NIL SOURCEFILE - "/u/daly/testmon.lisp") - #S(MONITOR-DATA NAME FOO3 COUNT 2 MONITORP T SOURCEFILE - "/u/daly/testmon.lisp")) - #S(MONITOR-DATA NAME FOO4 COUNT 0 MONITORP T SOURCEFILE - "/u/daly/testmon.lisp")) - - ; TEMPORARILY STOP ALL MONITORING - - >(monitor-disable) - NIL - - ; CHECK THAT NOTHING CHANGES - - >(foo3) - - FOO1 - FOO2 - FOO3 - FOO3 - - ; NO COUNT HAS CHANGED - - >(monitor-results) - (#S(MONITOR-DATA NAME FOO1 COUNT 3 MONITORP NIL SOURCEFILE - "/u/daly/testmon.lisp") - #S(MONITOR-DATA NAME FOO2 COUNT 2 MONITORP NIL SOURCEFILE - "/u/daly/testmon.lisp") - #S(MONITOR-DATA NAME FOO3 COUNT 2 MONITORP NIL SOURCEFILE - "/u/daly/testmon.lisp")) - #S(MONITOR-DATA NAME FOO4 COUNT 0 MONITORP T SOURCEFILE - "/u/daly/testmon.lisp")) - - ; MONITOR ONLY CALLS TO FOO1 - - >(monitor-enable 'foo1) - T - - ; FOO3 CALLS FOO1 - - >(foo3) - - FOO1 - FOO2 - FOO3 - FOO3 - - ; FOO1 HAS CHANGED BUT NOT FOO2 OR FOO3 - - >(monitor-results) - (#S(MONITOR-DATA NAME FOO1 COUNT 4 MONITORP T SOURCEFILE - "/u/daly/testmon.lisp") - #S(MONITOR-DATA NAME FOO2 COUNT 2 MONITORP NIL SOURCEFILE - "/u/daly/testmon.lisp") - #S(MONITOR-DATA NAME FOO3 COUNT 2 MONITORP NIL SOURCEFILE - "/u/daly/testmon.lisp")) - #S(MONITOR-DATA NAME FOO4 COUNT 0 MONITORP T SOURCEFILE - "/u/daly/testmon.lisp")) - - ; MONITOR EVERYBODY - - >(monitor-enable) - NIL - - ; CHECK THAT EVERYBODY CHANGES - - >(foo3) - - FOO1 - FOO2 - FOO3 - FOO3 - - ; EVERYBODY WAS BUMPED - - >(monitor-results) - (#S(MONITOR-DATA NAME FOO1 COUNT 5 MONITORP T SOURCEFILE - "/u/daly/testmon.lisp") - #S(MONITOR-DATA NAME FOO2 COUNT 3 MONITORP T SOURCEFILE - "/u/daly/testmon.lisp") - #S(MONITOR-DATA NAME FOO3 COUNT 3 MONITORP T SOURCEFILE - "/u/daly/testmon.lisp")) - #S(MONITOR-DATA NAME FOO4 COUNT 0 MONITORP T SOURCEFILE - "/u/daly/testmon.lisp")) - - ; WHAT FUNCTIONS WERE TESTED? - - >(monitor-tested) - (FOO1 FOO2 FOO3) - - ; WHAT FUNCTIONS WERE NOT TESTED? - - >(monitor-untested) - (FOO4) - - ; UNTRACE THE WHOLE WORLD, MONITORING CANNOT RESTART - - >(monitor-end) - NIL - - ; CHECK THE RESULTS - - >(monitor-results) - (#S(MONITOR-DATA NAME FOO1 COUNT 5 MONITORP T SOURCEFILE - "/u/daly/testmon.lisp") - #S(MONITOR-DATA NAME FOO2 COUNT 3 MONITORP T SOURCEFILE - "/u/daly/testmon.lisp") - #S(MONITOR-DATA NAME FOO3 COUNT 3 MONITORP T SOURCEFILE - "/u/daly/testmon.lisp")) - #S(MONITOR-DATA NAME FOO4 COUNT 0 MONITORP T SOURCEFILE - "/u/daly/testmon.lisp")) - - ; CHECK THAT THE FUNCTIONS STILL WORK - - >(foo3) - - FOO1 - FOO2 - FOO3 - FOO3 - - ; CHECK THAT MONITORING IS NOT OCCURING - - >(monitor-results) - (#S(MONITOR-DATA NAME FOO1 COUNT 5 MONITORP T SOURCEFILE - "/u/daly/testmon.lisp") - #S(MONITOR-DATA NAME FOO2 COUNT 3 MONITORP T SOURCEFILE - "/u/daly/testmon.lisp") - #S(MONITOR-DATA NAME FOO3 COUNT 3 MONITORP T SOURCEFILE - "/u/daly/testmon.lisp")) - #S(MONITOR-DATA NAME FOO4 COUNT 0 MONITORP T SOURCEFILE - "/u/daly/testmon.lisp")) - -\end{verbatim} -\section{License} -<>= -;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -;; All rights reserved. -;; -;; Redistribution and use in source and binary forms, with or without -;; modification, are permitted provided that the following conditions are -;; met: -;; -;; - Redistributions of source code must retain the above copyright -;; notice, this list of conditions and the following disclaimer. -;; -;; - Redistributions in binary form must reproduce the above copyright -;; notice, this list of conditions and the following disclaimer in -;; the documentation and/or other materials provided with the -;; distribution. -;; -;; - Neither the name of The Numerical ALgorithms Group Ltd. nor the -;; names of its contributors may be used to endorse or promote products -;; derived from this software without specific prior written permission. -;; -;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS -;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A -;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER -;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, -;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, -;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR -;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF -;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -@ -<<*>>= -<> - -(in-package "BOOT") - -(defun monitor-help () - (format t "~% -;;; MONITOR -;;; -;;; This file contains a set of function for monitoring the execution -;;; of the functions in a file. It constructs a hash table that contains -;;; the function name as the key and monitor-data structures as the value -;;; -;;; The technique is to use a :cond parameter on trace to call the -;;; monitor-incr function to incr the count every time a function is called -;;; -;;; *monitor-table* HASH TABLE -;;; is the monitor table containing the hash entries -;;; *monitor-nrlibs* LIST of STRING -;;; list of nrlib filenames that are monitored -;;; *monitor-domains* LIST of STRING -;;; list of domains to monitor-report (default is all exposed domains) -;;; monitor-data STRUCTURE -;;; is the defstruct name of records in the table -;;; name is the first field and is the name of the monitored function -;;; count contains a count of times the function was called -;;; monitorp is a flag that skips counting if nil, counts otherwise -;;; sourcefile is the name of the file that contains the source code -;;; -;;; ***** SETUP, SHUTDOWN **** -;;; -;;; monitor-inittable () FUNCTION -;;; creates the hashtable and sets *monitor-table* -;;; note that it is called every time this file is loaded -;;; monitor-end () FUNCTION -;;; unhooks all of the trace hooks -;;; -;;; ***** TRACE, UNTRACE ***** -;;; -;;; monitor-add (name &optional sourcefile) FUNCTION -;;; sets up the trace and adds the function to the table -;;; monitor-delete (fn) FUNCTION -;;; untraces a function and removes it from the table -;;; monitor-enable (&optional fn) FUNCTION -;;; starts tracing for all (or optionally one) functions that -;;; are in the table -;;; monitor-disable (&optional fn) FUNCTION -;;; stops tracing for all (or optionally one) functions that -;;; are in the table -;;; -;;; ***** COUNTING, RECORDING ***** -;;; -;;; monitor-reset (&optional fn) FUNCTION -;;; reset the table count for the table (or optionally, for a function) -;;; monitor-incr (fn) FUNCTION -;;; increments the count information for a function -;;; it is called by trace to increment the count -;;; monitor-decr (fn) FUNCTION -;;; decrements the count information for a function -;;; monitor-info (fn) FUNCTION -;;; returns the monitor-data structure for a function -;;; -;;; ***** FILE IO ***** -;;; -;;; monitor-write (items file) FUNCTION -;;; writes a list of symbols or structures to a file -;;; monitor-file (file) FUNCTION -;;; will read a file, scan for defuns, monitor each defun -;;; NOTE: monitor-file assumes that the file has been loaded -;;; -;;; ***** RESULTS ***** -;;; -;;; monitor-results () FUNCTION -;;; returns a list of the monitor-data structures -;;; monitor-untested () FUNCTION -;;; returns a list of files that have zero counts -;;; monitor-tested (&optional delete) FUNCTION -;;; returns a list of files that have nonzero counts -;;; optionally calling monitor-delete on those functions -;;; -;;; ***** CHECKPOINT/RESTORE ***** -;;; -;;; monitor-checkpoint (file) FUNCTION -;;; save the *monitor-table* in a loadable form -;;; monitor-restore (file) FUNCTION -;;; restore a checkpointed file so that everything is monitored -;;; -;;; ***** ALGEBRA ***** -;;; -;;; monitor-autoload () FUNCTION -;;; traces autoload of algebra to monitor corresponding source files -;;; NOTE: this requires the /spad/int/algebra directory -;;; monitor-dirname (args) FUNCTION -;;; expects a list of 1 libstream (loadvol's arglist) and monitors the source -;;; this is a function called by monitor-autoload -;;; monitor-nrlib (nrlib) FUNCTION -;;; takes an nrlib name as a string (eg POLY) and returns a list of -;;; monitor-data structures from that source file -;;; monitor-report () FUNCTION -;;; generate a report of the monitored activity for domains in -;;; *monitor-domains* -;;; monitor-spadfile (name) FUNCTION -;;; given a spad file, report all nrlibs it creates -;;; this adds each nrlib name to *monitor-domains* but does not -;;; trace the functions from those domains -;;; monitor-percent () FUNCTION -;;; ratio of (functions executed)/(functions traced) -;;; monitor-apropos (str) FUNCTION -;;; given a string, find all monitored symbols containing the string -;;; the search is case-insensitive. returns a list of monitor-data items -") nil) - -(defvar *monitor-domains* nil "a list of domains to report") - -(defvar *monitor-nrlibs* nil "a list of nrlibs that have been traced") - -(defvar *monitor-table* nil "a table of all of the monitored data") - -(defstruct monitor-data name count monitorp sourcefile) - -(unless (fboundp 'libstream-dirname) - (defstruct libstream mode dirname (indextable nil) (indexstream nil))) - -(defun monitor-inittable () - "initialize the table" - (setq *monitor-table* (make-hash-table))) - -(eval-when (eval load) - (unless *monitor-table* (monitor-inittable))) - -(defun monitor-end () - "stop the whole monitoring process. we cannot restart" - (maphash - #'(lambda (key value) - (declare (ignore value)) - (eval `(untrace ,key))) - *monitor-table*)) - -(defun monitor-results () - "return a list of the monitor-data structures" - (let (result) - (maphash - #'(lambda (key value) - (declare (ignore key)) - (push value result)) - *monitor-table*) - result)) - -(defun monitor-add (name &optional sourcefile) - "add a function to the hash table" - (unless (fboundp name) (load sourcefile)) - (when (gethash name *monitor-table*) - (monitor-delete name)) - (eval `(trace (,name :cond (progn (monitor-incr ',name) nil)))) - (setf (gethash name *monitor-table*) - (make-monitor-data - :name name :count 0 :monitorp t :sourcefile sourcefile))))) - -(defun monitor-delete (fn) - "delete a function from the monitor table" - (eval `(untrace ,fn)) - (remhash fn *monitor-table*)) - -(defun monitor-enable (&optional fn) - "enable all (or optionally one) function for monitoring" - (if fn - (progn - (eval `(trace (,fn :cond (progn (monitor-incr ',fn) nil)))) - (setf (monitor-data-monitorp (gethash fn *monitor-table*)) t)) - (maphash - #'(lambda (key value) - (declare (ignore value)) - (eval `(trace (,fn :cond (progn (monitor-incr ',fn) nil)))) - (setf (monitor-data-monitorp (gethash key *monitor-table*)) t)) - *monitor-table*))) - -(defun monitor-disable (&optional fn) - "disable all (or optionally one) function for monitoring" - (if fn - (progn - (eval `(untrace ,fn)) - (setf (monitor-data-monitorp (gethash fn *monitor-table*)) nil)) - (maphash - #'(lambda (key value) - (declare (ignore value)) - (eval `(untrace ,fn)) - (setf (monitor-data-monitorp (gethash key *monitor-table*)) nil)) - *monitor-table*))) - -(defun monitor-reset (&optional fn) - "reset the table count for the table (or optionally, for a function)" - (if fn - (setf (monitor-data-count (gethash fn *monitor-table*)) 0) - (maphash - #'(lambda (key value) - (declare (ignore value)) - (setf (monitor-data-count (gethash key *monitor-table*)) 0)) - *monitor-table*))) - -(defun monitor-incr (fn) - "incr the count of fn by 1" - (let (data) - (setq data (gethash fn *monitor-table*)) - (if data - (incf (monitor-data-count data)) ;; change table entry by side-effect - (warn "~s is monitored but not in table..do (untrace ~s)~%" fn fn)))) - -(defun monitor-decr (fn) - "decr the count of fn by 1" - (let (data) - (setq data (gethash fn *monitor-table*)) - (if data - (decf (monitor-data-count data)) ;; change table entry by side-effect - (warn "~s is monitored but not in table..do (untrace ~s)~%" fn fn)))) - -(defun monitor-info (fn) - "return the information for a function" - (gethash fn *monitor-table*)) - -(defun monitor-file (file) - "hang a monitor call on all of the defuns in a file" - (let (expr (package "BOOT")) - (format t "monitoring ~s~%" file) - (with-open-file (in file) - (catch 'done - (loop - (setq expr (read in nil 'done)) - (when (eq expr 'done) (throw 'done nil)) - (if (and (consp expr) (eq (car expr) 'in-package)) - (if (and (consp (second expr)) (eq (first (second expr)) 'quote)) - (setq package (string (second (second expr)))) - (setq package (second expr))) - (when (and (consp expr) (eq (car expr) 'defun)) - (monitor-add (intern (string (second expr)) package) file)))))))) - -(defun monitor-untested () - "return a list of the functions with zero count fields" - (let (result) - (maphash - #'(lambda (key value) - (if (and (monitor-data-monitorp value) (= (monitor-data-count value) 0)) - (push key result))) - *monitor-table*) - result)) - -(defun monitor-tested (&optional delete) - "return a list of the functions with non-zero count fields, optionally deleting them" - (let (result) - (maphash - #'(lambda (key value) - (when (and (monitor-data-monitorp value) (> (monitor-data-count value) 0)) - (when delete (monitor-delete key)) - (push key result))) - *monitor-table*) - result)) - -(defun monitor-write (items file) - "write out a list of symbols or structures to a file" - (with-open-file (out file :direction :output) - (dolist (item items) - (if (symbolp item) - (format out "~s~%" item) - (format out "~s~50t~s~100t~s~%" - (monitor-data-sourcefile item) - (monitor-data-name item) - (monitor-data-count item)))))) - -(defun monitor-checkpoint (file) - "save the *monitor-table* in loadable form" - (let ((*print-package* t)) - (declare (special *print-package*)) - (with-open-file (out file :direction :output) - (format out "(in-package \"BOOT\")~%") - (format out "(monitor-inittable)~%") - (dolist (data (monitor-results)) - (format out "(monitor-add '~s ~s)~%" - (monitor-data-name data) - (monitor-data-sourcefile data)) - (format out "(setf (gethash '~s *monitor-table*) - (make-monitor-data :name '~s :count ~s :monitorp ~s - :sourcefile ~s))~%" - (monitor-data-name data) - (monitor-data-name data) - (monitor-data-count data) - (monitor-data-monitorp data) - (monitor-data-sourcefile data)))))) - -(defun monitor-restore (file) - "restore a checkpointed file so that everything is monitored" - (load file)) - -;; these functions are used for testing the algebra code - -(defun monitor-dirname (args) - "expects a list of 1 libstream (loadvol's arglist) and monitors the source" - (let (name) - (setq name (libstream-dirname (car args))) - (setq name (file-namestring name)) - (setq name (concatenate 'string "/spad/int/algebra/" name "/code.lsp")) - (when (probe-file name) - (push name *monitor-nrlibs*) - (monitor-file name)))) - -(defun monitor-autoload () - "traces autoload of algebra to monitor corresponding source files" - (trace (vmlisp::loadvol - :entrycond nil - :exitcond (progn (monitor-dirname system::arglist) nil)))) - -(defun monitor-nrlib (nrlib) - "takes an nrlib name as a string (eg POLY) and returns a list of - monitor-data structures from that source file" - (let (result) - (maphash - #'(lambda (k v) - (declare (ignore k)) - (when (string= nrlib - (pathname-name (car (last - (pathname-directory (monitor-data-sourcefile v)))))) - (push v result))) - *monitor-table*) - result)) - -(defun monitor-libname (item) - "given a monitor-data item, extract the nrlib name" - (pathname-name (car (last - (pathname-directory (monitor-data-sourcefile item)))))) - -(defun monitor-exposedp (fn) - "exposed functions have more than 1 semicolon. given a symbol, count them" - (> (count #\; (symbol-name fn)) 1)) - -;;; TPDHERE note that the file interp.exposed no longer exists. -;;; The exposure information is now in bookvol5 -;;; This needs to work off the internal exposure list, not the file. -(defun monitor-readinterp () - "read interp.exposed to initialize *monitor-domains* to exposed domains. - this is the default action. adding or deleting domains from the list - will change the report results" - (let (skip expr name) - (declare (special *monitor-domains*)) - (setq *monitor-domains* nil) - (with-open-file (in "/spad/src/algebra/interp.exposed") - (read-line in) - (read-line in) - (read-line in) - (read-line in) - (catch 'done - (loop - (setq expr (read-line in nil "done")) - (when (string= expr "done") (throw 'done nil)) - (cond - ((string= expr "basic") (setq skip nil)) - ((string= expr "categories") (setq skip t)) - ((string= expr "hidden") (setq skip t)) - ((string= expr "defaults") (setq skip nil))) - (when (and (not skip) (> (length expr) 58)) - (setq name (subseq expr 58 (length expr))) - (setq name (string-right-trim '(#\space) name)) - (when (> (length name) 0) - (push name *monitor-domains*)))))))) - -(defun monitor-report () - "generate a report of the monitored activity for domains in *monitor-domains*" - (let (nrlibs nonzero total) - (unless *monitor-domains* (monitor-readinterp)) - (setq nonzero 0) - (setq total 0) - (maphash - #'(lambda (k v) - (declare (ignore k)) - (let (nextlib point) - (when (> (monitor-data-count v) 0) (incf nonzero)) - (incf total) - (setq nextlib (monitor-libname v)) - (setq point (member nextlib nrlibs :test #'string= :key #'car)) - (if point - (setf (cdr (first point)) (cons v (cdr (first point)))) - (push (cons nextlib (list v)) nrlibs)))) - *monitor-table*) - (format t "~d of ~d (~d percent) tested~%" nonzero total - (round (/ (* 100.0 nonzero) total))) - (setq nrlibs (sort nrlibs #'string< :key #'car)) - (dolist (pair nrlibs) - (let ((exposedcount 0) (testcount 0)) - (when (member (car pair) *monitor-domains* :test #'string=) - (format t "for library ~s~%" (car pair)) - (dolist (item (sort (cdr pair) #'> :key #'monitor-data-count)) - (when (monitor-exposedp (monitor-data-name item)) - (incf exposedcount) - (when (> (monitor-data-count item) 0) (incf testcount)) - (format t "~5d ~s~%" - (monitor-data-count item) - (monitor-data-name item)))) - (if (= exposedcount testcount) - (format t "~a has all exposed functions tested~%" (car pair)) - (format t "Daly bug:~a has untested exposed functions~%" (car pair)))))) - nil)) - -(defun monitor-parse (expr) - (let (point1 point2) - (setq point1 (position #\space expr :test #'char=)) - (setq point1 (position #\space expr :start point1 :test-not #'char=)) - (setq point1 (position #\space expr :start point1 :test #'char=)) - (setq point1 (position #\space expr :start point1 :test-not #'char=)) - (setq point2 (position #\space expr :start point1 :test #'char=)) - (subseq expr point1 point2))) - -(defun monitor-spadfile (name) - "given a spad file, report all nrlibs it creates" - (let (expr) - (with-open-file (in name) - (catch 'done - (loop - (setq expr (read-line in nil 'done)) - (when (eq expr 'done) (throw 'done nil)) - (when (and (> (length expr) 4) (string= (subseq expr 0 4) ")abb")) - (setq *monitor-domains* - (adjoin (monitor-parse expr) *monitor-domains* :test #'string=)))))))) - -(defun monitor-percent () - (let (nonzero total) - (setq nonzero 0) - (setq total 0) - (maphash - #'(lambda (k v) - (declare (ignore k)) - (when (> (monitor-data-count v) 0) (incf nonzero)) - (incf total)) - *monitor-table*) - (format t "~d of ~d (~d percent) tested~%" nonzero total - (round (/ (* 100.0 nonzero) total))))) - -(defun monitor-apropos (str) - "given a string, find all monitored symbols containing the string - the search is case-insensitive. returns a list of monitor-data items" - (let (result) - (maphash - #'(lambda (k v) - (when - (search (string-upcase str) - (string-upcase (symbol-name k)) - :test #'string=) - (push v result))) - *monitor-table*) - result)) -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document}