From 568cd660ab932176ee9aa1230a49e380e2e8f68f Mon Sep 17 00:00:00 2001 From: Max Rottenkolber Date: Wed, 7 Jun 2017 22:18:17 +0200 Subject: [PATCH 1/5] move ccl:current-time-in-nanoseconds from lib/time to l1-lisp-threads --- level-1/l1-lisp-threads.lisp | 20 ++++++++++++++++++++ lib/time.lisp | 22 ---------------------- 2 files changed, 20 insertions(+), 22 deletions(-) diff --git a/level-1/l1-lisp-threads.lisp b/level-1/l1-lisp-threads.lisp index 8c9c7f117..ba74a9391 100644 --- a/level-1/l1-lisp-threads.lisp +++ b/level-1/l1-lisp-threads.lisp @@ -76,6 +76,26 @@ :address (or ptz (%null-ptr)) :int)) +#-(or darwin-target windows-target) +(defloadvar preferred-posix-clock-id + (rlet ((ts :timespec)) + (if (eql 0 (#_clock_gettime #$CLOCK_MONOTONIC ts)) + #$CLOCK_MONOTONIC + #$CLOCK_REALTIME))) + +(defun current-time-in-nanoseconds () + #-(or darwin-target windows-target) + (rlet ((ts :timespec)) + (#_clock_gettime preferred-posix-clock-id ts) + (+ (* (pref ts :timespec.tv_sec) 1000000000) + (pref ts :timespec.tv_nsec))) + #+darwin-target (#_mach_absolute_time) + #+windows-target + (rlet ((time #>FILETIME)) + (#_GetSystemTimeAsFileTime time) + (* (logior (pref time #>FILETIME.dwLowDateTime) + (ash (pref time #>FILETIME.dwHighDateTime) 32)) + 100))) (defloadvar *lisp-start-timeval* (progn (let* ((r (make-record :timeval))) diff --git a/lib/time.lisp b/lib/time.lisp index 4afd24975..2e6ee251f 100644 --- a/lib/time.lisp +++ b/lib/time.lisp @@ -282,25 +282,3 @@ INTERNAL-TIME-UNITS-PER-SECOND.) This is useful for finding CPU usage." (multiple-value-bind (user sys) (%internal-run-time) (+ user sys))) - -#-(or darwin-target windows-target) -(defloadvar preferred-posix-clock-id - (rlet ((ts :timespec)) - (if (eql 0 (#_clock_gettime #$CLOCK_MONOTONIC ts)) - #$CLOCK_MONOTONIC - #$CLOCK_REALTIME))) - -(defun current-time-in-nanoseconds () - #-(or darwin-target windows-target) - (rlet ((ts :timespec)) - (#_clock_gettime preferred-posix-clock-id ts) - (+ (* (pref ts :timespec.tv_sec) 1000000000) - (pref ts :timespec.tv_nsec))) - #+darwin-target (#_mach_absolute_time) - #+windows-target - (rlet ((time #>FILETIME)) - (#_GetSystemTimeAsFileTime time) - (* (logior (pref time #>FILETIME.dwLowDateTime) - (ash (pref time #>FILETIME.dwHighDateTime) 32)) - 100))) - From 874f22467fc993e4aeaa8941190ba372eddb7124 Mon Sep 17 00:00:00 2001 From: Max Rottenkolber Date: Wed, 7 Jun 2017 22:18:28 +0200 Subject: [PATCH 2/5] remove dead code --- level-1/l1-lisp-threads.lisp | 6 ------ 1 file changed, 6 deletions(-) diff --git a/level-1/l1-lisp-threads.lisp b/level-1/l1-lisp-threads.lisp index ba74a9391..5a0793e91 100644 --- a/level-1/l1-lisp-threads.lisp +++ b/level-1/l1-lisp-threads.lisp @@ -96,12 +96,6 @@ (* (logior (pref time #>FILETIME.dwLowDateTime) (ash (pref time #>FILETIME.dwHighDateTime) 32)) 100))) -(defloadvar *lisp-start-timeval* - (progn - (let* ((r (make-record :timeval))) - (gettimeofday r) - r))) - (defloadvar *internal-real-time-session-seconds* nil) From b9d7fe8988f37531f253f356d7812126eebabe73 Mon Sep 17 00:00:00 2001 From: Max Rottenkolber Date: Thu, 8 Jun 2017 00:37:37 +0200 Subject: [PATCH 3/5] get-internal-realtime / ccl::get-tick-count - use current-time-in-nanoseconds --- level-1/l1-lisp-threads.lisp | 26 ++++---------------------- 1 file changed, 4 insertions(+), 22 deletions(-) diff --git a/level-1/l1-lisp-threads.lisp b/level-1/l1-lisp-threads.lisp index 5a0793e91..775e031ac 100644 --- a/level-1/l1-lisp-threads.lisp +++ b/level-1/l1-lisp-threads.lisp @@ -97,33 +97,15 @@ (ash (pref time #>FILETIME.dwHighDateTime) 32)) 100))) -(defloadvar *internal-real-time-session-seconds* nil) - - (defun get-internal-real-time () "Return the real time in the internal time format. (See INTERNAL-TIME-UNITS-PER-SECOND.) This is useful for finding elapsed time." - (rlet ((tv :timeval)) - (gettimeofday tv) - (let* ((units (truncate (the fixnum (pref tv :timeval.tv_usec)) (/ 1000000 internal-time-units-per-second))) - (initial *internal-real-time-session-seconds*)) - (if initial - (locally - (declare (type (unsigned-byte 32) initial)) - (+ (* internal-time-units-per-second - (the (unsigned-byte 32) - (- (the (unsigned-byte 32) (pref tv :timeval.tv_sec)) - initial))) - units)) - (progn - (setq *internal-real-time-session-seconds* - (pref tv :timeval.tv_sec)) - units))))) + (values (truncate (current-time-in-nanoseconds) + (load-time-value + (/ 1000000000 internal-time-units-per-second))))) (defun get-tick-count () - (values (floor (get-internal-real-time) - (floor internal-time-units-per-second - *ticks-per-second*)))) + (values (truncate (current-time-in-nanoseconds) *ns-per-tick*))) From 84af35a0c022969f956b34f5e63d16eef98562fe Mon Sep 17 00:00:00 2001 From: Max Rottenkolber Date: Thu, 8 Jun 2017 15:54:15 +0200 Subject: [PATCH 4/5] ccl:current-time-in-nanoseconds - fix for Darwin/Windows On Darwin it now correctly returns a value in ns, see https://developer.apple.com/library/content/qa/qa1398/_index.html On Windws it now correctly returns a monotinic value --- level-1/l1-lisp-threads.lisp | 35 ++++++++++++++++++++++++----------- 1 file changed, 24 insertions(+), 11 deletions(-) diff --git a/level-1/l1-lisp-threads.lisp b/level-1/l1-lisp-threads.lisp index 775e031ac..cd4a2fda0 100644 --- a/level-1/l1-lisp-threads.lisp +++ b/level-1/l1-lisp-threads.lisp @@ -33,8 +33,17 @@ #-windows-target (max 1000 (#_sysconf #$_SC_CLK_TCK))) +(defloadvar *ns-per-second* + 1000000000) + +(defloadvar *ns-per-millisecond* + (floor *ns-per-second* 1000)) + (defloadvar *ns-per-tick* - (floor 1000000000 *ticks-per-second*)) + (floor *ns-per-second* *ticks-per-second*)) + +(defloadvar *ns-per-internal-time-unit* + (floor *ns-per-second* internal-time-units-per-second)) #-windows-target (defun %nanosleep (seconds nanoseconds) @@ -83,29 +92,33 @@ #$CLOCK_MONOTONIC #$CLOCK_REALTIME))) +#+darwin-target +(defloadvar darwin-ns-per-unit + (rlet ((timebase-info :mach_timebase_info_data_t)) + (#_mach_timebase_info timebase-info) + (floor (pref timebase-info :mach_timebase_info_data_t.numer) + (pref timebase-info :mach_timebase_info_data_t.denom)))) + (defun current-time-in-nanoseconds () #-(or darwin-target windows-target) (rlet ((ts :timespec)) (#_clock_gettime preferred-posix-clock-id ts) - (+ (* (pref ts :timespec.tv_sec) 1000000000) + (+ (* (pref ts :timespec.tv_sec) *ns-per-second*) (pref ts :timespec.tv_nsec))) - #+darwin-target (#_mach_absolute_time) + #+darwin-target + (* (#_mach_absolute_time) darwin-ns-per-unit) #+windows-target - (rlet ((time #>FILETIME)) - (#_GetSystemTimeAsFileTime time) - (* (logior (pref time #>FILETIME.dwLowDateTime) - (ash (pref time #>FILETIME.dwHighDateTime) 32)) - 100))) + (* (#_GetTickCount64) *ns-per-millisecond*)) (defun get-internal-real-time () "Return the real time in the internal time format. (See INTERNAL-TIME-UNITS-PER-SECOND.) This is useful for finding elapsed time." (values (truncate (current-time-in-nanoseconds) - (load-time-value - (/ 1000000000 internal-time-units-per-second))))) + *ns-per-internal-time-unit*))) (defun get-tick-count () - (values (truncate (current-time-in-nanoseconds) *ns-per-tick*))) + (values (truncate (current-time-in-nanoseconds) + *ns-per-tick*))) From 3b966c541aa2cd384771a09119055adbf3461b2d Mon Sep 17 00:00:00 2001 From: Max Rottenkolber Date: Thu, 8 Jun 2017 23:31:56 +0200 Subject: [PATCH 5/5] Use defconstant for constants in l1-lisp-threads MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit *ns-per-second* → +ns-per-second+ *ns-per-millisecond* → +ns-per-millisecond+ --- level-1/l1-lisp-threads.lisp | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/level-1/l1-lisp-threads.lisp b/level-1/l1-lisp-threads.lisp index cd4a2fda0..d037e2b73 100644 --- a/level-1/l1-lisp-threads.lisp +++ b/level-1/l1-lisp-threads.lisp @@ -33,17 +33,15 @@ #-windows-target (max 1000 (#_sysconf #$_SC_CLK_TCK))) -(defloadvar *ns-per-second* - 1000000000) +(defconstant +ns-per-second+ 1000000000) -(defloadvar *ns-per-millisecond* - (floor *ns-per-second* 1000)) +(defconstant +ns-per-millisecond+ (floor +ns-per-second+ 1000)) (defloadvar *ns-per-tick* - (floor *ns-per-second* *ticks-per-second*)) + (floor +ns-per-second+ *ticks-per-second*)) (defloadvar *ns-per-internal-time-unit* - (floor *ns-per-second* internal-time-units-per-second)) + (floor +ns-per-second+ internal-time-units-per-second)) #-windows-target (defun %nanosleep (seconds nanoseconds) @@ -103,12 +101,12 @@ #-(or darwin-target windows-target) (rlet ((ts :timespec)) (#_clock_gettime preferred-posix-clock-id ts) - (+ (* (pref ts :timespec.tv_sec) *ns-per-second*) + (+ (* (pref ts :timespec.tv_sec) +ns-per-second+) (pref ts :timespec.tv_nsec))) #+darwin-target (* (#_mach_absolute_time) darwin-ns-per-unit) #+windows-target - (* (#_GetTickCount64) *ns-per-millisecond*)) + (* (#_GetTickCount64) +ns-per-millisecond+)) (defun get-internal-real-time () "Return the real time in the internal time format. (See