- working-set-size
- xyzzy が現在使用しているメモリ。
- use-memory(var)(body)
- body がどの位メモリを使用するか調べるためのマクロ。
- get-process-memory-info
- values で memory-info を返します。
- get-performance-info
- values で performance-info を返します。
(eval-when (:compile-toplevel :load-toplevel :execute)
(require "foreign")
(require "wip/winapi"))
(in-package "winapi")
(provide "psapi")
;;// Structure for GetProcessMemoryInfo()
;;typedef unsigned int size_t
(*define-c-type u_int SIZE_T)
(*define-c-struct
PROCESS_MEMORY_COUNTERS
(DWORD cb)
(DWORD PageFaultCount)
(SIZE_T PeakWorkingSetSize)
(SIZE_T WorkingSetSize)
(SIZE_T QuotaPeakPagedPoolUsage)
(SIZE_T QuotaPagedPoolUsage)
(SIZE_T QuotaPeakNonPagedPoolUsage)
(SIZE_T QuotaNonPagedPoolUsage)
(SIZE_T PagefileUsage)
(SIZE_T PeakPagefileUsage)
)
(*define-dll-entry BOOL GetProcessMemoryInfo (HANDLE (PROCESS_MEMORY_COUNTERS *) DWORD) "psapi")
(*define-dll-entry HANDLE GetCurrentProcess (LPVOID) "kernel32")
(*define-c-struct PERFORMANCE_INFORMATION
(DWORD cb)
(SIZE_T CommitTotal)
(SIZE_T CommitLimit)
(SIZE_T CommitPeak)
(SIZE_T PhysicalTotal)
(SIZE_T PhysicalAvailable)
(SIZE_T SystemCache)
(SIZE_T KernelTotal)
(SIZE_T KernelPaged)
(SIZE_T KernelNonpaged)
(SIZE_T PageSize)
(DWORD HandleCount)
(DWORD ProcessCount)
(DWORD ThreadCount)
)
(*define-dll-entry BOOL GetPerformanceInfo ((PERFORMANCE_INFORMATION *) DWORD) "psapi")
(defun get-process-memory-info()
(let((MemInfo (make-PROCESS_MEMORY_COUNTERS))
(cb (c:c-struct-size-of PROCESS_MEMORY_COUNTERS))
(hd (GetCurrentProcess 0)))
(values
(PROCESS_MEMORY_COUNTERS-PageFaultCount MemInfo)
(PROCESS_MEMORY_COUNTERS-PeakWorkingSetSize MemInfo)
(PROCESS_MEMORY_COUNTERS-WorkingSetSize MemInfo)
(PROCESS_MEMORY_COUNTERS-QuotaPeakPagedPoolUsage MemInfo)
(PROCESS_MEMORY_COUNTERS-QuotaPagedPoolUsage MemInfo)
(PROCESS_MEMORY_COUNTERS-QuotaPeakNonPagedPoolUsage MemInfo)
(PROCESS_MEMORY_COUNTERS-QuotaNonPagedPoolUsage MemInfo)
(PROCESS_MEMORY_COUNTERS-PagefileUsage MemInfo)
(PROCESS_MEMORY_COUNTERS-PeakPagefileUsage MemInfo))))
(defun get-performance-info()
(let ((PI (make-PERFORMANCE_INFORMATION))
(cb (c:c-struct-size-of PERFORMANCE_INFORMATION)))
(GetPerformanceInfo PI cb)
(make-PERFORMANCE_INFORMATION)
(values
(PERFORMANCE_INFORMATION-CommitTotal PI)
(PERFORMANCE_INFORMATION-CommitLimit PI)
(PERFORMANCE_INFORMATION-CommitPeak PI)
(PERFORMANCE_INFORMATION-PhysicalTotal PI)
(PERFORMANCE_INFORMATION-PhysicalAvailable PI)
(PERFORMANCE_INFORMATION-SystemCache PI)
(PERFORMANCE_INFORMATION-KernelTotal PI)
(PERFORMANCE_INFORMATION-KernelPaged PI)
(PERFORMANCE_INFORMATION-KernelNonpaged PI)
(PERFORMANCE_INFORMATION-PageSize PI)
(PERFORMANCE_INFORMATION-HandleCount PI)
(PERFORMANCE_INFORMATION-ProcessCount PI)
(PERFORMANCE_INFORMATION-ThreadCount PI)
)))
; xyzzy use memory size
(defun working-set-size()
(let((MemInfo (make-PROCESS_MEMORY_COUNTERS))
(cb (c:c-struct-size-of PROCESS_MEMORY_COUNTERS))
(hd (GetCurrentProcess 0))
beg end)
(GetProcessMemoryInfo hd MemInfo cb)
(PROCESS_MEMORY_COUNTERS-WorkingSetSize MemInfo)))
(in-package :user)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 使用する関数
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun get-process-memory-info()
(winapi::get-process-memory-info))
(defun get-performance-info()
(winapi::get-performance-info))
(defun working-set-size()
(winapi::working-set-size))
(defmacro use-memory ((var) &body body)
`(let((,var (working-set-size)))
,@body
(- (working-set-size) ,var)))
;; 何故こうしたのかは、忘れた。
;; before (- after before)
;;(use-memory(x)(princ x))
;;
;; (defmacro use-memory (&body body)
;; `(let((var (working-set-size)))
;; ,@body
;; (- (working-set-size) var)))
上記をふまえた上で time 風な物をでっちあげてみた。
(setq *time-macro-fmt* "
Varsion:~20t[~A ~A]
Try Test:~20t[~D times]
Execution Time:~20t[~D /ms]
Average Time:~20t[~A /ms]
Maximum Time:~20t[~D /ms]
Over Zero:~20t[~D itmes]
Execution Memory:~20t[~D /b]
Average Memory:~20t[~A /b]
Maximum Memory:~20t[~D /b]
Over Zero:~20t[~D itmes]
~{S-Expression:~20t~S~%Result:~20t~S~}
")
(defmacro time((&optional(how 1)) &body body)
(labels((tgensym()(gensym "time")))
(let((g (tgensym))(result (tgensym))
(start (tgensym))(total (tgensym))(time (tgensym))
(memory (tgensym))(mstart (tgensym))(mtotal (tgensym)))
(gc)
`(let (,total ,mtotal
(,time (get-internal-real-time))
(,memory (working-set-size)))
(dotimes(,g ,how (setq ,result (list (car ',body) ,result)))
(setq ,start (get-internal-real-time))
(setq ,mstart (working-set-size))
(setq ,result ,@body)
(push (- (get-internal-real-time) ,start) ,total)
(push (- (working-set-size) ,mstart) ,mtotal)
)
(labels((average(x)(apply #'+ (multiple-value-list
(float (/ (apply #'+ x)(length x)))))))
(format t *time-macro-fmt*
(software-type) (software-version)
,how
; time
(- (get-internal-real-time) ,time )
(average ,total)
(apply #'max ,total)
(count-if #'(lambda(x)(< 0 x)) ,total)
; memory
(- (working-set-size) ,memory)
(average ,mtotal)
(apply #'max ,mtotal)
(count-if #'(lambda(x)(< 0 x)) ,mtotal)
,result)
)))))
;; 使えるかどうかは解らない
(defun do-time-list(how list)
(dolist(x list)
(eval `(time (,how) ,x))))
(defmacro time+((&optional(how 1))&body body)
(let((f (gensym "gFunction:=")))
`(progn(defun ,f() ,@body)
(format t "~%~5t[before-compile]")
(time (,how) ,@body)
(format t "~60,,,'=A" "")
(compile ',f)
(format t "~%~5t[after-compile]")
(time (,how)(,f))
(format t "~60,,,'=A" ""))))
(defun do-time+-list(how list)
(dolist(x list)
(eval `(time+ (,how) ,x))))