aboutsummaryrefslogtreecommitdiff
path: root/src/interp/g-timer.boot.pamphlet
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp/g-timer.boot.pamphlet')
-rw-r--r--src/interp/g-timer.boot.pamphlet292
1 files changed, 292 insertions, 0 deletions
diff --git a/src/interp/g-timer.boot.pamphlet b/src/interp/g-timer.boot.pamphlet
new file mode 100644
index 00000000..513e367d
--- /dev/null
+++ b/src/interp/g-timer.boot.pamphlet
@@ -0,0 +1,292 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp g-timer.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<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.
+
+@
+<<*>>=
+<<license>>
+
+--% Code instrumentation facilities
+-- These functions can be used with arbitrary lists of
+-- named stats (listofnames) grouped in classes (listofclasses)
+-- and with measurement types (property, classproperty).
+
+printNamedStatsByProperty(listofnames, property) ==
+ total := +/[GETL(name,property) for [name,:.] in listofnames]
+ for [name,:.] in listofnames repeat
+ n := GETL(name, property)
+ strname := STRINGIMAGE name
+ strval := STRINGIMAGE n
+ sayBrightly concat(bright strname,
+ fillerSpaces(70-#strname-#strval,'"."),bright strval)
+ sayBrightly bright fillerSpaces(72,'"-")
+ sayBrightly concat(bright '"Total",
+ fillerSpaces(65-# STRINGIMAGE total,'"."),bright STRINGIMAGE total)
+
+makeLongStatStringByProperty _
+ (listofnames, listofclasses, property, classproperty, units, flag) ==
+ total := 0
+ str := '""
+ otherStatTotal := GETL('other, property)
+ for [name,class,:ab] in listofnames repeat
+ name = 'other => 'iterate
+ cl := CAR LASSOC(class,listofclasses)
+ n := GETL( name, property)
+ PUT(cl,classproperty, n + GETL(cl,classproperty))
+ total := total + n
+ if n >= 0.01
+ then timestr := normalizeStatAndStringify n
+ else
+ timestr := '""
+ otherStatTotal := otherStatTotal + n
+ str := makeStatString(str,timestr,ab,flag)
+ otherStatTotal := otherStatTotal
+ PUT('other, property, otherStatTotal)
+ if otherStatTotal > 0 then
+ str := makeStatString(str,normalizeStatAndStringify otherStatTotal,'O,flag)
+ total := total + otherStatTotal
+ cl := CAR LASSOC('other,listofnames)
+ cl := CAR LASSOC(cl,listofclasses)
+ PUT(cl,classproperty, otherStatTotal + GETL(cl,classproperty))
+ if flag ^= 'long then
+ total := 0
+ str := '""
+ for [class,name,:ab] in listofclasses repeat
+ n := GETL(name, classproperty)
+ n = 0.0 => 'iterate
+ total := total + n
+ timestr := normalizeStatAndStringify n
+ str := makeStatString(str,timestr,ab,flag)
+ total := STRCONC(normalizeStatAndStringify total,'" ", units)
+ str = '"" => total
+ STRCONC(str, '" = ", total)
+
+normalizeStatAndStringify t ==
+ RNUMP t =>
+ t := roundStat t
+ t = 0.0 => '"0"
+ FORMAT(nil,'"~,2F",t)
+ INTP t =>
+ K := 1024
+ M := K*K
+ t > 9*M => CONCAT(STRINGIMAGE((t + 512*K)/M), '"M")
+ t > 9*K => CONCAT(STRINGIMAGE((t + 512)/K), '"K")
+ STRINGIMAGE t
+ STRINGIMAGE t
+
+significantStat t ==
+ RNUMP t => (t > 0.01)
+ INTP t => (t > 100)
+ true
+
+roundStat t ==
+ not RNUMP t => t
+ (FIX (0.5 + t * 1000.0)) / 1000.0
+
+makeStatString(oldstr,time,abb,flag) ==
+ time = '"" => oldstr
+ opening := (flag = 'long => '"("; '" (")
+ oldstr = '"" => STRCONC(time,opening,abb,'")")
+ STRCONC(oldstr,'" + ",time,opening,abb,'")")
+
+peekTimedName() == IFCAR $timedNameStack
+
+popTimedName() ==
+ name := IFCAR $timedNameStack
+ $timedNameStack := IFCDR $timedNameStack
+ name
+
+pushTimedName name ==
+ PUSH(name,$timedNameStack)
+
+--currentlyTimedName() == CAR $timedNameStack
+
+startTimingProcess name ==
+ updateTimedName peekTimedName()
+ pushTimedName name
+ if EQ(name, 'load) then statRecordLoadEvent()
+
+stopTimingProcess name ==
+ (name ^= peekTimedName()) and null $InteractiveMode =>
+ keyedSystemError("S2GL0015",[name,peekTimedName()])
+ updateTimedName peekTimedName()
+ popTimedName()
+
+--% Instrumentation specific to the interpreter
+SETANDFILEQ($oldElapsedSpace, 0)
+SETANDFILEQ($oldElapsedGCTime,0.0)
+SETANDFILEQ($oldElapsedTime,0.0)
+SETANDFILEQ($gcTimeTotal,0.0)
+
+-- $timedNameStack is used to hold the names of sections of the
+-- code being timed.
+
+SETANDFILEQ($timedNameStack,'(other))
+
+SETANDFILEQ($interpreterTimedNames,'(
+-- name class abbrev
+ (algebra 2 . B) _
+ (analysis 1 . A) _
+ (coercion 1 . C) _
+ (compilation 3 . T) _
+ (debug 3 . D) _
+ (evaluation 2 . E) _
+ (gc 4 . G) _
+ (history 3 . H) _
+ (instantiation 3 . I) _
+ (load 3 . L) _
+ (modemaps 1 . M) _
+ (optimization 3 . Z) _
+ (querycoerce 1 . Q) _
+ (other 3 . O) _
+ (diskread 3 . K) _
+ (print 3 . P) _
+ (resolve 1 . R) _
+ ))
+
+SETANDFILEQ($interpreterTimedClasses, '(
+-- number class name short name
+ ( 1 interpreter . IN) _
+ ( 2 evaluation . EV) _
+ ( 3 other . OT) _
+ ( 4 reclaim . GC) _
+ ))
+
+initializeTimedNames(listofnames,listofclasses) ==
+ for [name,:.] in listofnames repeat
+ PUT(name, 'TimeTotal, 0.0)
+ PUT(name, 'SpaceTotal, 0)
+ for [.,name,:.] in listofclasses repeat
+ PUT( name, 'ClassTimeTotal, 0.0)
+ PUT( name, 'ClassSpaceTotal, 0)
+ $timedNameStack := '(other)
+ computeElapsedTime()
+ PUT('gc, 'TimeTotal, 0.0)
+ PUT('gc, 'SpaceTotal, 0)
+ NIL
+
+updateTimedName name ==
+ count := (GETL(name,'TimeTotal) or 0) + computeElapsedTime()
+ PUT(name,'TimeTotal, count)
+
+printNamedStats listofnames ==
+ printNamedStatsByProperty(listofnames, 'TimeTotal)
+ sayBrightly '" "
+ sayBrightly '"Space (in bytes):"
+ printNamedStatsByProperty(listofnames, 'SpaceTotal)
+
+makeLongTimeString(listofnames,listofclasses) ==
+ makeLongStatStringByProperty(listofnames, listofclasses, _
+ 'TimeTotal, 'ClassTimeTotal, _
+ '"sec", $printTimeIfTrue)
+
+makeLongSpaceString(listofnames,listofclasses) ==
+ makeLongStatStringByProperty(listofnames, listofclasses, _
+ 'SpaceTotal, 'ClassSpaceTotal, _
+ '"bytes", $printStorageIfTrue)
+
+computeElapsedTime() ==
+ -- in total time lists, CAR is VIRTCPU and CADR is TOTCPU
+ currentTime:= elapsedUserTime()
+ currentGCTime:= elapsedGcTime()
+ gcDelta := currentGCTime - $oldElapsedGCTime
+ elapsedSeconds:=
+ -- In CCL total time does not include GC time.
+ $cclSystem => 1.*(currentTime-$oldElapsedTime)/$timerTicksPerSecond
+ 1.*(currentTime-$oldElapsedTime-gcDelta)/$timerTicksPerSecond
+ PUT('gc, 'TimeTotal,GETL('gc,'TimeTotal) +
+ 1.*gcDelta/$timerTicksPerSecond)
+ $oldElapsedTime := elapsedUserTime()
+ $oldElapsedGCTime := elapsedGcTime()
+ elapsedSeconds
+
+computeElapsedSpace() ==
+ currentElapsedSpace := HEAPELAPSED()
+ elapsedBytes := currentElapsedSpace - $oldElapsedSpace
+ $oldElapsedSpace := currentElapsedSpace
+ elapsedBytes
+
+timedAlgebraEvaluation(code) ==
+ startTimingProcess 'algebra
+ r := eval code
+ stopTimingProcess 'algebra
+ r
+
+timedOptimization(code) ==
+ startTimingProcess 'optimization
+ $getDomainCode : local := NIL
+ r := lispize code
+ if $reportOptimization then
+ sayBrightlyI bright '"Optimized LISP code:"
+ pp r
+ stopTimingProcess 'optimization
+ r
+
+timedEVALFUN(code) ==
+ startTimingProcess 'evaluation
+ r := timedEvaluate code
+ stopTimingProcess 'evaluation
+ r
+
+timedEvaluate code ==
+ code is ["LIST",:a] and #a > 200 =>
+ "append"/[eval ["LIST",:x] for x in splitIntoBlocksOf200 a]
+ eval code
+
+displayHeapStatsIfWanted() ==
+ $printStorageIfTrue => sayBrightly OLDHEAPSTATS()
+
+--EVALANDFILEACTQ(
+-- PUTGCEXIT function displayHeapStatsIfWanted )
+
+--% stubs for the stats summary fns
+statRecordInstantiationEvent() == nil
+statRecordLoadEvent() == nil
+
+statisticsSummary() == '"No statistics available."
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}