From: John Benediktsson Date: Fri, 11 Dec 2020 06:23:47 +0000 (-0800) Subject: calendar: make now faster, remove now-gmt. X-Git-Tag: 0.99~2790 X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=2b025836055ee7a59a8b3d7cb8946c7ed0a050f0 calendar: make now faster, remove now-gmt. --- diff --git a/basis/calendar/calendar-docs.factor b/basis/calendar/calendar-docs.factor index e05b3654f7..74a06717f1 100644 --- a/basis/calendar/calendar-docs.factor +++ b/basis/calendar/calendar-docs.factor @@ -154,6 +154,8 @@ HELP: time+ } } ; +{ time+ time- } related-words + HELP: duration>years { $values { "duration" duration } { "x" number } } { $description "Calculates the length of a duration in years." } @@ -264,7 +266,7 @@ HELP: convert-timezone { $description "Converts the " { $snippet "timestamp" } "'s " { $snippet "gmt-offset" } " to the GMT offset represented by the " { $snippet "duration" } "." } { $examples { $example "USING: accessors calendar prettyprint ;" - "now-gmt noon instant -5 >>hour convert-timezone gmt-offset>> hour>> ." + "now >gmt noon -5 hours convert-timezone gmt-offset>> hour>> ." "-5" } } ; @@ -274,7 +276,7 @@ HELP: >local-time { $description "Converts the " { $snippet "timestamp" } " to the timezone of your computer." } { $examples { $example "USING: accessors calendar kernel prettyprint ;" - "now now-gmt >local-time [ gmt-offset>> ] same? ." + "now dup clone >gmt >local-time [ gmt-offset>> ] same? ." "t" } } ; @@ -301,10 +303,9 @@ HELP: gmt { local-time >local-time gmt >gmt convert-timezone } related-words -HELP: time* +HELP: duration* { $values { "obj1" object } { "obj2" object } { "obj3" object } } -{ $description "Multiplies each time slot of a timestamp or duration by a number and make a new duration from the result. Used in the implementation of " { $link before } "." } ; -{ time+ time- time* } related-words +{ $description "Multiplies each time slot of a duration by a number and make a new duration from the result. Used in the implementation of " { $link before } "." } ; HELP: before { $values { "duration" duration } { "-duration" duration } } @@ -330,12 +331,6 @@ HELP: micros>timestamp } } ; -HELP: now-gmt -{ $values { "timestamp" timestamp } } -{ $description "Returns the time right now, but in the GMT timezone." } ; - -{ now now-gmt } related-words - HELP: now { $values { "timestamp" timestamp } } { $description "Returns the time right now in your computer's timezone." } @@ -532,8 +527,8 @@ ARTICLE: "timestamp-arithmetic" "Timestamp arithmetic" { $subsections time+ } "Subtracting:" { $subsections time- } -"Element-wise multiplication:" -{ $subsections time* } ; +"Multiplying durations:" +{ $subsections duration* } ; ARTICLE: "using-durations" "Using durations" "Creating a duration object:" diff --git a/basis/calendar/calendar.factor b/basis/calendar/calendar.factor index a95baf990e..f9fa3a08af 100644 --- a/basis/calendar/calendar.factor +++ b/basis/calendar/calendar.factor @@ -15,7 +15,7 @@ ERROR: not-in-interval value interval ; HOOK: gmt-offset os ( -- hours minutes seconds ) -HOOK: now-gmt os ( -- timestamp ) +HOOK: now os ( -- timestamp ) TUPLE: duration { year real } @@ -448,9 +448,6 @@ M: duration time- : timestamp>micros ( timestamp -- n ) unix-1970 (time-) 1000000 * >integer ; -: now ( -- timestamp ) - now-gmt gmt-offset-duration [ (time+) ] [ >>gmt-offset ] bi ; - : hence ( duration -- timestamp ) now swap time+ ; : ago ( duration -- timestamp ) now swap time- ; diff --git a/basis/calendar/unix/unix.factor b/basis/calendar/unix/unix.factor index 3fbe252511..cb850f8e43 100644 --- a/basis/calendar/unix/unix.factor +++ b/basis/calendar/unix/unix.factor @@ -14,7 +14,7 @@ IN: calendar.unix timeval>seconds seconds ; inline : timeval>unix-time ( timeval -- timestamp ) - [ unix-1970 ] dip timeval>seconds +second ; inline + unix-1970 swap timeval>seconds +second ; inline : timespec>seconds ( timespec -- seconds ) [ sec>> ] [ nsec>> 1,000,000,000 / ] bi + ; inline @@ -23,7 +23,7 @@ IN: calendar.unix timespec>seconds seconds ; inline : timespec>unix-time ( timespec -- timestamp ) - [ unix-1970 ] dip timespec>seconds +second ; inline + unix-1970 swap timespec>seconds +second ; inline : get-time ( -- alien ) f time time_t localtime ; inline @@ -40,5 +40,8 @@ M: unix gmt-offset : system-micros ( -- n ) current-timeval timeval>micros ; -M: unix now-gmt - current-timeval timeval>unix-time ; +M: unix now + timeval timezone + [ gettimeofday io-error ] 2keep + [ timeval>unix-time dup gmt-offset>> ] + [ tz_minuteswest>> 60 /mod [ >>hour ] [ >>minute ] bi* drop ] bi* ; diff --git a/basis/calendar/windows/windows.factor b/basis/calendar/windows/windows.factor index dea9f7257e..82e50786ca 100644 --- a/basis/calendar/windows/windows.factor +++ b/basis/calendar/windows/windows.factor @@ -37,5 +37,6 @@ M: windows gmt-offset { TIME_ZONE_ID_DAYLIGHT [ [ Bias>> ] [ DaylightBias>> ] bi + ] } } case neg 60 /mod 0 ; -M: windows now-gmt - SYSTEMTIME [ GetSystemTime ] keep SYSTEMTIME>timestamp ; +M: windows now + SYSTEMTIME [ GetSystemTime ] keep SYSTEMTIME>timestamp + dup gmt-offset>> gmt-offset set-time drop ; diff --git a/basis/furnace/cache/cache.factor b/basis/furnace/cache/cache.factor index a43f74ffab..aaad309656 100644 --- a/basis/furnace/cache/cache.factor +++ b/basis/furnace/cache/cache.factor @@ -22,7 +22,7 @@ server-state f : expire-state ( class -- ) new - -1/0. now-gmt timestamp>micros [a,b] >>expires + -1/0. now timestamp>micros [a,b] >>expires delete-tuples ; TUPLE: server-state-manager < filter-responder timeout ; diff --git a/basis/smtp/smtp.factor b/basis/smtp/smtp.factor index 5690545268..744796bb44 100644 --- a/basis/smtp/smtp.factor +++ b/basis/smtp/smtp.factor @@ -193,7 +193,7 @@ ERROR: invalid-header-string string ; "<" % 64 random-bits # "-" % - now-gmt timestamp>micros # + now timestamp>micros # "@" % smtp-config get domain>> [ host-name ] unless* % ">" % diff --git a/basis/uuid/uuid.factor b/basis/uuid/uuid.factor index 5c34a8c8c6..b96434627b 100644 --- a/basis/uuid/uuid.factor +++ b/basis/uuid/uuid.factor @@ -11,7 +11,7 @@ IN: uuid ! 0x01b21dd213814000L is the number of 100-ns intervals ! between the UUID epoch 1582-10-15 00:00:00 and the ! Unix epoch 1970-01-01 00:00:00. - now-gmt timestamp>micros 10 * 0x01b21dd213814000 + + now timestamp>micros 10 * 0x01b21dd213814000 + [ -48 shift 0x0fff bitand ] [ -32 shift 0xffff bitand ] [ 0xffffffff bitand ] diff --git a/extra/ci/run-process/run-process.factor b/extra/ci/run-process/run-process.factor index 67c2693e1e..96fc0f9c26 100644 --- a/extra/ci/run-process/run-process.factor +++ b/extra/ci/run-process/run-process.factor @@ -13,7 +13,7 @@ TUPLE: process-autopsy : ci-run-process ( process -- timestamp os-envs cwd uid euid gid egid out elapsed os-envs' process ) [ [ - now-gmt os-envs current-directory get + now os-envs current-directory get real-user-id effective-user-id real-group-id effective-group-id ] dip [ diff --git a/extra/key-logger/key-logger.factor b/extra/key-logger/key-logger.factor index c4b48a2de3..75a1f0e717 100644 --- a/extra/key-logger/key-logger.factor +++ b/extra/key-logger/key-logger.factor @@ -12,7 +12,7 @@ CONSTANT: path "resource:key-log.txt" : update-key-caps-state ( -- ) read-keyboard keys>> path binary [ - [ now-gmt unix-1970 time- duration>nanoseconds >integer ] + [ now unix-1970 time- duration>nanoseconds >integer ] [ bit-array>integer ] bi* [ 8 >be write ] bi@ flush ] with-file-appender ; diff --git a/extra/managed-server/chat/chat.factor b/extra/managed-server/chat/chat.factor index c425890c40..e23a1934af 100644 --- a/extra/managed-server/chat/chat.factor +++ b/extra/managed-server/chat/chat.factor @@ -76,7 +76,7 @@ Displays the documentation for a command." Shows the list of connected users." "who" add-command -[ drop now-gmt timestamp>rfc822 send-line ] +[ drop now >gmt timestamp>rfc822 send-line ] "Syntax: /time Returns the current GMT time." "time" add-command diff --git a/extra/webapps/irc-log/irc-log.factor b/extra/webapps/irc-log/irc-log.factor index 74805f91e8..5158c9afd0 100644 --- a/extra/webapps/irc-log/irc-log.factor +++ b/extra/webapps/irc-log/irc-log.factor @@ -8,7 +8,7 @@ IN: webapps.irc-log TUPLE: irclog-app < dispatcher ; : irc-link ( channel -- string ) - now-gmt -7 hours convert-timezone >date< + now -7 hours convert-timezone >date< [ unparse 2 tail ] 2dip "http://bespin.org/~nef/logs/%s/%02s.%02d.%02d" sprintf ;