diff --git a/changelog b/changelog index fd5da86..1b6b280 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,5 @@ +20091007 tpd src/axiom-website/patches.html 20091007.02.tpd.patch +20091007 tpd src/interp/g-timer.lisp cleanup 20091007 tpd src/axiom-website/patches.html 20091007.01.tpd.patch 20091007 tpd src/interp/template.lisp cleanup 20091006 tpd src/axiom-website/patches.html 20091006.07.tpd.patch diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 84d1dd1..f8231cc 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -2123,5 +2123,7 @@ src/interp/fortcall.lisp cleanup
src/interp/daase.lisp cleanup
20091007.01.tpd.patch src/interp/template.lisp cleanup
+20091007.02.tpd.patch +src/interp/g-timer.lisp cleanup
diff --git a/src/interp/g-timer.lisp.pamphlet b/src/interp/g-timer.lisp.pamphlet index 834d39a..35aad96 100644 --- a/src/interp/g-timer.lisp.pamphlet +++ b/src/interp/g-timer.lisp.pamphlet @@ -31,44 +31,62 @@ ; fillerSpaces(65-# STRINGIMAGE total,'"."),bright STRINGIMAGE total) (DEFUN |printNamedStatsByProperty| (|listofnames| |property|) - (PROG (|total| |name| |n| |strname| |strval|) - (RETURN - (SEQ - (PROGN - (SPADLET |total| - (PROG (#0=#:G166065) - (SPADLET #0# 0) - (RETURN - (DO ((#1=#:G166071 |listofnames| (CDR #1#)) (#2=#:G166057 NIL)) - ((OR (ATOM #1#) - (PROGN (SETQ #2# (CAR #1#)) NIL) - (PROGN (PROGN (SPADLET |name| (CAR #2#)) #2#) NIL)) #0#) - (SEQ (EXIT (SETQ #0# (PLUS #0# (GETL |name| |property|))))))))) - (DO ((#3=#:G166086 |listofnames| (CDR #3#)) (#4=#:G166061 NIL)) - ((OR (ATOM #3#) - (PROGN (SETQ #4# (CAR #3#)) NIL) - (PROGN (PROGN (SPADLET |name| (CAR #4#)) #4#) NIL)) - NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |n| (GETL |name| |property|)) - (SPADLET |strname| (STRINGIMAGE |name|)) - (SPADLET |strval| (STRINGIMAGE |n|)) - (|sayBrightly| - (|concat| - (|bright| |strname|) - (|fillerSpaces| - (SPADDIFFERENCE (SPADDIFFERENCE 70 (|#| |strname|)) (|#| |strval|)) (MAKESTRING ".")) - (|bright| |strval|))))))) - (|sayBrightly| (|bright| (|fillerSpaces| 72 (MAKESTRING "-")))) - (|sayBrightly| - (|concat| - (|bright| "Total") - (|fillerSpaces| (SPADDIFFERENCE 65 (|#| (STRINGIMAGE |total|))) ".") - (|bright| (STRINGIMAGE |total|))))))))) + (PROG (|total| |name| |n| |strname| |strval|) + (RETURN + (SEQ (PROGN + (SPADLET |total| + (PROG (G166065) + (SPADLET G166065 0) + (RETURN + (DO ((G166071 |listofnames| + (CDR G166071)) + (G166057 NIL)) + ((OR (ATOM G166071) + (PROGN + (SETQ G166057 (CAR G166071)) + NIL) + (PROGN + (PROGN + (SPADLET |name| (CAR G166057)) + G166057) + NIL)) + G166065) + (SEQ (EXIT (SETQ G166065 + (PLUS G166065 + (GETL |name| |property|))))))))) + (DO ((G166086 |listofnames| (CDR G166086)) + (G166061 NIL)) + ((OR (ATOM G166086) + (PROGN (SETQ G166061 (CAR G166086)) NIL) + (PROGN + (PROGN + (SPADLET |name| (CAR G166061)) + G166061) + NIL)) + NIL) + (SEQ (EXIT (PROGN + (SPADLET |n| (GETL |name| |property|)) + (SPADLET |strname| (STRINGIMAGE |name|)) + (SPADLET |strval| (STRINGIMAGE |n|)) + (|sayBrightly| + (|concat| (|bright| |strname|) + (|fillerSpaces| + (SPADDIFFERENCE + (SPADDIFFERENCE 70 + (|#| |strname|)) + (|#| |strval|)) + (MAKESTRING ".")) + (|bright| |strval|))))))) + (|sayBrightly| + (|bright| (|fillerSpaces| 72 (MAKESTRING "-")))) + (|sayBrightly| + (|concat| (|bright| "Total") + (|fillerSpaces| + (SPADDIFFERENCE 65 + (|#| (STRINGIMAGE |total|))) + ".") + (|bright| (STRINGIMAGE |total|))))))))) -; ;makeLongStatStringByProperty _ ; (listofnames, listofclasses, property, classproperty, units, flag) == ; total := 0 @@ -108,86 +126,99 @@ ; STRCONC(str, '" = ", total) (DEFUN |makeLongStatStringByProperty| - (|listofnames| |listofclasses| |property| |classproperty| |units| |flag|) - (PROG (|otherStatTotal| |cl| |class| |name| |ab| |n| |timestr| |str| |total|) - (RETURN - (SEQ - (PROGN - (SPADLET |total| 0) - (SPADLET |str| (MAKESTRING "")) - (SPADLET |otherStatTotal| (GETL (QUOTE |other|) |property|)) - (DO ((#0=#:G166123 |listofnames| (CDR #0#)) (#1=#:G166105 NIL)) - ((OR (ATOM #0#) - (PROGN (SETQ #1# (CAR #0#)) NIL) - (PROGN - (PROGN - (SPADLET |name| (CAR #1#)) - (SPADLET |class| (CADR #1#)) - (SPADLET |ab| (CDDR #1#)) - #1#) - NIL)) - NIL) - (SEQ - (EXIT - (COND - ((BOOT-EQUAL |name| (QUOTE |other|)) (QUOTE |iterate|)) - ((QUOTE T) - (SPADLET |cl| (CAR (LASSOC |class| |listofclasses|))) - (SPADLET |n| (GETL |name| |property|)) - (PUT |cl| |classproperty| (PLUS |n| (GETL |cl| |classproperty|))) - (SPADLET |total| (PLUS |total| |n|)) - (COND - ((>= |n| 0.01) - (SPADLET |timestr| (|normalizeStatAndStringify| |n|))) - ((QUOTE T) - (SPADLET |timestr| (MAKESTRING "")) - (SPADLET |otherStatTotal| (PLUS |otherStatTotal| |n|)))) - (SPADLET |str| (|makeStatString| |str| |timestr| |ab| |flag|))))))) - (SPADLET |otherStatTotal| |otherStatTotal|) - (PUT (QUOTE |other|) |property| |otherStatTotal|) - (COND - ((> |otherStatTotal| 0) - (SPADLET |str| - (|makeStatString| |str| - (|normalizeStatAndStringify| |otherStatTotal|) (QUOTE O) |flag|)) - (SPADLET |total| (PLUS |total| |otherStatTotal|)) - (SPADLET |cl| (CAR (LASSOC (QUOTE |other|) |listofnames|))) - (SPADLET |cl| (CAR (LASSOC |cl| |listofclasses|))) - (PUT |cl| |classproperty| - (PLUS |otherStatTotal| (GETL |cl| |classproperty|))))) - (COND - ((NEQUAL |flag| (QUOTE |long|)) - (SPADLET |total| 0) - (SPADLET |str| (MAKESTRING "")) - (DO ((#2=#:G166136 |listofclasses| (CDR #2#)) (#3=#:G166112 NIL)) - ((OR (ATOM #2#) - (PROGN (SETQ #3# (CAR #2#)) NIL) - (PROGN - (PROGN - (SPADLET |class| (CAR #3#)) - (SPADLET |name| (CADR #3#)) - (SPADLET |ab| (CDDR #3#)) - #3#) - NIL)) - NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |n| (GETL |name| |classproperty|)) - (COND - ((BOOT-EQUAL |n| 0.0) (QUOTE |iterate|)) - ((QUOTE T) - (SPADLET |total| (PLUS |total| |n|)) - (SPADLET |timestr| (|normalizeStatAndStringify| |n|)) - (SPADLET |str| - (|makeStatString| |str| |timestr| |ab| |flag|)))))))))) - (SPADLET |total| - (STRCONC (|normalizeStatAndStringify| |total|) " " |units|)) - (COND - ((BOOT-EQUAL |str| (MAKESTRING "")) |total|) - ((QUOTE T) (STRCONC |str| (MAKESTRING " = ") |total|)))))))) + (|listofnames| |listofclasses| |property| |classproperty| + |units| |flag|) + (PROG (|otherStatTotal| |cl| |class| |name| |ab| |n| |timestr| |str| + |total|) + (RETURN + (SEQ (PROGN + (SPADLET |total| 0) + (SPADLET |str| (MAKESTRING "")) + (SPADLET |otherStatTotal| (GETL '|other| |property|)) + (DO ((G166123 |listofnames| (CDR G166123)) + (G166105 NIL)) + ((OR (ATOM G166123) + (PROGN (SETQ G166105 (CAR G166123)) NIL) + (PROGN + (PROGN + (SPADLET |name| (CAR G166105)) + (SPADLET |class| (CADR G166105)) + (SPADLET |ab| (CDDR G166105)) + G166105) + NIL)) + NIL) + (SEQ (EXIT (COND + ((BOOT-EQUAL |name| '|other|) '|iterate|) + ('T + (SPADLET |cl| + (CAR + (LASSOC |class| |listofclasses|))) + (SPADLET |n| (GETL |name| |property|)) + (PUT |cl| |classproperty| + (PLUS |n| + (GETL |cl| |classproperty|))) + (SPADLET |total| (PLUS |total| |n|)) + (COND + ((>= |n| 0.01) + (SPADLET |timestr| + (|normalizeStatAndStringify| + |n|))) + ('T (SPADLET |timestr| (MAKESTRING "")) + (SPADLET |otherStatTotal| + (PLUS |otherStatTotal| |n|)))) + (SPADLET |str| + (|makeStatString| |str| |timestr| + |ab| |flag|))))))) + (SPADLET |otherStatTotal| |otherStatTotal|) + (PUT '|other| |property| |otherStatTotal|) + (COND + ((> |otherStatTotal| 0) + (SPADLET |str| + (|makeStatString| |str| + (|normalizeStatAndStringify| + |otherStatTotal|) + 'O |flag|)) + (SPADLET |total| (PLUS |total| |otherStatTotal|)) + (SPADLET |cl| (CAR (LASSOC '|other| |listofnames|))) + (SPADLET |cl| (CAR (LASSOC |cl| |listofclasses|))) + (PUT |cl| |classproperty| + (PLUS |otherStatTotal| + (GETL |cl| |classproperty|))))) + (COND + ((NEQUAL |flag| '|long|) (SPADLET |total| 0) + (SPADLET |str| (MAKESTRING "")) + (DO ((G166136 |listofclasses| (CDR G166136)) + (G166112 NIL)) + ((OR (ATOM G166136) + (PROGN (SETQ G166112 (CAR G166136)) NIL) + (PROGN + (PROGN + (SPADLET |class| (CAR G166112)) + (SPADLET |name| (CADR G166112)) + (SPADLET |ab| (CDDR G166112)) + G166112) + NIL)) + NIL) + (SEQ (EXIT (PROGN + (SPADLET |n| + (GETL |name| |classproperty|)) + (COND + ((BOOT-EQUAL |n| 0.0) '|iterate|) + ('T + (SPADLET |total| (PLUS |total| |n|)) + (SPADLET |timestr| + (|normalizeStatAndStringify| + |n|)) + (SPADLET |str| + (|makeStatString| |str| + |timestr| |ab| |flag|)))))))))) + (SPADLET |total| + (STRCONC (|normalizeStatAndStringify| |total|) + " " |units|)) + (COND + ((BOOT-EQUAL |str| (MAKESTRING "")) |total|) + ('T (STRCONC |str| (MAKESTRING " = ") |total|)))))))) -; ;normalizeStatAndStringify t == ; RNUMP t => ; t := roundStat t @@ -202,49 +233,41 @@ ; STRINGIMAGE t (DEFUN |normalizeStatAndStringify| (|t|) - (PROG (K M) - (RETURN - (COND - ((RNUMP |t|) - (SPADLET |t| (|roundStat| |t|)) - (COND - ((BOOT-EQUAL |t| 0.0) (MAKESTRING "0")) - ((QUOTE T) (FORMAT NIL (MAKESTRING "~,2F") |t|)))) - ((INTP |t|) - (SPADLET K 1024) - (SPADLET M (TIMES K K)) - (COND - ((> |t| (TIMES 9 M)) - (CONCAT - (STRINGIMAGE (QUOTIENT (PLUS |t| (TIMES 512 K)) M)) - (MAKESTRING "M"))) - ((> |t| (TIMES 9 K)) - (CONCAT (STRINGIMAGE (QUOTIENT (PLUS |t| 512) K)) (MAKESTRING "K"))) - ((QUOTE T) (STRINGIMAGE |t|)))) - ((QUOTE T) (STRINGIMAGE |t|)))))) + (PROG (K M) + (RETURN + (COND + ((RNUMP |t|) (SPADLET |t| (|roundStat| |t|)) + (COND + ((BOOT-EQUAL |t| 0.0) (MAKESTRING "0")) + ('T (FORMAT NIL (MAKESTRING "~,2F") |t|)))) + ((INTP |t|) (SPADLET K 1024) (SPADLET M (TIMES K K)) + (COND + ((> |t| (TIMES 9 M)) + (CONCAT (STRINGIMAGE (QUOTIENT (PLUS |t| (TIMES 512 K)) M)) + (MAKESTRING "M"))) + ((> |t| (TIMES 9 K)) + (CONCAT (STRINGIMAGE (QUOTIENT (PLUS |t| 512) K)) + (MAKESTRING "K"))) + ('T (STRINGIMAGE |t|)))) + ('T (STRINGIMAGE |t|)))))) -; ;significantStat t == ; RNUMP t => (t > 0.01) ; INTP t => (t > 100) ; true (DEFUN |significantStat| (|t|) - (COND - ((RNUMP |t|) (> |t| 0.01)) - ((INTP |t|) (> |t| 100)) - ((QUOTE T) (QUOTE T)))) -; + (COND ((RNUMP |t|) (> |t| 0.01)) ((INTP |t|) (> |t| 100)) ('T 'T))) + ;roundStat t == ; not RNUMP t => t ; (FIX (0.5 + t * 1000.0)) / 1000.0 (DEFUN |roundStat| (|t|) - (COND - ((NULL (RNUMP |t|)) |t|) - ((QUOTE T) (QUOTIENT (FIX (PLUS 0.5 (TIMES |t| 1000.0))) 1000.0)))) + (COND + ((NULL (RNUMP |t|)) |t|) + ('T (QUOTIENT (FIX (PLUS 0.5 (TIMES |t| 1000.0))) 1000.0)))) -; ;makeStatString(oldstr,time,abb,flag) == ; time = '"" => oldstr ; opening := (flag = 'long => '"("; '" (") @@ -252,53 +275,49 @@ ; STRCONC(oldstr,'" + ",time,opening,abb,'")") (DEFUN |makeStatString| (|oldstr| |time| |abb| |flag|) - (PROG (|opening|) - (RETURN - (COND - ((BOOT-EQUAL |time| (MAKESTRING "")) |oldstr|) - ((QUOTE T) - (SPADLET |opening| + (PROG (|opening|) + (RETURN (COND - ((BOOT-EQUAL |flag| (QUOTE |long|)) (MAKESTRING "(")) - ((QUOTE T) (MAKESTRING " (")))) - (COND - ((BOOT-EQUAL |oldstr| (MAKESTRING "")) - (STRCONC |time| |opening| |abb| (MAKESTRING ")"))) - ((QUOTE T) - (STRCONC - |oldstr| - (MAKESTRING " + ") - |time| - |opening| - |abb| - (MAKESTRING ")"))))))))) + ((BOOT-EQUAL |time| (MAKESTRING "")) |oldstr|) + ('T + (SPADLET |opening| + (COND + ((BOOT-EQUAL |flag| '|long|) (MAKESTRING "(")) + ('T (MAKESTRING " (")))) + (COND + ((BOOT-EQUAL |oldstr| (MAKESTRING "")) + (STRCONC |time| |opening| |abb| (MAKESTRING ")"))) + ('T + (STRCONC |oldstr| (MAKESTRING " + ") |time| |opening| |abb| + (MAKESTRING ")"))))))))) -; ;peekTimedName() == IFCAR $timedNameStack -(DEFUN |peekTimedName| NIL (IFCAR |$timedNameStack|)) +(DEFUN |peekTimedName| () + (DECLARE (SPECIAL |$timedNameStack|)) + (IFCAR |$timedNameStack|)) -; ;popTimedName() == ; name := IFCAR $timedNameStack ; $timedNameStack := IFCDR $timedNameStack ; name (DEFUN |popTimedName| () - (PROG (|name|) - (RETURN - (PROGN - (SPADLET |name| (IFCAR |$timedNameStack|)) - (SPADLET |$timedNameStack| (IFCDR |$timedNameStack|)) - |name|)))) + (PROG (|name|) + (DECLARE (SPECIAL |$timedNameStack|)) + (RETURN + (PROGN + (SPADLET |name| (IFCAR |$timedNameStack|)) + (SPADLET |$timedNameStack| (IFCDR |$timedNameStack|)) + |name|)))) -; ;pushTimedName name == ; PUSH(name,$timedNameStack) -(DEFUN |pushTimedName| (|name|) (PUSH |name| |$timedNameStack|)) +(DEFUN |pushTimedName| (|name|) + (DECLARE (SPECIAL |$timedNameStack|)) + (PUSH |name| |$timedNameStack|)) -; ;--currentlyTimedName() == CAR $timedNameStack ; ;startTimingProcess name == @@ -307,14 +326,11 @@ ; if EQ(name, 'load) then statRecordLoadEvent() (DEFUN |startTimingProcess| (|name|) - (PROGN - (|updateTimedName| (|peekTimedName|)) - (|pushTimedName| |name|) - (COND - ((EQ |name| (QUOTE |load|)) (|statRecordLoadEvent|)) - ((QUOTE T) NIL)))) + (PROGN + (|updateTimedName| (|peekTimedName|)) + (|pushTimedName| |name|) + (COND ((EQ |name| '|load|) (|statRecordLoadEvent|)) ('T NIL)))) -; ;stopTimingProcess name == ; (name ^= peekTimedName()) and null $InteractiveMode => ; keyedSystemError("S2GL0015",[name,peekTimedName()]) @@ -322,38 +338,25 @@ ; popTimedName() (DEFUN |stopTimingProcess| (|name|) - (COND - ((AND (NEQUAL |name| (|peekTimedName|)) (NULL |$InteractiveMode|)) - (|keyedSystemError| 'S2GL0015 (CONS |name| (CONS (|peekTimedName|) NIL)))) - ((QUOTE T) (|updateTimedName| (|peekTimedName|)) (|popTimedName|)))) + (DECLARE (SPECIAL |$InteractiveMode|)) + (COND + ((AND (NEQUAL |name| (|peekTimedName|)) (NULL |$InteractiveMode|)) + (|keyedSystemError| 'S2GL0015 + (CONS |name| (CONS (|peekTimedName|) NIL)))) + ('T (|updateTimedName| (|peekTimedName|)) (|popTimedName|)))) -; ;--% Instrumentation specific to the interpreter -;SETANDFILEQ($oldElapsedSpace, 0) - (SETANDFILEQ |$oldElapsedSpace| 0) - -;SETANDFILEQ($oldElapsedGCTime,0.0) - (SETANDFILEQ |$oldElapsedGCTime| 0.0) - -;SETANDFILEQ($oldElapsedTime,0.0) - (SETANDFILEQ |$oldElapsedTime| 0.0) - -;SETANDFILEQ($gcTimeTotal,0.0) - (SETANDFILEQ |$gcTimeTotal| 0.0) ; ;-- $timedNameStack is used to hold the names of sections of the ;-- code being timed. ; -;SETANDFILEQ($timedNameStack,'(other)) +(SETANDFILEQ |$timedNameStack| '(|other|)) -(SETANDFILEQ |$timedNameStack| (QUOTE (|other|))) - -; ;SETANDFILEQ($interpreterTimedNames,'( ;-- name class abbrev ; (algebra 2 . B) _ @@ -376,26 +379,13 @@ ; )) (SETANDFILEQ |$interpreterTimedNames| - (QUOTE - ((|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)))) + '((|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) _ @@ -405,13 +395,9 @@ ; )) (SETANDFILEQ |$interpreterTimedClasses| - (QUOTE - ((1 |interpreter| . IN) - (2 |evaluation| . EV) - (3 |other| . OT) - (4 |reclaim| . GC)))) + '((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) @@ -426,49 +412,55 @@ ; NIL (DEFUN |initializeTimedNames| (|listofnames| |listofclasses|) - (PROG (|name|) - (RETURN - (SEQ - (PROGN - (DO ((#0=#:G166232 |listofnames| (CDR #0#)) (#1=#:G166218 NIL)) - ((OR (ATOM #0#) - (PROGN (SETQ #1# (CAR #0#)) NIL) - (PROGN (PROGN (SPADLET |name| (CAR #1#)) #1#) NIL)) - NIL) - (SEQ - (EXIT - (PROGN - (PUT |name| (QUOTE |TimeTotal|) 0.0) - (PUT |name| (QUOTE |SpaceTotal|) 0))))) - (DO ((#2=#:G166245 |listofclasses| (CDR #2#)) (#3=#:G166222 NIL)) - ((OR (ATOM #2#) - (PROGN (SETQ #3# (CAR #2#)) NIL) - (PROGN (PROGN (SPADLET |name| (CADR #3#)) #3#) NIL)) - NIL) - (SEQ - (EXIT - (PROGN - (PUT |name| (QUOTE |ClassTimeTotal|) 0.0) - (PUT |name| (QUOTE |ClassSpaceTotal|) 0))))) - (SPADLET |$timedNameStack| (QUOTE (|other|))) - (|computeElapsedTime|) - (PUT (QUOTE |gc|) (QUOTE |TimeTotal|) 0.0) - (PUT (QUOTE |gc|) (QUOTE |SpaceTotal|) 0) - NIL))))) + (PROG (|name|) + (DECLARE (SPECIAL |$timedNameStack|)) + (RETURN + (SEQ (PROGN + (DO ((G166232 |listofnames| (CDR G166232)) + (G166218 NIL)) + ((OR (ATOM G166232) + (PROGN (SETQ G166218 (CAR G166232)) NIL) + (PROGN + (PROGN + (SPADLET |name| (CAR G166218)) + G166218) + NIL)) + NIL) + (SEQ (EXIT (PROGN + (PUT |name| '|TimeTotal| 0.0) + (PUT |name| '|SpaceTotal| 0))))) + (DO ((G166245 |listofclasses| (CDR G166245)) + (G166222 NIL)) + ((OR (ATOM G166245) + (PROGN (SETQ G166222 (CAR G166245)) NIL) + (PROGN + (PROGN + (SPADLET |name| (CADR G166222)) + G166222) + NIL)) + NIL) + (SEQ (EXIT (PROGN + (PUT |name| '|ClassTimeTotal| 0.0) + (PUT |name| '|ClassSpaceTotal| 0))))) + (SPADLET |$timedNameStack| '(|other|)) + (|computeElapsedTime|) + (PUT '|gc| '|TimeTotal| 0.0) + (PUT '|gc| '|SpaceTotal| 0) + NIL))))) -; ;updateTimedName name == ; count := (GET(name,'TimeTotal) or 0) + computeElapsedTime() ; PUT(name,'TimeTotal, count) (DEFUN |updateTimedName| (|name|) - (PROG (|count|) - (RETURN - (PROGN - (SPADLET |count| - (PLUS (OR (GETL |name| (QUOTE |TimeTotal|)) 0) (|computeElapsedTime|))) - (PUT |name| (QUOTE |TimeTotal|) |count|))))) -; + (PROG (|count|) + (RETURN + (PROGN + (SPADLET |count| + (PLUS (OR (GETL |name| '|TimeTotal|) 0) + (|computeElapsedTime|))) + (PUT |name| '|TimeTotal| |count|))))) + ;printNamedStats listofnames == ; printNamedStatsByProperty(listofnames, 'TimeTotal) ; sayBrightly '" " @@ -476,43 +468,34 @@ ; printNamedStatsByProperty(listofnames, 'SpaceTotal) (DEFUN |printNamedStats| (|listofnames|) - (PROGN - (|printNamedStatsByProperty| |listofnames| (QUOTE |TimeTotal|)) - (|sayBrightly| (MAKESTRING " ")) - (|sayBrightly| (MAKESTRING "Space (in bytes):")) - (|printNamedStatsByProperty| |listofnames| (QUOTE |SpaceTotal|)))) + (PROGN + (|printNamedStatsByProperty| |listofnames| '|TimeTotal|) + (|sayBrightly| (MAKESTRING " ")) + (|sayBrightly| (MAKESTRING "Space (in bytes):")) + (|printNamedStatsByProperty| |listofnames| '|SpaceTotal|))) -; ;makeLongTimeString(listofnames,listofclasses) == ; makeLongStatStringByProperty(listofnames, listofclasses, _ ; 'TimeTotal, 'ClassTimeTotal, _ ; '"sec", $printTimeIfTrue) (DEFUN |makeLongTimeString| (|listofnames| |listofclasses|) - (|makeLongStatStringByProperty| - |listofnames| - |listofclasses| - (QUOTE |TimeTotal|) - (QUOTE |ClassTimeTotal|) - (MAKESTRING "sec") - |$printTimeIfTrue|)) + (DECLARE (SPECIAL |$printTimeIfTrue|)) + (|makeLongStatStringByProperty| |listofnames| |listofclasses| + '|TimeTotal| '|ClassTimeTotal| (MAKESTRING "sec") + |$printTimeIfTrue|)) -; ;makeLongSpaceString(listofnames,listofclasses) == ; makeLongStatStringByProperty(listofnames, listofclasses, _ ; 'SpaceTotal, 'ClassSpaceTotal, _ ; '"bytes", $printStorageIfTrue) (DEFUN |makeLongSpaceString| (|listofnames| |listofclasses|) - (|makeLongStatStringByProperty| - |listofnames| - |listofclasses| - (QUOTE |SpaceTotal|) - (QUOTE |ClassSpaceTotal|) - (MAKESTRING "bytes") - |$printStorageIfTrue|)) + (DECLARE (SPECIAL |$printStorageIfTrue|)) + (|makeLongStatStringByProperty| |listofnames| |listofclasses| + '|SpaceTotal| '|ClassSpaceTotal| (MAKESTRING "bytes") + |$printStorageIfTrue|)) -; ;computeElapsedTime() == ; -- in total time lists, CAR is VIRTCPU and CADR is TOTCPU ; currentTime:= elapsedUserTime() @@ -529,50 +512,57 @@ ; elapsedSeconds (DEFUN |computeElapsedTime| () - (PROG (|currentTime| |currentGCTime| |gcDelta| |elapsedSeconds|) - (RETURN - (PROGN - (SPADLET |currentTime| (|elapsedUserTime|)) - (SPADLET |currentGCTime| (|elapsedGcTime|)) - (SPADLET |gcDelta| (SPADDIFFERENCE |currentGCTime| |$oldElapsedGCTime|)) - (SPADLET |elapsedSeconds| - (COND - (|$cclSystem| - (QUOTIENT - (TIMES 1.0 (SPADDIFFERENCE |currentTime| |$oldElapsedTime|)) - |$timerTicksPerSecond|)) - ((QUOTE T) - (QUOTIENT - (TIMES 1.0 - (SPADDIFFERENCE - (SPADDIFFERENCE |currentTime| |$oldElapsedTime|) |gcDelta|)) - |$timerTicksPerSecond|)))) - (PUT (QUOTE |gc|) (QUOTE |TimeTotal|) - (PLUS - (GETL (QUOTE |gc|) (QUOTE |TimeTotal|)) - (QUOTIENT (TIMES 1.0 |gcDelta|) |$timerTicksPerSecond|))) - (SPADLET |$oldElapsedTime| (|elapsedUserTime|)) - (SPADLET |$oldElapsedGCTime| (|elapsedGcTime|)) - |elapsedSeconds|)))) + (PROG (|currentTime| |currentGCTime| |gcDelta| |elapsedSeconds|) + (DECLARE (SPECIAL |$oldElapsedGCTime| |$oldElapsedTime| + |$timerTicksPerSecond| |$cclSystem|)) + (RETURN + (PROGN + (SPADLET |currentTime| (|elapsedUserTime|)) + (SPADLET |currentGCTime| (|elapsedGcTime|)) + (SPADLET |gcDelta| + (SPADDIFFERENCE |currentGCTime| |$oldElapsedGCTime|)) + (SPADLET |elapsedSeconds| + (COND + (|$cclSystem| + (QUOTIENT + (TIMES 1.0 + (SPADDIFFERENCE |currentTime| + |$oldElapsedTime|)) + |$timerTicksPerSecond|)) + ('T + (QUOTIENT + (TIMES 1.0 + (SPADDIFFERENCE + (SPADDIFFERENCE |currentTime| + |$oldElapsedTime|) + |gcDelta|)) + |$timerTicksPerSecond|)))) + (PUT '|gc| '|TimeTotal| + (PLUS (GETL '|gc| '|TimeTotal|) + (QUOTIENT (TIMES 1.0 |gcDelta|) + |$timerTicksPerSecond|))) + (SPADLET |$oldElapsedTime| (|elapsedUserTime|)) + (SPADLET |$oldElapsedGCTime| (|elapsedGcTime|)) + |elapsedSeconds|)))) -; ;computeElapsedSpace() == ; currentElapsedSpace := HEAPELAPSED() ; elapsedBytes := currentElapsedSpace - $oldElapsedSpace ; $oldElapsedSpace := currentElapsedSpace ; elapsedBytes -(DEFUN |computeElapsedSpace| () - (PROG (|currentElapsedSpace| |elapsedBytes|) - (RETURN - (PROGN - (SPADLET |currentElapsedSpace| (HEAPELAPSED)) - (SPADLET |elapsedBytes| - (SPADDIFFERENCE |currentElapsedSpace| |$oldElapsedSpace|)) - (SPADLET |$oldElapsedSpace| |currentElapsedSpace|) - |elapsedBytes|)))) +(DEFUN |computeElapsedSpace| () + (PROG (|currentElapsedSpace| |elapsedBytes|) + (DECLARE (SPECIAL |$oldElapsedSpace|)) + (RETURN + (PROGN + (SPADLET |currentElapsedSpace| (HEAPELAPSED)) + (SPADLET |elapsedBytes| + (SPADDIFFERENCE |currentElapsedSpace| + |$oldElapsedSpace|)) + (SPADLET |$oldElapsedSpace| |currentElapsedSpace|) + |elapsedBytes|)))) -; ;timedAlgebraEvaluation(code) == ; startTimingProcess 'algebra ; r := eval code @@ -580,15 +570,14 @@ ; r (DEFUN |timedAlgebraEvaluation| (|code|) - (PROG (|r|) - (RETURN - (PROGN - (|startTimingProcess| (QUOTE |algebra|)) - (SPADLET |r| (|eval| |code|)) - (|stopTimingProcess| (QUOTE |algebra|)) - |r|)))) + (PROG (|r|) + (RETURN + (PROGN + (|startTimingProcess| '|algebra|) + (SPADLET |r| (|eval| |code|)) + (|stopTimingProcess| '|algebra|) + |r|)))) -; ;timedOptimization(code) == ; startTimingProcess 'optimization ; $getDomainCode : local := NIL @@ -600,19 +589,20 @@ ; r (DEFUN |timedOptimization| (|code|) - (PROG (|$getDomainCode| |r|) - (DECLARE (SPECIAL |$getDomainCode|)) - (RETURN - (PROGN - (|startTimingProcess| (QUOTE |optimization|)) - (SPADLET |$getDomainCode| NIL) - (SPADLET |r| (|lispize| |code|)) - (COND - (|$reportOptimization| - (|sayBrightlyI| (|bright| "Optimized LISP code:")) (|pp| |r|))) - (|stopTimingProcess| (QUOTE |optimization|)) |r|)))) + (PROG (|$getDomainCode| |r|) + (DECLARE (SPECIAL |$getDomainCode| |$reportOptimization|)) + (RETURN + (PROGN + (|startTimingProcess| '|optimization|) + (SPADLET |$getDomainCode| NIL) + (SPADLET |r| (|lispize| |code|)) + (COND + (|$reportOptimization| + (|sayBrightlyI| (|bright| "Optimized LISP code:")) + (|pp| |r|))) + (|stopTimingProcess| '|optimization|) + |r|)))) -; ;timedEVALFUN(code) == ; startTimingProcess 'evaluation ; r := timedEvaluate code @@ -620,47 +610,48 @@ ; r (DEFUN |timedEVALFUN| (|code|) - (PROG (|r|) - (RETURN - (PROGN - (|startTimingProcess| (QUOTE |evaluation|)) - (SPADLET |r| (|timedEvaluate| |code|)) - (|stopTimingProcess| (QUOTE |evaluation|)) - |r|)))) + (PROG (|r|) + (RETURN + (PROGN + (|startTimingProcess| '|evaluation|) + (SPADLET |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 (DEFUN |timedEvaluate| (|code|) - (PROG (|a|) - (RETURN - (SEQ - (COND - ((AND (PAIRP |code|) - (EQ (QCAR |code|) (QUOTE LIST)) - (PROGN (SPADLET |a| (QCDR |code|)) (QUOTE T)) - (> (|#| |a|) 200)) - (PROG (#0=#:G166311) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G166316 (|splitIntoBlocksOf200| |a|) (CDR #1#)) (|x| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) #0#) - (SEQ - (EXIT (SETQ #0# (APPEND #0# (|eval| (CONS (QUOTE LIST) |x|)))))))))) - ((QUOTE T) (|eval| |code|))))))) + (PROG (|a|) + (RETURN + (SEQ (COND + ((AND (PAIRP |code|) (EQ (QCAR |code|) 'LIST) + (PROGN (SPADLET |a| (QCDR |code|)) 'T) + (> (|#| |a|) 200)) + (PROG (G166311) + (SPADLET G166311 NIL) + (RETURN + (DO ((G166316 (|splitIntoBlocksOf200| |a|) + (CDR G166316)) + (|x| NIL)) + ((OR (ATOM G166316) + (PROGN (SETQ |x| (CAR G166316)) NIL)) + G166311) + (SEQ (EXIT (SETQ G166311 + (APPEND G166311 + (|eval| (CONS 'LIST |x|)))))))))) + ('T (|eval| |code|))))))) -; ;displayHeapStatsIfWanted() == ; $printStorageIfTrue => sayBrightly OLDHEAPSTATS() -(DEFUN |displayHeapStatsIfWanted| () - (SEQ - (COND (|$printStorageIfTrue| (EXIT (|sayBrightly| (OLDHEAPSTATS))))))) +(DEFUN |displayHeapStatsIfWanted| () + (DECLARE (SPECIAL |$printStorageIfTrue|)) + (SEQ (COND + (|$printStorageIfTrue| (EXIT (|sayBrightly| (OLDHEAPSTATS))))))) -; ;--EVALANDFILEACTQ( ;-- PUTGCEXIT function displayHeapStatsIfWanted ) ; @@ -676,7 +667,7 @@ ; ;statisticsSummary() == '"No statistics available." -(DEFUN |statisticsSummary| () (MAKESTRING "No statistics available.")) +(DEFUN |statisticsSummary| () "No statistics available.") @ \eject