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, 0 insertions, 292 deletions
diff --git a/src/interp/g-timer.boot.pamphlet b/src/interp/g-timer.boot.pamphlet
deleted file mode 100644
index 513e367d..00000000
--- a/src/interp/g-timer.boot.pamphlet
+++ /dev/null
@@ -1,292 +0,0 @@
-\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}