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

use nano-count instead of monotonic counters, dont allow sleeping for 

timestamps
db4
Doug Coleman 2009-11-18 16:20:29 -06:00
parent 6f7ec206a1
commit 070393df70
3 changed files with 10 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
basis/alarms/alarms.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs boxes calendar USING: accessors assocs boxes calendar
combinators.short-circuit fry heaps init kernel math.order combinators.short-circuit fry heaps init kernel math.order
namespaces quotations threads math monotonic-clock ; namespaces quotations threads math system ;
IN: alarms IN: alarms
TUPLE: alarm TUPLE: alarm
@ -25,7 +25,7 @@ SYMBOL: alarm-thread
: <alarm> ( quot start interval -- alarm ) : <alarm> ( quot start interval -- alarm )
alarm new alarm new
swap dup [ normalize-argument ] when >>interval swap dup [ normalize-argument ] when >>interval
swap dup [ normalize-argument monotonic-count + ] when >>start swap dup [ normalize-argument nano-count + ] when >>start
swap >>quot swap >>quot
<box> >>entry ; <box> >>entry ;
@ -38,7 +38,7 @@ SYMBOL: alarm-thread
[ start>> ] dip <= ; [ start>> ] dip <= ;
: reschedule-alarm ( alarm -- ) : reschedule-alarm ( alarm -- )
dup interval>> monotonic-count + >>start register-alarm ; dup interval>> nano-count + >>start register-alarm ;
: call-alarm ( alarm -- ) : call-alarm ( alarm -- )
[ entry>> box> drop ] [ entry>> box> drop ]
@ -57,13 +57,12 @@ SYMBOL: alarm-thread
] if ; ] if ;
: trigger-alarms ( alarms -- ) : trigger-alarms ( alarms -- )
monotonic-count (trigger-alarms) ; nano-count (trigger-alarms) ;
: next-alarm ( alarms -- timestamp/f ) : next-alarm ( alarms -- timestamp/f )
dup heap-empty? [ drop f ] [ dup heap-empty? [ drop f ] [
heap-peek drop start>> heap-peek drop start>>
monotonic-count swap - nano-count swap -
nanoseconds hence
] if ; ] if ;
: alarm-thread-loop ( -- ) : alarm-thread-loop ( -- )

4
basis/calendar/calendar.factor
View File

@ -560,9 +560,7 @@ M: integer end-of-year 12 31 <date> ;
: unix-time>timestamp ( seconds -- timestamp ) : unix-time>timestamp ( seconds -- timestamp )
seconds unix-1970 time+ ; seconds unix-1970 time+ ;
M: timestamp sleep-until timestamp>micros sleep-until ; M: duration sleep duration>nanoseconds nano-count + sleep-until ;
M: duration sleep hence sleep-until ;
{ {
{ [ os unix? ] [ "calendar.unix" ] } { [ os unix? ] [ "calendar.unix" ] }

7
basis/threads/threads.factor
View File

@ -95,7 +95,7 @@ PRIVATE>
{ {
{ [ run-queue deque-empty? not ] [ 0 ] } { [ run-queue deque-empty? not ] [ 0 ] }
{ [ sleep-queue heap-empty? ] [ f ] } { [ sleep-queue heap-empty? ] [ f ] }
[ sleep-queue heap-peek nip system-micros [-] ] [ sleep-queue heap-peek nip nano-count [-] ]
} cond ; } cond ;
DEFER: stop DEFER: stop
@ -108,7 +108,7 @@ DEFER: stop
: expire-sleep? ( heap -- ? ) : expire-sleep? ( heap -- ? )
dup heap-empty? dup heap-empty?
[ drop f ] [ heap-peek nip system-micros <= ] if ; [ drop f ] [ heap-peek nip nano-count <= ] if ;
: expire-sleep ( thread -- ) : expire-sleep ( thread -- )
f >>sleep-entry resume ; f >>sleep-entry resume ;
@ -184,7 +184,8 @@ M: f sleep-until
GENERIC: sleep ( dt -- ) GENERIC: sleep ( dt -- )
M: real sleep M: real sleep
system-micros + >integer sleep-until ; >integer 1000 *
nano-count + sleep-until ;
: interrupt ( thread -- ) : interrupt ( thread -- )
dup state>> [ dup state>> [