diff --git a/basis/calendar/calendar-tests.factor b/basis/calendar/calendar-tests.factor index 3f52b4d2e7..5cfb042608 100644 --- a/basis/calendar/calendar-tests.factor +++ b/basis/calendar/calendar-tests.factor @@ -140,7 +140,6 @@ IN: calendar.tests [ +gt+ ] [ 2005 1 1 12 30 0 instant 2004 1 1 13 30 0 instant <=> ] unit-test -[ t ] [ now timestamp>micros system-micros - 1000000 < ] unit-test [ t ] [ 0 micros>timestamp unix-1970 = ] unit-test [ t ] [ 123456789000000 [ micros>timestamp timestamp>micros ] keep = ] unit-test [ t ] [ 123456789123456000 [ micros>timestamp timestamp>micros ] keep = ] unit-test diff --git a/basis/calendar/unix/unix.factor b/basis/calendar/unix/unix.factor index 40475b4d40..a1e83cc1c1 100644 --- a/basis/calendar/unix/unix.factor +++ b/basis/calendar/unix/unix.factor @@ -29,6 +29,12 @@ IN: calendar.unix M: unix gmt-offset ( -- hours minutes seconds ) get-time gmtoff>> 3600 /mod 60 /mod ; +: current-timeval ( -- timeval ) + timeval f [ gettimeofday io-error ] 2keep drop ; + +: system-micros ( -- n ) + current-timeval + [ sec>> 1,000,000 * ] [ usec>> ] bi + ; + M: unix gmt - timeval f [ gettimeofday io-error ] 2keep drop - timeval>unix-time ; + current-timeval timeval>unix-time ; diff --git a/basis/core-foundation/run-loop/run-loop.factor b/basis/core-foundation/run-loop/run-loop.factor index 793efefbe8..5396b83dca 100644 --- a/basis/core-foundation/run-loop/run-loop.factor +++ b/basis/core-foundation/run-loop/run-loop.factor @@ -1,10 +1,12 @@ ! Copyright (C) 2008, 2010 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien alien.c-types alien.syntax kernel math -namespaces sequences destructors combinators threads heaps -deques calendar system core-foundation core-foundation.strings -core-foundation.file-descriptors core-foundation.timers -core-foundation.time ; +USING: accessors alien alien.c-types alien.syntax calendar +classes.struct combinators core-foundation +core-foundation.file-descriptors core-foundation.strings +core-foundation.time core-foundation.timers deques destructors +heaps kernel math namespaces sequences system threads unix +unix.time ; +FROM: calendar.unix => system-micros ; IN: core-foundation.run-loop CONSTANT: kCFRunLoopRunFinished 1 diff --git a/basis/core-foundation/timers/timers.factor b/basis/core-foundation/timers/timers.factor index 343753385a..99091408bb 100644 --- a/basis/core-foundation/timers/timers.factor +++ b/basis/core-foundation/timers/timers.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types alien.syntax system math kernel calendar -core-foundation core-foundation.time ; +core-foundation core-foundation.time calendar.unix ; IN: core-foundation.timers TYPEDEF: void* CFRunLoopTimerRef diff --git a/basis/furnace/cache/cache.factor b/basis/furnace/cache/cache.factor index 676e41d3bc..abb41867a3 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. system-micros [a,b] >>expires + -1/0. gmt 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 045c08df42..5b99edc9e8 100644 --- a/basis/smtp/smtp.factor +++ b/basis/smtp/smtp.factor @@ -188,7 +188,7 @@ ERROR: invalid-header-string string ; "<" % 64 random-bits # "-" % - system-micros # + gmt timestamp>micros # "@" % smtp-domain get [ host-name ] unless* % ">" % diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index a652c500ba..0721e61a2a 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -459,7 +459,6 @@ M: bad-executable summary \ special-object { fixnum } { object } define-primitive \ special-object make-flushable \ string-nth-fast { fixnum string } { fixnum } define-primitive \ string-nth-fast make-flushable \ strip-stack-traces { } { } define-primitive -\ system-micros { } { integer } define-primitive \ system-micros make-flushable \ tag { object } { fixnum } define-primitive \ tag make-foldable \ unimplemented { } { } define-primitive \ word-code { word } { integer integer } define-primitive \ word-code make-flushable diff --git a/basis/tools/time/time-docs.factor b/basis/tools/time/time-docs.factor index cbcd38c801..a3b8e9fc7e 100644 --- a/basis/tools/time/time-docs.factor +++ b/basis/tools/time/time-docs.factor @@ -24,7 +24,7 @@ HELP: time { $values { "quot" quotation } } { $description "Runs a quotation, gathering statistics about method dispatch and garbage collection, and then prints the total run time." } ; -{ benchmark system-micros time } related-words +{ benchmark time } related-words HELP: collect-gc-events { $values { "quot" quotation } { "gc-events" "a sequence of " { $link gc-event } " instances" } } diff --git a/basis/ui/gestures/gestures-docs.factor b/basis/ui/gestures/gestures-docs.factor index bb33e28da3..592a3fea3a 100644 --- a/basis/ui/gestures/gestures-docs.factor +++ b/basis/ui/gestures/gestures-docs.factor @@ -174,7 +174,7 @@ HELP: hand-last-button { $var-description "Global variable. The mouse button most recently pressed." } ; HELP: hand-last-time -{ $var-description "Global variable. The timestamp of the most recent mouse button click. This timestamp has the same format as the output value of " { $link system-micros } "." } ; +{ $var-description "Global variable. The timestamp of the most recent mouse button click. This timestamp has the same format as the output value of " { $link nano-count } "." } ; HELP: hand-buttons { $var-description "Global variable. A vector of mouse buttons currently held down." } ; diff --git a/basis/uuid/uuid.factor b/basis/uuid/uuid.factor index 118db67d90..6c1e1de55b 100644 --- a/basis/uuid/uuid.factor +++ b/basis/uuid/uuid.factor @@ -1,10 +1,9 @@ ! Copyright (C) 2008 John Benediktsson ! See http://factorcode.org/license.txt for BSD license -USING: byte-arrays checksums checksums.md5 checksums.sha -kernel math math.parser math.ranges random unicode.case -sequences strings system io.binary ; - -IN: uuid +USING: byte-arrays calendar checksums checksums.md5 +checksums.sha io.binary kernel math math.parser math.ranges +random sequences strings system unicode.case ; +IN: uuid micros 10 * HEX: 01b21dd213814000 + [ -48 shift HEX: 0fff bitand ] [ -32 shift HEX: ffff bitand ] [ HEX: ffffffff bitand ] diff --git a/core/system/system-docs.factor b/core/system/system-docs.factor index 8ef3b3e42a..b14cb90a68 100644 --- a/core/system/system-docs.factor +++ b/core/system/system-docs.factor @@ -14,10 +14,6 @@ ARTICLE: "system" "System interface" vm image } -"Getting the current time:" -{ $subsections - system-micros -} "Getting a monotonically increasing nanosecond count:" { $subsections nano-count } "Exiting the Factor VM:" @@ -78,15 +74,10 @@ HELP: exit ( n -- ) { $values { "n" "an integer exit code" } } { $description "Exits the Factor process." } ; -HELP: system-micros ( -- us ) -{ $values { "us" integer } } -{ $description "Outputs the number of microseconds elapsed since midnight January 1, 1970." } -{ $notes "This is a low-level word. The " { $vocab-link "calendar" } " vocabulary provides features for date/time arithmetic and formatting. For timing code, use " { $link nano-count } "." } ; - HELP: nano-count ( -- ns ) { $values { "ns" integer } } { $description "Outputs a monotonically increasing count of nanoseconds elapsed since an arbitrary starting time. The difference of two calls to this word allows timing. This word is unaffected by system clock changes." } -{ $notes "This is a low-level word. The " { $vocab-link "tools.time" } " vocabulary defines words to time code execution time. For system time, use " { $link system-micros } "." } ; +{ $notes "This is a low-level word. The " { $vocab-link "tools.time" } " vocabulary defines words to time code execution time." } ; HELP: image { $values { "path" "a pathname string" } } diff --git a/extra/space-invaders/space-invaders.factor b/extra/space-invaders/space-invaders.factor index 14277a1f28..a287c419d3 100755 --- a/extra/space-invaders/space-invaders.factor +++ b/extra/space-invaders/space-invaders.factor @@ -359,8 +359,8 @@ M: space-invaders update-video ( value addr cpu -- ) : sync-frame ( micros -- micros ) #! Sleep until the time for the next frame arrives. - 1000 60 / >fixnum + system:system-micros - dup 0 > - [ milliseconds threads:sleep ] [ drop threads:yield ] if system:system-micros ; + 1000 60 / >fixnum + gmt timestamp>micros - dup 0 > + [ milliseconds threads:sleep ] [ drop threads:yield ] if gmt timestamp>micros ; : invaders-process ( micros gadget -- ) #! Run a space invaders gadget inside a @@ -378,7 +378,7 @@ M: space-invaders update-video ( value addr cpu -- ) M: invaders-gadget graft* ( gadget -- ) dup cpu>> init-sounds f over quit?<< - [ system:system-micros swap invaders-process ] curry + [ gmt timestamp>micros swap invaders-process ] curry "Space invaders" threads:spawn drop ; M: invaders-gadget ungraft* ( gadget -- ) diff --git a/extra/tetris/game/game.factor b/extra/tetris/game/game.factor index a45e655131..d96434fbe1 100644 --- a/extra/tetris/game/game.factor +++ b/extra/tetris/game/game.factor @@ -35,7 +35,7 @@ CONSTANT: default-height 20 rows>> 1 + 10 / ceiling ; : update-interval ( tetris -- interval ) - level>> 1 - 60 * 1000000 swap - ; + level>> 1 - 60 * 1,000,000,000 swap - ; : add-block ( tetris block -- ) over [ board>> ] 2dip current-piece tetromino>> colour>> set-block ; @@ -104,10 +104,10 @@ CONSTANT: default-height 20 dup { 0 1 } tetris-move [ move-drop ] [ lock-piece ] if ; : update ( tetris -- ) - system-micros over last-update>> - + nano-count over last-update>> - over update-interval > [ dup move-down - system-micros >>last-update + nano-count >>last-update ] when drop ; : ?update ( tetris -- )