steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

remove system-millis and update vocabs to use system-micros or nano-count

db4
Doug Coleman 2009-11-18 20:56:09 -06:00
parent 8d43f4e911
commit f4450653a9
13 changed files with 41 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
basis/bootstrap/stage2.factor
View 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 [

4
basis/furnace/cache/cache.factor vendored
View 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 ;

2
basis/tools/time/time-docs.factor
View 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 } }

6
core/system/system-docs.factor
View 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." }

2
core/system/system.factor
View File

@ -55,6 +55,4 @@ PRIVATE>
: embedded? ( -- ? ) 15 getenv ;
: system-millis ( -- ms ) system-micros 1000 /i ;
: exit ( n -- ) do-shutdown-hooks (exit) ;

20
extra/game/loop/loop.factor
View 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

2
extra/game/worlds/worlds.factor
View 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 ;

2
extra/gpu/demos/bunny/bunny.factor
View File

@ -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 ;

2
extra/gpu/demos/raytrace/raytrace.factor
View 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 ( -- )

4
extra/jamshred/player/player.factor
View 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] ;

28
extra/space-invaders/space-invaders.factor
View File

@ -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 -- )

2
extra/terrain/terrain.factor
View 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

6
extra/tetris/game/game.factor
View 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 -- )