]> gitweb.factorcode.org Git - factor.git/commitdiff
Merge branch 'master' of git://github.com/erg/factor
authorSlava Pestov <slava@factorcode.org>
Tue, 22 Jun 2010 08:13:39 +0000 (04:13 -0400)
committerSlava Pestov <slava@factorcode.org>
Tue, 22 Jun 2010 08:13:39 +0000 (04:13 -0400)
13 files changed:
basis/calendar/calendar-tests.factor
basis/calendar/unix/unix.factor
basis/core-foundation/run-loop/run-loop.factor
basis/core-foundation/timers/timers.factor
basis/furnace/cache/cache.factor
basis/smtp/smtp.factor
basis/stack-checker/known-words/known-words.factor
basis/tools/time/time-docs.factor
basis/ui/gestures/gestures-docs.factor
basis/uuid/uuid.factor
core/system/system-docs.factor
extra/space-invaders/space-invaders.factor
extra/tetris/game/game.factor

index 3f52b4d2e7f2da50688a450580d9112070201647..5cfb0426081ab7ac2a2f1a26ae1a1935553fb499 100644 (file)
@@ -140,7 +140,6 @@ IN: calendar.tests
 [ +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
index 40475b4d407ef53cbbc3da1d0f9b617de9926001..a1e83cc1c15e6d270f10a71df6c684a9ef9f37df 100644 (file)
@@ -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 <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 ;
index 793efefbe869b81e663fa2514d737af9a039ed30..5396b83dcadeb4a65037176604a9c161af9b1ea3 100644 (file)
@@ -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
index 343753385a205f248d39e8bdc403c9da5419571e..99091408bbb8fbdcdb2196f93cb4a567882acaa2 100644 (file)
@@ -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
index 676e41d3bcf5886579f27b148e067e7ce56761ee..abb41867a36f63f2efdaa51810d3c70e9cb398b4 100644 (file)
@@ -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 ;
index 045c08df42b86056fec8e5ccd13f35e1585e1b66..5b99edc9e8fa316287f5fa69367cc9e2849d0cb1 100644 (file)
@@ -188,7 +188,7 @@ ERROR: invalid-header-string string ;
         "<" %
         64 random-bits #
         "-" %
-        system-micros #
+        gmt timestamp>micros #
         "@" %
         smtp-domain get [ host-name ] unless* %
         ">" %
index a652c500bac5ff180c03e3d415900abba46f61fd..0721e61a2a9babefd4b483eb5df32802494a5c0d 100644 (file)
@@ -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
index cbcd38c80159769d4844c18bf8753fb2fa7ec94d..a3b8e9fc7ec87cc3fbc0d6c4e4bc94fa395ebaf7 100644 (file)
@@ -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" } }
index bb33e28da3c281060772b3ac57abbb8dbf81bc1d..592a3fea3af61455d378cb7456ea8dfccdbf09d9 100644 (file)
@@ -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." } ;
index 118db67d907eed15410fa524f4dbe932637d6b70..6c1e1de55b05ea96abac24aa3326384fd5037561 100644 (file)
@@ -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
 
 <PRIVATE
 
@@ -12,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.
-    system-micros 10 * HEX: 01b21dd213814000 +
+    gmt timestamp>micros 10 * HEX: 01b21dd213814000 +
     [ -48 shift HEX: 0fff bitand ] 
     [ -32 shift HEX: ffff bitand ]
     [ HEX: ffffffff bitand ]
index 8ef3b3e42a4b5b9960ba27869705e39b4bbd3379..b14cb90a6807202f1efc7bac19c3d3d53ae94196 100644 (file)
@@ -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" } }
index 14277a1f2845dfb458a7cb6f011c95b8567762b9..a287c419d3d7fe0be895b5796b1ab15cfb3d0518 100755 (executable)
@@ -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 -- )
index a45e6551317ebc44cf97f256eedd9ebd92ce22ff..d96434fbe10266c8814acb6aca76377f38a4d220 100644 (file)
@@ -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 -- )