diff --git a/ChangeLog b/ChangeLog index 740b803b8..297f84208 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2023-11-04 Qian Yun + + * src/interp/g-timer.boot, src/interp/setvart.boot, + src/interp/macros.lisp, src/interp/setq.lisp: + Enable memory usage report: ')set message storage on' + 2023-10-30 Waldek Hebisch * src/lisp/Makefile.in: Use large memory model for GCL diff --git a/src/interp/g-timer.boot b/src/interp/g-timer.boot index bb452c9eb..3b3614228 100644 --- a/src/interp/g-timer.boot +++ b/src/interp/g-timer.boot @@ -66,7 +66,7 @@ makeLongStatStringByProperty _ str := '"" for [class,name,:ab] in listofclasses repeat n := GET(name, classproperty) - n = 0.0 => 'iterate + n = 0.0 or n = 0 => 'iterate total := total + n timestr := normalizeStatAndStringify n str := makeStatString(str,timestr,ab,flag) @@ -79,19 +79,9 @@ normalizeStatAndStringify t == t := roundStat t t = 0.0 => '"0" FORMAT(nil,'"~,2F",t) - INTEGERP 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 + INTEGERP t => FORMAT(nil, '"~:d", t) STRINGIMAGE t -significantStat t == - FLOATP t => (t > 0.01) - INTEGERP t => (t > 100) - true - roundStat t == not FLOATP t => t (TRUNCATE (0.5 + t * 1000.0)) / 1000.0 @@ -170,6 +160,7 @@ initializeTimedNames(listofnames,listofclasses) == PUT( name, 'ClassSpaceTotal, 0) $timedNameStack := '(other) computeElapsedTime() + computeElapsedSpace() PUT('gc, 'TimeTotal, 0.0) PUT('gc, 'SpaceTotal, 0) NIL @@ -177,6 +168,8 @@ initializeTimedNames(listofnames,listofclasses) == updateTimedName name == count := (GET(name, 'TimeTotal) or 0) + computeElapsedTime() PUT(name, 'TimeTotal, count) + count := (GET(name, 'SpaceTotal) or 0) + computeElapsedSpace() + PUT(name, 'SpaceTotal, count) makeLongTimeString(listofnames,listofclasses) == makeLongStatStringByProperty(listofnames, listofclasses, _ @@ -234,6 +227,3 @@ timedEvaluate code == code is ["LIST",:a] and #a > 200 => "append"/[eval ["LIST",:x] for x in splitIntoBlocksOf200 a] eval code - -displayHeapStatsIfWanted() == - $printStorageIfTrue => sayBrightly OLDHEAPSTATS() diff --git a/src/interp/macros.lisp b/src/interp/macros.lisp index d24589f86..c9325232c 100644 --- a/src/interp/macros.lisp +++ b/src/interp/macros.lisp @@ -675,7 +675,15 @@ This function respects intermediate #\Newline characters and drops (defun WHOCALLED(n) nil) ;; no way to look n frames up the stack -(defun heapelapsed () 0) +(defun heapelapsed () + #+:clisp + (multiple-value-bind (used room static gc-count gc-space gc-time) (sys::%room) + (+ used gc-space)) + #+:cmu (ext:get-bytes-consed) + #+:ecl (si:gc-stats t) + #+:openmcl (ccl::total-bytes-allocated) + #+:sbcl (sb-ext:get-bytes-consed) + #-(or :clisp :cmu :ecl :openmcl :sbcl) 0) (defun |goGetTracerHelper| (dn f oname alias options modemap) (lambda(&rest l) diff --git a/src/interp/setq.lisp b/src/interp/setq.lisp index f94f55394..e1ccd5216 100644 --- a/src/interp/setq.lisp +++ b/src/interp/setq.lisp @@ -317,7 +317,7 @@ |UnionCategory| )) -(SETQ |$printStorageIfTrue| NIL) ;; storage info disabled in common lisp +(SETQ |$printStorageIfTrue| NIL) (SETQ |$noEnv| NIL) (SETQ |$SideEffectFreeFunctionList| '( diff --git a/src/interp/setvart.boot b/src/interp/setvart.boot index 97d6f29ae..95c6c5527 100644 --- a/src/interp/setvart.boot +++ b/src/interp/setvart.boot @@ -381,6 +381,13 @@ DEFPARAMETER($setOptions, '( $displayStartMsgs (on off) on) + (storage + "print memory usage after computation" + interpreter + LITERALS + $printStorageIfTrue + (on off) + off) (testing "print system testing header" development