master: decode-universal-time: don't do mod and truncate separately
stassats via Sbcl-commits <[email protected]>
| Newsgroups | gmane.lisp.steel-bank.cvs |
|---|---|
| Message-ID | <[email protected]> |
The branch "master" has been updated in SBCL:
via 2e8fa20cbdd1fae3258185ae96227533530d5468 (commit)
from 23dedf91502177ccb8922594200d3cb445389d65 (commit)
- Log -----------------------------------------------------------------
commit 2e8fa20cbdd1fae3258185ae96227533530d5468
Author: Stas Boukarev <[email protected]>
Date: Thu Aug 20 13:17:46 2026 +0300
decode-universal-time: don't do mod and truncate separately
And some other arithmetic rearrangements.
---
src/code/time.lisp | 60 ++++++++++++++++++++++++++--------------------------
tests/time.pure.lisp | 20 ++++++++++++++++--
2 files changed, 48 insertions(+), 32 deletions(-)
diff --git a/src/code/time.lisp b/src/code/time.lisp
index 2a18d3162..13762ee0f 100644
--- a/src/code/time.lisp
+++ b/src/code/time.lisp
@@ -138,41 +138,41 @@ format."
nine values: second, minute, hour, date, month, year, day of week (0 =
Monday), T (daylight savings time) or NIL (standard time), and timezone.
Completely ignores daylight-savings-time when time-zone is supplied."
- (multiple-value-bind (seconds-west daylight)
+ (multiple-value-bind (seconds-west time-zone daylight)
(if time-zone
- (values (* time-zone 60 60) nil)
- (sb-unix::get-timezone (truncate-to-unix-range universal-time)))
+ (values (* time-zone 60 60) time-zone nil)
+ (multiple-value-bind (seconds-west daylight)
+ (sb-unix::get-timezone (truncate-to-unix-range universal-time))
+ (let ((time-zone (/ seconds-west 60 60)))
+ (values seconds-west
+ (if daylight
+ (1+ time-zone)
+ time-zone)
+ daylight))))
(declare (fixnum seconds-west))
(multiple-value-bind (weeks secs)
(truncate (+ (- universal-time seconds-west) seconds-offset)
seconds-in-week)
- (let ((weeks (+ weeks weeks-offset)))
- (multiple-value-bind (t1 second)
- (truncate secs 60)
- (let ((tday (truncate t1 minutes-per-day)))
- (multiple-value-bind (hour minute)
- (truncate (- t1 (* tday minutes-per-day)) 60)
- (let* ((t2 (1- (* (+ (* weeks 7) tday november-17-1858) 4)))
- (tcent (truncate t2 quarter-days-per-century)))
- (setq t2 (mod t2 quarter-days-per-century))
- (setq t2 (+ (- t2 (mod t2 4)) 3))
- (let* ((year (+ (* tcent 100)
- (truncate t2 quarter-days-per-year)))
- (days-since-mar0
- (1+ (truncate (mod t2 quarter-days-per-year) 4)))
- (day (mod (+ tday weekday-november-17-1858) 7))
- (t3 (+ (* days-since-mar0 5) 456)))
- (cond ((>= t3 1989)
- (setq t3 (- t3 1836))
- (setq year (1+ year))))
- (multiple-value-bind (month t3)
- (truncate t3 153)
- (let ((date (1+ (truncate t3 5))))
- (values second minute hour date month year day
- daylight
- (if daylight
- (1+ (/ seconds-west 60 60))
- (/ seconds-west 60 60))))))))))))))
+ (multiple-value-bind (t1 second) (truncate secs 60)
+ (multiple-value-bind (tday tday-rem) (truncate t1 minutes-per-day)
+ (multiple-value-bind (hour minute) (truncate tday-rem 60)
+ (let* ((weeks (+ weeks weeks-offset))
+ (t2 (1- (* (+ (* weeks 7) tday november-17-1858) 4))))
+ (multiple-value-bind (tcent t2) (truncate t2 quarter-days-per-century)
+ (setq t2 (+ (logand t2 -4) 3)) ;; align up
+ (multiple-value-bind (t2-quarter-days t2-quarter-days-rem)
+ (truncate t2 quarter-days-per-year)
+ (let* ((year (+ (* tcent 100) t2-quarter-days))
+ (days-since-mar0 (truncate t2-quarter-days-rem 4))
+ (day (mod (+ tday weekday-november-17-1858) 7))
+ (t3 (+ (* days-since-mar0 5) 5 456)))
+ (cond ((>= t3 1989)
+ (setq t3 (- t3 1836))
+ (setq year (1+ year))))
+ (multiple-value-bind (month t3) (truncate t3 153)
+ (let ((date (1+ (truncate t3 5))))
+ (values second minute hour date month year day
+ daylight time-zone)))))))))))))
(defun pick-obvious-year (year)
(declare (type (mod 100) year))
diff --git a/tests/time.pure.lisp b/tests/time.pure.lisp
index 10ac3c173..61d4595b8 100644
--- a/tests/time.pure.lisp
+++ b/tests/time.pure.lisp
@@ -14,7 +14,6 @@
(with-test (:name (get-internal-run-time :monotonic))
(checked-compile-and-assert (:optimize nil)
'(lambda (n-seconds)
- (declare (type fixnum n-seconds))
(let* ((n-internal-time-units
(* n-seconds
internal-time-units-per-second))
@@ -23,7 +22,7 @@
(loop for time = (get-internal-run-time)
while (< time time1)
always (>= time time0))))
- ((1) t)))
+ ((0.5) t)))
(with-test (:name (time :lambdas-converted))
(let ((output (with-output-to-string (*trace-output*)
@@ -32,3 +31,20 @@
;; converted. The exact number depends on the inner workings of
;; the compiler.
(assert (search "converted" output))))
+
+(with-test (:name :encode-decode-time)
+ (let ((*random-state* (make-random-state t)))
+ (loop repeat 200
+ for time = (random (expt 2 (random 80)))
+ for tz = (* 1/3600
+ (if (zerop (random 2))
+ -1
+ 1)
+ (random (/ 24 1/3600)))
+ do (multiple-value-bind (second minute hour date month year day daylight-p zone)
+ (decode-universal-time time tz)
+ (assert (= day (mod (floor (- time (* tz 3600)) 86400) 7)))
+ (assert (= zone tz))
+ (assert (not daylight-p))
+ (assert (= time
+ (encode-universal-time second minute hour date month year tz)))))))
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL