[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master afa67ed6f2 08/16: Fix year-285428751 bug in hanoi-unix-64
From: |
Paul Eggert |
Subject: |
master afa67ed6f2 08/16: Fix year-285428751 bug in hanoi-unix-64 |
Date: |
Mon, 1 Aug 2022 04:17:28 -0400 (EDT) |
branch: master
commit afa67ed6f20780ee8e99a5cac1bcc4899d83adea
Author: Paul Eggert <eggert@cs.ucla.edu>
Commit: Paul Eggert <eggert@cs.ucla.edu>
Fix year-285428751 bug in hanoi-unix-64
* lisp/play/hanoi.el (hanoi-move-period, hanoi, hanoi-unix)
(hanoi-unix-64): Use integers, not floating point, to avoid
rounding errors for timestamps greater than 2**53.
---
lisp/play/hanoi.el | 44 +++++++++++++++++++++-----------------------
1 file changed, 21 insertions(+), 23 deletions(-)
diff --git a/lisp/play/hanoi.el b/lisp/play/hanoi.el
index 227dd790af..58fb82b6ed 100644
--- a/lisp/play/hanoi.el
+++ b/lisp/play/hanoi.el
@@ -73,7 +73,7 @@
"Non-nil means that hanoi poles are oriented horizontally."
:type 'boolean)
-(defcustom hanoi-move-period 1.0
+(defcustom hanoi-move-period 1
"Time, in seconds, for each pole-to-pole move of a ring.
If nil, move rings as fast as possible while displaying all
intermediate positions."
@@ -112,35 +112,32 @@ intermediate positions."
(prefix-numeric-value current-prefix-arg))))
(if (< nrings 0)
(error "Negative number of rings"))
- (hanoi-internal nrings (make-list nrings 0) (float-time)))
+ (hanoi-internal nrings (make-list nrings 0) (time-convert nil 'integer)))
;;;###autoload
(defun hanoi-unix ()
- "Towers of Hanoi, UNIX doomsday version.
-Displays 32-ring towers that have been progressing at one move per
-second since 1970-01-01 00:00:00 GMT.
+ "Towers of Hanoi, 32-bit UNIX doomsday version.
+Display 32-ring towers that have been progressing at one move per
+second since 1970-01-01 00:00:00 UTC.
Repent before ring 31 moves."
(interactive)
- (let* ((start (ftruncate (float-time)))
- (bits (cl-loop repeat 32
- for x = (/ start (expt 2.0 31)) then (* x 2.0)
- collect (truncate (mod x 2.0))))
- (hanoi-move-period 1.0))
+ (let* ((start (time-convert nil 'integer))
+ (bits (nreverse (cl-loop repeat 32
+ for x = start then (ash x -1)
+ collect (logand x 1))))
+ (hanoi-move-period 1))
(hanoi-internal 32 bits start)))
;;;###autoload
(defun hanoi-unix-64 ()
- "Like `hanoi-unix', but pretend to have a 64-bit clock.
-This is, necessarily (as of Emacs 20.3), a crock. When the
-`current-time' interface is made s2G-compliant, hanoi.el will need
-to be updated."
+ "Like `hanoi-unix', but with a 64-bit clock."
(interactive)
- (let* ((start (ftruncate (float-time)))
- (bits (cl-loop repeat 64
- for x = (/ start (expt 2.0 63)) then (* x 2.0)
- collect (truncate (mod x 2.0))))
- (hanoi-move-period 1.0))
+ (let* ((start (time-convert nil 'integer))
+ (bits (nreverse (cl-loop repeat 64
+ for x = start then (ash x -1)
+ collect (logand x 1))))
+ (hanoi-move-period 1))
(hanoi-internal 64 bits start)))
(defun hanoi-internal (nrings bits start-time)
@@ -378,9 +375,10 @@ BITS must be of length nrings. Start at START-TIME."
(/ (- tick flyward-ticks fly-ticks)
ticks-per-pole-step))))))))
(if hanoi-move-period
- (cl-loop for elapsed = (- (float-time) start-time)
- while (< elapsed hanoi-move-period)
- with tick-period = (/ (float hanoi-move-period) total-ticks)
+ (cl-loop for elapsed = (float-time (time-subtract nil start-time))
+ while (time-less-p elapsed hanoi-move-period)
+ with tick-period = (/ (float-time hanoi-move-period)
+ total-ticks)
for tick = (ceiling elapsed tick-period) do
(hanoi-ring-to-pos ring (funcall tick-to-pos tick))
(hanoi-sit-for (- (* tick tick-period) elapsed)))
@@ -389,7 +387,7 @@ BITS must be of length nrings. Start at START-TIME."
(hanoi-sit-for 0)))
;; Always make last move to keep pole and ring data consistent
(hanoi-ring-to-pos ring (car to))
- (if hanoi-move-period (+ start-time hanoi-move-period))))
+ (if hanoi-move-period (time-add start-time hanoi-move-period))))
;; update display and pause, quitting with a pithy comment if the user
;; hits a key.
- master updated (ee0ce18662 -> bec8474a45), Paul Eggert, 2022/08/01
- master 24e1123241 06/16: Improve time-equal-p etc. performance, Paul Eggert, 2022/08/01
- master 914cf4b91b 04/16: Make time arithmetic more like comparison, Paul Eggert, 2022/08/01
- master afa67ed6f2 08/16: Fix year-285428751 bug in hanoi-unix-64,
Paul Eggert <=
- master 353413a76b 10/16: * lisp/vc/vc.el: Remove stray comment hyphen., Paul Eggert, 2022/08/01
- master 932c0bc1fc 01/16: Tune blv_found, Paul Eggert, 2022/08/01
- master d6c054a007 09/16: Fix "cons up a storm" issue in type-break, Paul Eggert, 2022/08/01
- master a51863f73d 12/16: Simplify a few timestamps, Paul Eggert, 2022/08/01
- master d634cb0954 11/16: Omit some (current-time) calls, Paul Eggert, 2022/08/01
- master 2cd204d8bb 13/16: Prefer ‘time-equal-p’ to ‘equal’ on timestamps, Paul Eggert, 2022/08/01
- master 72c3efd7d0 15/16: Fix time comparison in primitive-undo, Paul Eggert, 2022/08/01
- master bec8474a45 16/16: Improve GCC pacification in xterm.c, Paul Eggert, 2022/08/01
- master 0a4477415c 05/16: Improve float-time etc. performance, Paul Eggert, 2022/08/01
- master 9d4633e934 02/16: (time-equal-p nil X) returns nil, Paul Eggert, 2022/08/01