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.
USING: accessors assocs boxes calendar
combinators.short-circuit fry heaps init kernel math.order
namespaces quotations threads math monotonic-clock ;
namespaces quotations threads math system ;
IN: alarms
TUPLE: alarm
@ -25,7 +25,7 @@ SYMBOL: alarm-thread
: <alarm> ( quot start interval -- alarm )
alarm new
swap dup [ normalize-argument ] when >>interval
swap dup [ normalize-argument monotonic-count + ] when >>start
swap dup [ normalize-argument nano-count + ] when >>start
swap >>quot
<box> >>entry ;
@ -38,7 +38,7 @@ SYMBOL: alarm-thread
[ start>> ] dip <= ;
: reschedule-alarm ( alarm -- )
dup interval>> monotonic-count + >>start register-alarm ;
dup interval>> nano-count + >>start register-alarm ;
: call-alarm ( alarm -- )
[ entry>> box> drop ]
@ -57,13 +57,12 @@ SYMBOL: alarm-thread
] if ;
: trigger-alarms ( alarms -- )
monotonic-count (trigger-alarms) ;
nano-count (trigger-alarms) ;
: next-alarm ( alarms -- timestamp/f )
dup heap-empty? [ drop f ] [
heap-peek drop start>>
monotonic-count swap -
nanoseconds hence
nano-count swap -
] if ;
: 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 )
seconds unix-1970 time+ ;
M: timestamp sleep-until timestamp>micros sleep-until ;
M: duration sleep hence sleep-until ;
M: duration sleep duration>nanoseconds nano-count + sleep-until ;
{
{ [ os unix? ] [ "calendar.unix" ] }

7
basis/threads/threads.factor
View File

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