Enable memory usage report: ')set message storage on'

ChangeLog

@@ -1,3 +1,9 @@
+2023-11-04  Qian Yun  <[email protected]>
+
+	* 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  <[email protected]>
 
 	* src/lisp/Makefile.in: Use large memory model for GCL

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,13 +160,16 @@ initializeTimedNames(listofnames,listofclasses) ==
     PUT( name, 'ClassSpaceTotal,  0)
   $timedNameStack := '(other)
   computeElapsedTime()
+  computeElapsedSpace()
   PUT('gc, 'TimeTotal, 0.0)
   PUT('gc, 'SpaceTotal,  0)
   NIL
 
 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()

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)

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| '(

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