1-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. 2-- All rights reserved. 3-- 4-- Redistribution and use in source and binary forms, with or without 5-- modification, are permitted provided that the following conditions are 6-- met: 7-- 8-- - Redistributions of source code must retain the above copyright 9-- notice, this list of conditions and the following disclaimer. 10-- 11-- - Redistributions in binary form must reproduce the above copyright 12-- notice, this list of conditions and the following disclaimer in 13-- the documentation and/or other materials provided with the 14-- distribution. 15-- 16-- - Neither the name of The Numerical ALgorithms Group Ltd. nor the 17-- names of its contributors may be used to endorse or promote products 18-- derived from this software without specific prior written permission. 19-- 20-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS 21-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED 22-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A 23-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER 24-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 25-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 26-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 27-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 28-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 29-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 30-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 32)package "BOOT" 33 34--% Code instrumentation facilities 35-- These functions can be used with arbitrary lists of 36-- named stats (listofnames) grouped in classes (listofclasses) 37-- and with measurement types (property, classproperty). 38 39makeLongStatStringByProperty _ 40 (listofnames, listofclasses, property, classproperty, units, flag) == 41 total := 0 42 str := '"" 43 otherStatTotal := GET('other, property) 44 for [name,class,:ab] in listofnames repeat 45 name = 'other => 'iterate 46 cl := first LASSOC(class, listofclasses) 47 n := GET(name, property) 48 PUT(cl, classproperty, n + GET(cl, classproperty)) 49 total := total + n 50 if n >= 0.01 51 then timestr := normalizeStatAndStringify n 52 else 53 timestr := '"" 54 otherStatTotal := otherStatTotal + n 55 str := makeStatString(str,timestr,ab,flag) 56 otherStatTotal := otherStatTotal 57 PUT('other, property, otherStatTotal) 58 if otherStatTotal > 0 then 59 str := makeStatString(str,normalizeStatAndStringify otherStatTotal,'O,flag) 60 total := total + otherStatTotal 61 cl := first LASSOC('other, listofnames) 62 cl := first LASSOC(cl, listofclasses) 63 PUT(cl, classproperty, otherStatTotal + GET(cl, classproperty)) 64 if flag ~= 'long then 65 total := 0 66 str := '"" 67 for [class,name,:ab] in listofclasses repeat 68 n := GET(name, classproperty) 69 n = 0.0 => 'iterate 70 total := total + n 71 timestr := normalizeStatAndStringify n 72 str := makeStatString(str,timestr,ab,flag) 73 total := STRCONC(normalizeStatAndStringify total,'" ", units) 74 str = '"" => total 75 STRCONC(str, '" = ", total) 76 77normalizeStatAndStringify t == 78 FLOATP t => 79 t := roundStat t 80 t = 0.0 => '"0" 81 FORMAT(nil,'"~,2F",t) 82 INTEGERP t => 83 K := 1024 84 M := K*K 85 t > 9*M => CONCAT(STRINGIMAGE((t + 512*K)/M), '"M") 86 t > 9*K => CONCAT(STRINGIMAGE((t + 512)/K), '"K") 87 STRINGIMAGE t 88 STRINGIMAGE t 89 90significantStat t == 91 FLOATP t => (t > 0.01) 92 INTEGERP t => (t > 100) 93 true 94 95roundStat t == 96 not FLOATP t => t 97 (TRUNCATE (0.5 + t * 1000.0)) / 1000.0 98 99makeStatString(oldstr,time,abb,flag) == 100 time = '"" => oldstr 101 opening := (flag = 'long => '"("; '" (") 102 oldstr = '"" => STRCONC(time,opening,abb,'")") 103 STRCONC(oldstr,'" + ",time,opening,abb,'")") 104 105peekTimedName() == IFCAR $timedNameStack 106 107popTimedName() == 108 name := IFCAR $timedNameStack 109 $timedNameStack := IFCDR $timedNameStack 110 name 111 112pushTimedName name == 113 PUSH(name,$timedNameStack) 114 115startTimingProcess name == 116 updateTimedName peekTimedName() 117 pushTimedName name 118 if EQ(name, 'load) then statRecordLoadEvent() 119 120stopTimingProcess name == 121 (name ~= peekTimedName()) and null $InteractiveMode => 122 keyedSystemError("S2GL0015",[name,peekTimedName()]) 123 updateTimedName peekTimedName() 124 popTimedName() 125 126--% Instrumentation specific to the interpreter 127DEFPARAMETER($oldElapsedSpace, 0) 128DEFPARAMETER($oldElapsedGCTime, 0.0) 129DEFPARAMETER($oldElapsedTime, 0.0) 130DEFPARAMETER($gcTimeTotal, 0.0) 131 132-- $timedNameStack is used to hold the names of sections of the 133-- code being timed. 134 135DEFPARAMETER($timedNameStack, '(other)) 136 137DEFPARAMETER($interpreterTimedNames, '( 138-- name class abbrev 139 (algebra 2 . B) _ 140 (analysis 1 . A) _ 141 (coercion 1 . C) _ 142 (compilation 3 . T) _ 143 (debug 3 . D) _ 144 (evaluation 2 . E) _ 145 (gc 4 . G) _ 146 (history 3 . H) _ 147 (instantiation 3 . I) _ 148 (load 3 . L) _ 149 (modemaps 1 . M) _ 150 (optimization 3 . Z) _ 151 (querycoerce 1 . Q) _ 152 (other 3 . O) _ 153 (diskread 3 . K) _ 154 (resolve 1 . R) _ 155 )) 156 157DEFPARAMETER($interpreterTimedClasses, '( 158-- number class name short name 159 ( 1 interpreter . IN) _ 160 ( 2 evaluation . EV) _ 161 ( 3 other . OT) _ 162 ( 4 reclaim . GC) _ 163 )) 164 165initializeTimedNames(listofnames,listofclasses) == 166 for [name,:.] in listofnames repeat 167 PUT(name, 'TimeTotal, 0.0) 168 PUT(name, 'SpaceTotal, 0) 169 for [.,name,:.] in listofclasses repeat 170 PUT( name, 'ClassTimeTotal, 0.0) 171 PUT( name, 'ClassSpaceTotal, 0) 172 $timedNameStack := '(other) 173 computeElapsedTime() 174 PUT('gc, 'TimeTotal, 0.0) 175 PUT('gc, 'SpaceTotal, 0) 176 NIL 177 178updateTimedName name == 179 count := (GET(name, 'TimeTotal) or 0) + computeElapsedTime() 180 PUT(name, 'TimeTotal, count) 181 182makeLongTimeString(listofnames,listofclasses) == 183 makeLongStatStringByProperty(listofnames, listofclasses, _ 184 'TimeTotal, 'ClassTimeTotal, _ 185 '"sec", $printTimeIfTrue) 186 187makeLongSpaceString(listofnames,listofclasses) == 188 makeLongStatStringByProperty(listofnames, listofclasses, _ 189 'SpaceTotal, 'ClassSpaceTotal, _ 190 '"bytes", $printStorageIfTrue) 191 192DEFPARAMETER($inverseTimerTicksPerSecond, 1.0/$timerTicksPerSecond) 193 194computeElapsedTime() == 195 -- in total time lists, CAR is VIRTCPU and CADR is TOTCPU 196 currentTime:= elapsedUserTime() 197 currentGCTime:= elapsedGcTime() 198 gcDelta := currentGCTime - $oldElapsedGCTime 199 elapsedSeconds:= $inverseTimerTicksPerSecond * 200 (currentTime-$oldElapsedTime-gcDelta) 201 PUT('gc, 'TimeTotal, GET('gc, 'TimeTotal) + 202 $inverseTimerTicksPerSecond*gcDelta) 203 $oldElapsedTime := currentTime 204 $oldElapsedGCTime := currentGCTime 205 elapsedSeconds 206 207computeElapsedSpace() == 208 currentElapsedSpace := HEAPELAPSED() 209 elapsedBytes := currentElapsedSpace - $oldElapsedSpace 210 $oldElapsedSpace := currentElapsedSpace 211 elapsedBytes 212 213timedAlgebraEvaluation(code) == 214 startTimingProcess 'algebra 215 r := eval code 216 stopTimingProcess 'algebra 217 r 218 219timedOptimization(code) == 220 startTimingProcess 'optimization 221 r := lispize code 222 if $reportOptimization then 223 sayBrightlyI bright '"Optimized LISP code:" 224 pp r 225 stopTimingProcess 'optimization 226 r 227 228timedEVALFUN(code) == 229 startTimingProcess 'evaluation 230 r := timedEvaluate code 231 stopTimingProcess 'evaluation 232 r 233 234timedEvaluate code == 235 code is ["LIST",:a] and #a > 200 => 236 "append"/[eval ["LIST",:x] for x in splitIntoBlocksOf200 a] 237 eval code 238 239displayHeapStatsIfWanted() == 240 $printStorageIfTrue => sayBrightly OLDHEAPSTATS() 241 242--% stubs for the stats summary fns 243statRecordInstantiationEvent() == nil 244statRecordLoadEvent() == nil 245 246statisticsSummary() == '"No statistics available." 247