]> gitweb.factorcode.org Git - factor.git/commitdiff
remove system-millis and update vocabs to use system-micros or nano-count
authorDoug Coleman <doug.coleman@gmail.com>
Thu, 19 Nov 2009 02:56:09 +0000 (20:56 -0600)
committerDoug Coleman <doug.coleman@gmail.com>
Thu, 19 Nov 2009 02:56:09 +0000 (20:56 -0600)
13 files changed:
basis/bootstrap/stage2.factor
basis/furnace/cache/cache.factor
basis/tools/time/time-docs.factor
core/system/system-docs.factor
core/system/system.factor
extra/game/loop/loop.factor
extra/game/worlds/worlds.factor
extra/gpu/demos/bunny/bunny.factor
extra/gpu/demos/raytrace/raytrace.factor
extra/jamshred/player/player.factor
extra/space-invaders/space-invaders.factor
extra/terrain/terrain.factor
extra/tetris/game/game.factor

index 674cb2e7d5419e15b1e20a6ce9d75a59011f6559..0ddcb58a4fa3c776859cf69e402c871caf510b1c 100644 (file)
@@ -35,8 +35,8 @@ SYMBOL: bootstrap-time
 : count-words ( pred -- )
     all-words swap count number>string write ; inline
 
-: print-time ( ms -- )
-    1000 /i
+: print-time ( us -- )
+    1000000 /i
     60 /mod swap
     number>string write
     " minutes and " write number>string write " seconds." print ;
@@ -59,7 +59,7 @@ SYMBOL: bootstrap-time
 
 [
     ! We time bootstrap
-    system-millis
+    system-micros
 
     default-image-name "output-image" set-global
 
@@ -84,14 +84,14 @@ SYMBOL: bootstrap-time
 
     load-components
 
-    system-millis over - core-bootstrap-time set-global
+    system-micros over - core-bootstrap-time set-global
 
     run-bootstrap-init
 
     f error set-global
     f error-continuation set-global
 
-    system-millis swap - bootstrap-time set-global
+    system-micros swap - bootstrap-time set-global
     print-report
 
     "deploy-vocab" get [
index d5d72b117ff863e599b141dcc58f91e3af9b020c..51de8c0be6852053c8af3ad55a7508ac90899508 100644 (file)
@@ -22,7 +22,7 @@ server-state f
 
 : expire-state ( class -- )
     new
-        -1/0. system-millis [a,b] >>expires
+        -1/0. system-micros [a,b] >>expires
     delete-tuples ;
 
 TUPLE: server-state-manager < filter-responder timeout ;
@@ -33,4 +33,4 @@ TUPLE: server-state-manager < filter-responder timeout ;
         20 minutes >>timeout ; inline
 
 : touch-state ( state manager -- )
-    timeout>> hence timestamp>millis >>expires drop ;
+    timeout>> hence timestamp>micros >>expires drop ;
index 4d3054db8aa21e7e1ace27c7a5990c8a2a1838cc..6603fa2d7e5ef278e324700e3dcbc3251b1f89df 100644 (file)
@@ -25,7 +25,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 system-millis time } related-words
+{ benchmark system-micros time } related-words
 
 HELP: collect-gc-events
 { $values { "quot" quotation } }
index 7414f6be606326e2800445b095ce2b2a15ac178d..8ef3b3e42a4b5b9960ba27869705e39b4bbd3379 100644 (file)
@@ -17,7 +17,6 @@ ARTICLE: "system" "System interface"
 "Getting the current time:"
 { $subsections
     system-micros
-    system-millis
 }
 "Getting a monotonically increasing nanosecond count:"
 { $subsections nano-count }
@@ -84,11 +83,6 @@ HELP: system-micros ( -- us )
 { $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: system-millis ( -- ms )
-{ $values { "ms" integer } }
-{ $description "Outputs the number of milliseconds 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." } ;
-
 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." }
index 31daa49b9fbc535ad14d9ef1057de6c05d91fd40..59f2a030ceee8fcb44a3dee3a4925f52a5a3c6fd 100644 (file)
@@ -55,6 +55,4 @@ PRIVATE>
 
 : embedded? ( -- ? ) 15 getenv ;
 
-: system-millis ( -- ms ) system-micros 1000 /i ;
-
 : exit ( n -- ) do-shutdown-hooks (exit) ;
index eec133ed1988baa7349dea332ae79bd52af710b0..c0f36d0294ddef784ea9e9964144e3c7f0151759 100644 (file)
@@ -20,8 +20,8 @@ GENERIC: draw* ( tick-slice delegate -- )
 
 SYMBOL: game-loop
 
-: since-last-tick ( loop -- milliseconds )
-    last-tick>> system-millis swap - ;
+: since-last-tick ( loop -- microseconds )
+    last-tick>> system-micros swap - ;
 
 : tick-slice ( loop -- slice )
     [ since-last-tick ] [ tick-length>> ] bi /f 1.0 min ;
@@ -53,7 +53,7 @@ TUPLE: game-loop-error game-loop error ;
     drop ;
 
 : ?tick ( loop count -- )
-    [ system-millis >>last-tick drop ] [
+    [ system-micros >>last-tick drop ] [
         over [ since-last-tick ] [ tick-length>> ] bi >=
         [ [ drop increment-tick ] [ drop tick ] [ 1 - ?tick ] 2tri ]
         [ 2drop ] if
@@ -69,24 +69,24 @@ TUPLE: game-loop-error game-loop error ;
     [ [ (run-loop) ] [ game-loop-error ] recover ]
     with-variable ;
 
-: benchmark-millis ( loop -- millis )
-    system-millis swap benchmark-time>> - ;
+: benchmark-micros ( loop -- micros )
+    system-micros swap benchmark-time>> - ;
 
 PRIVATE>
 
 : reset-loop-benchmark ( loop -- )
-    system-millis >>benchmark-time
+    system-micros >>benchmark-time
     dup tick-number>> >>benchmark-tick-number
     dup frame-number>> >>benchmark-frame-number
     drop ;
 
 : benchmark-ticks-per-second ( loop -- n )
-    [ tick-number>> ] [ benchmark-tick-number>> - ] [ benchmark-millis ] tri /f ;
+    [ tick-number>> ] [ benchmark-tick-number>> - ] [ benchmark-micros ] tri /f ;
 : benchmark-frames-per-second ( loop -- n )
-    [ frame-number>> ] [ benchmark-frame-number>> - ] [ benchmark-millis ] tri /f ;
+    [ frame-number>> ] [ benchmark-frame-number>> - ] [ benchmark-micros ] tri /f ;
 
 : start-loop ( loop -- )
-    system-millis >>last-tick
+    system-micros >>last-tick
     t >>running?
     [ reset-loop-benchmark ]
     [ [ run-loop ] curry "game loop" spawn ]
@@ -98,7 +98,7 @@ PRIVATE>
     drop ;
 
 : <game-loop> ( tick-length delegate -- loop )
-    system-millis f f 0 0 system-millis 0 0
+    system-micros f f 0 0 system-micros 0 0
     game-loop boa ;
 
 M: game-loop dispose
index 399c5d19027689ec688a91b53ad81b03fee82a30..308b5006cf2ed14593949737b96dbf4245c7b5fb 100644 (file)
@@ -6,7 +6,7 @@ TUPLE: game-world < world
     game-loop
     { tick-slice float initial: 0.0 } ;
 
-GENERIC: tick-length ( world -- millis )
+GENERIC: tick-length ( world -- micros )
 
 M: game-world draw*
     swap >>tick-slice relayout-1 yield ;
index 09853263ce58a8ce882e6a9b34ec9fd8e2891cca..7b778f05002ec8dcf7bfc20b13a0cd342fccd427 100755 (executable)
@@ -295,7 +295,7 @@ AFTER: bunny-world resize-world
     [ sobel>> framebuffer>> ] [ dim>> ] bi resize-framebuffer ;
 
 M: bunny-world pref-dim* drop { 1024 768 } ;
-M: bunny-world tick-length drop 1000 30 /i ;
+M: bunny-world tick-length drop 1000000 30 /i ;
 M: bunny-world wasd-movement-speed drop 1/160. ;
 M: bunny-world wasd-near-plane drop 1/32. ;
 M: bunny-world wasd-far-plane drop 256.0 ;
index 5a3d5864fb09216fdde98b90785bf3d04e689def..94a8d179259ff34c305f4edeb08396dabf3322a9 100644 (file)
@@ -93,7 +93,7 @@ M: raytrace-world draw-world*
     } <render-set> render ;
 
 M: raytrace-world pref-dim* drop { 1024 768 } ;
-M: raytrace-world tick-length drop 1000 30 /i ;
+M: raytrace-world tick-length drop 1000000 30 /i ;
 M: raytrace-world wasd-movement-speed drop 1/4. ;
 
 : raytrace-window ( -- )
index 233d34e0788bc0b5e657bfcb10ffb8fb02d903ae..49536e257058cf5dbdcdc6bc2eb979cd0a4a20dd 100644 (file)
@@ -39,9 +39,9 @@ CONSTANT: max-speed 30.0
     >>tunnel to-tunnel-start ;
 
 : update-time ( player -- seconds-passed )
-    system-millis swap [ last-move>> - 1000 / ] [ (>>last-move) ] 2bi ;
+    system-micros swap [ last-move>> - 1000000 / ] [ (>>last-move) ] 2bi ;
 
-: moved ( player -- ) system-millis swap (>>last-move) ;
+: moved ( player -- ) system-micros swap (>>last-move) ;
 
 : speed-range ( -- range )
     max-speed [0,b] ;
index 76284532b4861dbab3877aaaa6985f3c305711d6..17e277fb6afd236fbe518dd8dc491dad0b3ab5db 100755 (executable)
@@ -72,16 +72,16 @@ CONSTANT: SOUND-UFO-HIT      8
 : init-sounds ( cpu -- )
   init-openal
   [ 9 gen-sources swap (>>sounds) ] keep
-  [ SOUND-SHOT        "resource:extra/space-invaders/resources/Shot.wav" init-sound ] keep 
-  [ SOUND-UFO         "resource:extra/space-invaders/resources/Ufo.wav" init-sound ] keep 
+  [ SOUND-SHOT        "vocab:space-invaders/resources/Shot.wav" init-sound ] keep 
+  [ SOUND-UFO         "vocab:space-invaders/resources/Ufo.wav" init-sound ] keep 
   [ sounds>> SOUND-UFO swap nth AL_LOOPING AL_TRUE set-source-param ] keep
-  [ SOUND-BASE-HIT    "resource:extra/space-invaders/resources/BaseHit.wav" init-sound ] keep 
-  [ SOUND-INVADER-HIT "resource:extra/space-invaders/resources/InvHit.Wav" init-sound ] keep 
-  [ SOUND-WALK1       "resource:extra/space-invaders/resources/Walk1.wav" init-sound ] keep 
-  [ SOUND-WALK2       "resource:extra/space-invaders/resources/Walk2.wav" init-sound ] keep 
-  [ SOUND-WALK3       "resource:extra/space-invaders/resources/Walk3.wav" init-sound ] keep 
-  [ SOUND-WALK4       "resource:extra/space-invaders/resources/Walk4.wav" init-sound ] keep 
-  [ SOUND-UFO-HIT    "resource:extra/space-invaders/resources/UfoHit.wav" init-sound ] keep
+  [ SOUND-BASE-HIT    "vocab:space-invaders/resources/BaseHit.wav" init-sound ] keep 
+  [ SOUND-INVADER-HIT "vocab:space-invaders/resources/InvHit.Wav" init-sound ] keep 
+  [ SOUND-WALK1       "vocab:space-invaders/resources/Walk1.wav" init-sound ] keep 
+  [ SOUND-WALK2       "vocab:space-invaders/resources/Walk2.wav" init-sound ] keep 
+  [ SOUND-WALK3       "vocab:space-invaders/resources/Walk3.wav" init-sound ] keep 
+  [ SOUND-WALK4       "vocab:space-invaders/resources/Walk4.wav" init-sound ] keep 
+  [ SOUND-UFO-HIT    "vocab:space-invaders/resources/UfoHit.wav" init-sound ] keep
   f swap (>>looping?) ;
 
 : cpu-init ( cpu -- cpu )
@@ -356,12 +356,12 @@ M: space-invaders update-video ( value addr cpu -- )
     3drop
   ] if ;
 
-: sync-frame ( millis -- millis )
+: sync-frame ( micros -- micros )
   #! Sleep until the time for the next frame arrives.
-  1000 60 / >fixnum + system:system-millis - dup 0 >
-  [ milliseconds threads:sleep ] [ drop threads:yield ] if system:system-millis ;
+  1000 60 / >fixnum + system:system-micros - dup 0 >
+  [ milliseconds threads:sleep ] [ drop threads:yield ] if system:system-micros ;
 
-: invaders-process ( millis gadget -- )
+: invaders-process ( micros gadget -- )
   #! Run a space invaders gadget inside a 
   #! concurrent process. Messages can be sent to
   #! signal key presses, etc.
@@ -377,7 +377,7 @@ M: space-invaders update-video ( value addr cpu -- )
 M: invaders-gadget graft* ( gadget -- )
   dup cpu>> init-sounds
   f over (>>quit?)
-  [ system:system-millis swap invaders-process ] curry
+  [ system:system-micros swap invaders-process ] curry
   "Space invaders" threads:spawn drop ;
 
 M: invaders-gadget ungraft* ( gadget -- )
index f1da877c3e0ce04c5eff7d1ccd54860b131b32bb..3f342f69713a20334c98ecfcea9e17ce676f112a 100644 (file)
@@ -57,7 +57,7 @@ TUPLE: terrain-world < game-world
         VELOCITY-MODIFIER-NORMAL >>velocity-modifier ;
 
 M: terrain-world tick-length
-    drop 1000 30 /i ;
+    drop 1000000 30 /i ;
 
 : frustum ( dim -- -x x -y y near far )
     dup first2 min v/n
index fdf6e10d5d77d75a70646bdd89ef69f1cae505ec..a45e6551317ebc44cf97f256eedd9ebd92ce22ff 100644 (file)
@@ -35,7 +35,7 @@ CONSTANT: default-height 20
     rows>> 1 + 10 / ceiling ;
 
 : update-interval ( tetris -- interval )
-    level>> 1 - 60 * 1000 swap - ;
+    level>> 1 - 60 * 1000000 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-millis over last-update>> -
+    system-micros over last-update>> -
     over update-interval > [
         dup move-down
-        system-millis >>last-update
+        system-micros >>last-update
     ] when drop ;
 
 : ?update ( tetris -- )