[ +gt+ ] [ 2005 1 1 12 30 0 instant <timestamp>
2004 1 1 13 30 0 instant <timestamp> <=> ] 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
M: unix gmt-offset ( -- hours minutes seconds )
get-time gmtoff>> 3600 /mod 60 /mod ;
+: current-timeval ( -- timeval )
+ timeval <struct> f [ gettimeofday io-error ] 2keep drop ;
+
+: system-micros ( -- n )
+ current-timeval
+ [ sec>> 1,000,000 * ] [ usec>> ] bi + ;
+
M: unix gmt
- timeval <struct> f [ gettimeofday io-error ] 2keep drop
- timeval>unix-time ;
+ current-timeval timeval>unix-time ;
! 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
! 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
: 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 ;
"<" %
64 random-bits #
"-" %
- system-micros #
+ gmt timestamp>micros #
"@" %
smtp-domain get [ host-name ] unless* %
">" %
\ 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
{ $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" } }
{ $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." } ;
! 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
<PRIVATE
! 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.
- system-micros 10 * HEX: 01b21dd213814000 +
+ gmt timestamp>micros 10 * HEX: 01b21dd213814000 +
[ -48 shift HEX: 0fff bitand ]
[ -32 shift HEX: ffff bitand ]
[ HEX: ffffffff bitand ]
vm
image
}
-"Getting the current time:"
-{ $subsections
- system-micros
-}
"Getting a monotonically increasing nanosecond count:"
{ $subsections nano-count }
"Exiting the Factor VM:"
{ $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" } }
: 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
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 -- )
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 ;
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 -- )