mirror of
https://github.com/PDP-10/its.git
synced 2026-01-21 18:16:07 +00:00
60 lines
1.5 KiB
Common Lisp
Executable File
60 lines
1.5 KiB
Common Lisp
Executable File
;;;-*-lisp-*-
|
|
|
|
(herald timepn)
|
|
|
|
(defun (timeprogn macro) (form)
|
|
(displace form
|
|
`(unwind-protect
|
|
(progn (time-origin 'push)
|
|
,@(cdr form))
|
|
(time-origin 'pop))))
|
|
|
|
|
|
(defvar last-gctime nil)
|
|
(defvar last-runtime nil)
|
|
(defvar last-realtime nil)
|
|
|
|
|
|
(defun time-origin (&optional (updatep nil)
|
|
(printp (not (eq updatep 'push))))
|
|
(let ((realtime (time))
|
|
(runtime (runtime))
|
|
(gctime (status gctime)))
|
|
(if
|
|
printp
|
|
(let ((rel-realtime (-$ realtime (car last-realtime)))
|
|
(rel-runtime (- runtime (car last-runtime)))
|
|
(rel-gctime (- gctime (car last-gctime))))
|
|
(format
|
|
msgfiles
|
|
"~&;~D.~3,'0D cpu sec. ~D% gc ~D.~D realtime (~D%)~:[ so far~]"
|
|
(// rel-runtime 1000000.)
|
|
(\ (// rel-runtime 1000.) 1000.)
|
|
(quotient (times 100. rel-gctime)
|
|
rel-runtime)
|
|
(ifix rel-realtime)
|
|
(\ (ifix (*$ 10.0 rel-realtime)) 10.)
|
|
(ifix (//$ (*$ 1.0e-4 (float rel-runtime))
|
|
rel-realtime))
|
|
updatep)))
|
|
|
|
(caseq updatep
|
|
(set
|
|
(setf (car last-realtime) realtime)
|
|
(setf (car last-gctime) gctime)
|
|
(setf (car last-runtime) runtime))
|
|
(push
|
|
(push realtime last-realtime)
|
|
(push gctime last-gctime)
|
|
(push runtime last-runtime))
|
|
(pop
|
|
(pop last-realtime)
|
|
(pop last-gctime)
|
|
(pop last-runtime)))))
|
|
|
|
(time-origin 'push)
|
|
|
|
(sstatus ttyint #^] #'(lambda (stream char)
|
|
(if (= char (tyipeek -1 stream))
|
|
(tyi stream))
|
|
(time-origin))) |