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

Replace millis primitive with micros primitive 

Add millis as a library word
sleep now takes either a duration or a microsecond count; code using durations doens't need to be updated, code using millisecond counts updated to use durations for the most part
db4
Slava Pestov 2008-11-19 01:50:05 -06:00
parent 306e123621
commit 8819f23312
59 changed files with 155 additions and 132 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
basis/bootstrap/stage2.factor
View File

@ -32,8 +32,8 @@ SYMBOL: bootstrap-time
: count-words ( pred -- )
all-words swap count number>string write ;
: print-time ( time -- )
1000 /i
: print-time ( us -- )
1000000 /i
60 /mod swap
number>string write
" minutes and " write number>string write " seconds." print ;
@ -52,7 +52,7 @@ SYMBOL: bootstrap-time
[
! We time bootstrap
millis
micros
default-image-name "output-image" set-global
@ -77,7 +77,7 @@ SYMBOL: bootstrap-time
[
load-components
millis over - core-bootstrap-time set-global
micros over - core-bootstrap-time set-global
run-bootstrap-init
] with-compiler-errors
@ -100,7 +100,7 @@ SYMBOL: bootstrap-time
] [ print-error 1 exit ] recover
] set-boot-quot
millis swap - bootstrap-time set-global
micros swap - bootstrap-time set-global
print-report
"output-image" get save-image-and-exit

6
basis/calendar/calendar-docs.factor
View File

@ -365,12 +365,12 @@ HELP: unix-1970
{ $values { "timestamp" timestamp } }
{ $description "Outputs the beginning of UNIX time, or midnight, January 1, 1970." } ;
HELP: millis>timestamp
HELP: micros>timestamp
{ $values { "x" number } { "timestamp" timestamp } }
{ $description "Converts a number of milliseconds into a timestamp value in GMT time." }
{ $description "Converts a number of microseconds into a timestamp value in GMT time." }
{ $examples
{ $example "USING: accessors calendar prettyprint ;"
"1000 millis>timestamp year>> ."
"1000 micros>timestamp year>> ."
"1970"
}
} ;

8
basis/calendar/calendar-tests.factor
View File

@ -143,10 +143,10 @@ 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>millis millis - 1000 < ] unit-test
[ t ] [ 0 millis>timestamp unix-1970 = ] unit-test
[ t ] [ 123456789000 [ millis>timestamp timestamp>millis ] keep = ] unit-test
[ t ] [ 123456789123456 [ millis>timestamp timestamp>millis ] keep = ] unit-test
[ t ] [ now timestamp>micros 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
: checktime+ now dup clone [ rot time+ drop ] keep = ;

10
basis/calendar/calendar.factor
View File

@ -325,9 +325,15 @@ M: duration time-
: timestamp>millis ( timestamp -- n )
unix-1970 (time-) 1000 * >integer ;
: micros>timestamp ( x -- timestamp )
>r unix-1970 r> microseconds time+ ;
: timestamp>micros ( timestamp -- n )
unix-1970 (time-) 1000000 * >integer ;
: gmt ( -- timestamp )
#! GMT time, right now
unix-1970 millis milliseconds time+ ;
unix-1970 micros microseconds time+ ;
: now ( -- timestamp ) gmt >local-time ;
: hence ( duration -- timestamp ) now swap time+ ;
@ -404,7 +410,7 @@ PRIVATE>
: since-1970 ( duration -- timestamp )
unix-1970 time+ >local-time ;
M: timestamp sleep-until timestamp>millis sleep-until ;
M: timestamp sleep-until timestamp>micros sleep-until ;
M: duration sleep hence sleep-until ;

2
basis/calendar/model/model.factor
View File

@ -7,7 +7,7 @@ SYMBOL: time
: (time-thread) ( -- )
now time get set-model
1000 sleep (time-thread) ;
1 seconds sleep (time-thread) ;
: time-thread ( -- )
[

2
basis/compiler/tests/alien.factor
View File

@ -361,7 +361,7 @@ FUNCTION: ulonglong ffi_test_38 ( ulonglong x, ulonglong y ) ;
[ 1 2 3 ] [ callback-6 callback_test_1 1 2 3 ] unit-test
: callback-7 ( -- callback )
"void" { } "cdecl" [ 1000 sleep ] alien-callback ;
"void" { } "cdecl" [ 1000000 sleep ] alien-callback ;
[ 1 2 3 ] [ callback-7 callback_test_1 1 2 3 ] unit-test

2
basis/concurrency/combinators/combinators-tests.factor
View File

@ -10,7 +10,7 @@ concurrency.mailboxes threads sequences accessors arrays ;
[ { 1 4 9 } ] [ { 1 2 3 } [ sq ] parallel-map ] unit-test
[ { 1 4 9 } ] [ { 1 2 3 } [ 1000 random sleep sq ] parallel-map ] unit-test
[ { 1 4 9 } ] [ { 1 2 3 } [ 1000000 random sleep sq ] parallel-map ] unit-test
[ { 1 2 3 } [ dup 2 mod 0 = [ "Even" throw ] when ] parallel-map ]
[ error>> "Even" = ] must-fail-with

8
basis/concurrency/flags/flags-tests.factor
View File

@ -1,6 +1,6 @@
IN: concurrency.flags.tests
USING: tools.test concurrency.flags concurrency.combinators
kernel threads locals accessors ;
kernel threads locals accessors calendar ;
:: flag-test-1 ( -- )
[let | f [ <flag> ] |
@ -13,7 +13,7 @@ kernel threads locals accessors ;
:: flag-test-2 ( -- )
[let | f [ <flag> ] |
[ 1000 sleep f raise-flag ] "Flag test" spawn drop
[ 1 seconds sleep f raise-flag ] "Flag test" spawn drop
f lower-flag
f value>>
] ;
@ -39,7 +39,7 @@ kernel threads locals accessors ;
:: flag-test-5 ( -- )
[let | f [ <flag> ] |
[ 1000 sleep f raise-flag ] "Flag test" spawn drop
[ 1 seconds sleep f raise-flag ] "Flag test" spawn drop
f wait-for-flag
f value>>
] ;
@ -48,6 +48,6 @@ kernel threads locals accessors ;
[ ] [
{ 1 2 } <flag>
[ [ 1000 sleep raise-flag ] curry "Flag test" spawn drop ]
[ [ 1 seconds sleep raise-flag ] curry "Flag test" spawn drop ]
[ [ wait-for-flag drop ] curry parallel-each ] bi
] unit-test

6
basis/concurrency/futures/futures-docs.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2005, 2008 Chris Double, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: concurrency.promises concurrency.messaging kernel arrays
continuations help.markup help.syntax quotations ;
continuations help.markup help.syntax quotations calendar ;
IN: concurrency.futures
HELP: future
@ -11,8 +11,8 @@ $nl
"The quotation begins with an empty data stack, an empty catch stack, and a name stack containing the global namespace only. This means that the only way to pass data to the quotation is to partially apply the data, for example using " { $link curry } " or " { $link compose } "." } ;
HELP: ?future-timeout
{ $values { "future" future } { "timeout" "a timeout in milliseconds or " { $link f } } { "value" object } }
{ $description "Waits for a deferred computation to complete, blocking indefinitely if " { $snippet "timeout" } " is " { $link f } ", otherwise waiting up to " { $snippet "timeout" } " milliseconds." }
{ $values { "future" future } { "timeout" { $maybe duration } } { "value" object } }
{ $description "Waits for a deferred computation to complete, blocking indefinitely if " { $snippet "timeout" } " is " { $link f } ", otherwise waiting up to the " { $snippet "timeout" } " before throwing an error." }
{ $errors "Throws an error if the timeout expires before the computation completes. Also throws an error if the future quotation threw an error." } ;
HELP: ?future

4
basis/concurrency/locks/locks-tests.factor
View File

@ -100,7 +100,7 @@ threads sequences calendar accessors ;
c await
l [
4 v push
1000 sleep
1 seconds sleep
5 v push
] with-write-lock
c'' count-down
@ -139,7 +139,7 @@ threads sequences calendar accessors ;
l [
1 v push
c count-down
1000 sleep
1 seconds sleep
2 v push
] with-write-lock
c' count-down

2
basis/concurrency/promises/promises-docs.factor
View File

@ -13,7 +13,7 @@ HELP: promise-fulfilled?
HELP: ?promise-timeout
{ $values { "promise" promise } { "timeout" { $maybe duration } } { "result" object } }
{ $description "Waits for another thread to fulfill a promise, returning immediately if the promise has already been fulfilled. A timeout of " { $link f } " indicates that the thread may block indefinitely, otherwise it will wait up to " { $snippet "timeout" } " milliseconds." }
{ $description "Waits for another thread to fulfill a promise, returning immediately if the promise has already been fulfilled. A timeout of " { $link f } " indicates that the thread may block indefinitely, otherwise it will wait up to the " { $snippet "timeout" } " before throwing an error." }
{ $errors "Throws an error if the timeout expires before the promise has been fulfilled." } ;
HELP: ?promise

4
basis/core-foundation/run-loop/run-loop.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax kernel threads init namespaces alien
core-foundation ;
core-foundation calendar ;
IN: core-foundation.run-loop
: kCFRunLoopRunFinished 1 ; inline
@ -30,7 +30,7 @@ FUNCTION: SInt32 CFRunLoopRunInMode (
: run-loop-thread ( -- )
CFRunLoopDefaultMode 0 f CFRunLoopRunInMode
kCFRunLoopRunHandledSource = [ 1000 sleep ] unless
kCFRunLoopRunHandledSource = [ 1 seconds sleep ] unless
run-loop-thread ;
: start-run-loop-thread ( -- )

5
basis/io/launcher/launcher.factor
View File

@ -4,7 +4,8 @@ USING: system kernel namespaces strings hashtables sequences
assocs combinators vocabs.loader init threads continuations
math accessors concurrency.flags destructors environment
io io.backend io.timeouts io.pipes io.pipes.private io.encodings
io.streams.duplex io.ports debugger prettyprint summary ;
io.streams.duplex io.ports debugger prettyprint summary
calendar ;
IN: io.launcher
TUPLE: process < identity-tuple
@ -65,7 +66,7 @@ SYMBOL: wait-flag
: wait-loop ( -- )
processes get assoc-empty?
[ wait-flag get-global lower-flag ]
[ wait-for-processes [ 100 sleep ] when ] if ;
[ wait-for-processes [ 100 milliseconds sleep ] when ] if ;
: start-wait-thread ( -- )
<flag> wait-flag set-global

2
basis/io/unix/files/files.factor
View File

@ -290,7 +290,7 @@ M: string other-execute? ( path -- ? ) OTHER-EXECUTE file-mode? ;
dup length [ over [ pick set-timeval-nth ] [ 2drop ] if ] 2each ;
: timestamp>timeval ( timestamp -- timeval )
unix-1970 time- duration>milliseconds make-timeval ;
unix-1970 time- duration>microseconds make-timeval ;
: timestamps>byte-array ( timestamps -- byte-array )
[ dup [ timestamp>timeval ] when ] map make-timeval-array ;

2
basis/io/unix/kqueue/kqueue.factor
View File

@ -94,7 +94,7 @@ M: kqueue-mx unregister-io-task ( task mx -- )
: handle-kevents ( mx n -- )
[ over events>> kevent-nth handle-kevent ] with each ;
M: kqueue-mx wait-for-events ( ms mx -- )
M: kqueue-mx wait-for-events ( us mx -- )
swap dup [ make-timespec ] when
dupd wait-kevent handle-kevents ;

4
basis/io/unix/select/select.factor
View File

@ -48,9 +48,9 @@ TUPLE: select-mx < mx read-fdset write-fdset ;
[ write-fdset/tasks [ init-fdset ] [ underlying>> ] bi ] tri
f ;
M:: select-mx wait-for-events ( ms mx -- )
M:: select-mx wait-for-events ( us mx -- )
mx
[ init-fdsets ms dup [ make-timeval ] when select multiplexer-error ]
[ init-fdsets us dup [ make-timeval ] when select multiplexer-error ]
[ [ read-fdset/tasks ] keep [ input-available ] check-fdset ]
[ [ write-fdset/tasks ] keep [ output-available ] check-fdset ]
tri ;

2
basis/io/windows/nt/pipes/pipes.factor
View File

@ -35,7 +35,7 @@ IN: io.windows.nt.pipes
"-" %
32 random-bits #
"-" %
millis #
micros #
] "" make ;
M: winnt (pipe) ( -- pipe )

2
basis/smtp/smtp.factor
View File

@ -145,7 +145,7 @@ ERROR: invalid-header-string string ;
"<" %
64 random-bits #
"-" %
millis #
micros #
"@" %
smtp-domain get [ host-name ] unless* %
">" %

4
basis/stack-checker/known-words/known-words.factor
View File

@ -423,8 +423,8 @@ do-primitive alien-invoke alien-indirect alien-callback
\ code-room { } { integer integer integer integer } define-primitive
\ code-room make-flushable
\ millis { } { integer } define-primitive
\ millis make-flushable
\ micros { } { integer } define-primitive
\ micros make-flushable
\ tag { object } { fixnum } define-primitive
\ tag make-foldable

5
basis/stack-checker/stack-checker.factor
View File

@ -24,4 +24,7 @@ M: callable infer ( quot -- effect )
: forget-effects ( -- )
forget-errors
all-words [ f "inferred-effect" set-word-prop ] each ;
all-words [
dup subwords [ f "inferred-effect" set-word-prop ] each
f "inferred-effect" set-word-prop
] each ;

2
basis/threads/threads-docs.factor
View File

@ -100,7 +100,7 @@ HELP: sleep-queue
{ $var-description "A " { $link min-heap } " storing the queue of sleeping threads." } ;
HELP: sleep-time
{ $values { "ms/f" "a non-negative integer or " { $link f } } }
{ $values { "us/f" "a non-negative integer or " { $link f } } }
{ $description "Outputs the time until the next sleeping thread is scheduled to wake up, which could be zero if there are threads in the run queue, or threads which need to wake up right now. If there are no runnable or sleeping threads, outputs " { $link f } "." } ;
HELP: stop

6
basis/threads/threads.factor
View File

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

2
basis/tools/deploy/test/1/1.factor
View File

@ -1,6 +1,6 @@
IN: tools.deploy.test.1
USING: threads ;
: deploy-test-1 ( -- ) 1000 sleep ;
: deploy-test-1 ( -- ) 1000000 sleep ;
MAIN: deploy-test-1

2
basis/tools/profiler/profiler-tests.factor
View File

@ -11,7 +11,7 @@ words ;
[ ] [ [ 10 [ gc ] times ] profile ] unit-test
[ ] [ [ 1000 sleep ] profile ] unit-test
[ ] [ [ 1000000 sleep ] profile ] unit-test
[ ] [ profile. ] unit-test

4
basis/tools/threads/threads.factor
View File

@ -14,8 +14,8 @@ IN: tools.threads
] with-cell
[
sleep-entry>> [
key>> millis [-] number>string write
" ms" write
key>> micros [-] number>string write
" us" write
] when*
] with-cell ;

6
basis/tools/time/time-docs.factor
View File

@ -7,7 +7,7 @@ ARTICLE: "timing" "Timing code"
"A lower-level word puts timings on the stack, intead of printing:"
{ $subsection benchmark }
"You can also read the system clock and garbage collection statistics directly:"
{ $subsection millis }
{ $subsection micros }
{ $subsection gc-stats }
{ $see-also "profiling" } ;
@ -15,7 +15,7 @@ ABOUT: "timing"
HELP: benchmark
{ $values { "quot" "a quotation" }
{ "runtime" "an integer denoting milliseconds" } }
{ "runtime" "the runtime in microseconds" } }
{ $description "Runs a quotation, measuring the total wall clock time." }
{ $notes "A nicer word for interactive use is " { $link time } "." } ;
@ -23,4 +23,4 @@ HELP: time
{ $values { "quot" "a quotation" } }
{ $description "Runs a quotation and then prints the total run time and some garbage collection statistics." } ;
{ benchmark millis time } related-words
{ benchmark micros time } related-words

12
basis/tools/time/time.factor
View File

@ -5,20 +5,20 @@ namespaces system sequences splitting grouping assocs strings ;
IN: tools.time
: benchmark ( quot -- runtime )
millis >r call millis r> - ; inline
micros >r call micros r> - ; inline
: time. ( data -- )
unclip
"==== RUNNING TIME" print nl pprint " ms" print nl
"==== RUNNING TIME" print nl pprint " us" print nl
4 cut*
"==== GARBAGE COLLECTION" print nl
[
6 group
{
"GC count:"
"Cumulative GC time (ms):"
"Longest GC pause (ms):"
"Average GC pause (ms):"
"Cumulative GC time (us):"
"Longest GC pause (us):"
"Average GC pause (us):"
"Objects copied:"
"Bytes copied:"
} prefix
@ -37,4 +37,4 @@ IN: tools.time
] bi* ;
: time ( quot -- )
gc-reset millis >r call gc-stats millis r> - prefix time. ; inline
gc-reset micros >r call gc-stats micros r> - prefix time. ; inline

2
basis/ui/gestures/gestures-docs.factor
View File

@ -147,7 +147,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 millis } "." } ;
{ $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 micros } "." } ;
HELP: hand-buttons
{ $var-description "Global variable. A vector of mouse buttons currently held down." } ;

6
basis/ui/gestures/gestures.factor
View File

@ -94,7 +94,7 @@ SYMBOL: scroll-direction
{ 0 0 } scroll-direction set-global
SYMBOL: double-click-timeout
300 double-click-timeout set-global
300 milliseconds double-click-timeout set-global
: hand-moved? ( -- ? )
hand-loc get hand-click-loc get = not ;
@ -182,7 +182,7 @@ SYMBOL: drag-timer
hand-click-loc get-global swap screen-loc v- ;
: multi-click-timeout? ( -- ? )
millis hand-last-time get - double-click-timeout get <= ;
now hand-last-time get time- double-click-timeout get before=? ;
: multi-click-button? ( button -- button ? )
dup hand-last-button get = ;
@ -207,7 +207,7 @@ SYMBOL: drag-timer
1 hand-click# set
] if
hand-last-button set
millis hand-last-time set
now hand-last-time set
] bind ;
: update-clicked ( -- )

8
basis/ui/tools/interactor/interactor-tests.factor
View File

@ -38,7 +38,7 @@ tools.test kernel calendar parser accessors calendar io ;
[ ] [ [ "interactor" get stream-read-quot drop ] "B" spawn drop ] unit-test
[ ] [ 1000 sleep ] unit-test
[ ] [ 1 seconds sleep ] unit-test
[ ] [ "interactor" get interactor-eof ] unit-test
@ -57,11 +57,11 @@ tools.test kernel calendar parser accessors calendar io ;
] in-thread
] unit-test
[ ] [ 100 sleep ] unit-test
[ ] [ 100 milliseconds sleep ] unit-test
[ ] [ "interactor" get evaluate-input ] unit-test
[ ] [ 100 sleep ] unit-test
[ ] [ 100 milliseconds sleep ] unit-test
[ ] [ "interactor" get interactor-eof ] unit-test
@ -80,7 +80,7 @@ tools.test kernel calendar parser accessors calendar io ;
] in-thread
] unit-test
[ ] [ 100 sleep ] unit-test
[ ] [ 100 milliseconds sleep ] unit-test
[ ] [ "interactor" get evaluate-input ] unit-test

5
basis/ui/tools/listener/listener-tests.factor
View File

@ -2,7 +2,8 @@ USING: continuations documents ui.tools.interactor
ui.tools.listener hashtables kernel namespaces parser sequences
tools.test ui.commands ui.gadgets ui.gadgets.editors
ui.gadgets.panes vocabs words tools.test.ui slots.private
threads arrays generic threads accessors listener math ;
threads arrays generic threads accessors listener math
calendar ;
IN: ui.tools.listener.tests
[ f ] [ "word" source-editor command-map commands>> empty? ] unit-test
@ -47,7 +48,7 @@ IN: ui.tools.listener.tests
[ ] [ "listener" get restart-listener ] unit-test
[ ] [ 1000 sleep ] unit-test
[ ] [ 1 seconds sleep ] unit-test
[ ] [ "listener" get com-end ] unit-test
] with-grafted-gadget

6
basis/ui/tools/search/search-tests.factor
View File

@ -1,7 +1,7 @@
USING: assocs ui.tools.search help.topics io.files io.styles
kernel namespaces sequences source-files threads
tools.test ui.gadgets ui.gestures vocabs accessors
vocabs.loader words tools.test.ui debugger ;
vocabs.loader words tools.test.ui debugger calendar ;
IN: ui.tools.search.tests
[ f ] [
@ -14,7 +14,7 @@ IN: ui.tools.search.tests
: update-live-search ( search -- seq )
dup [
300 sleep
300 milliseconds sleep
list>> control-value
] with-grafted-gadget ;
@ -30,7 +30,7 @@ IN: ui.tools.search.tests
"" all-words t <definition-search>
dup [
{ "set-word-prop" } over field>> set-control-value
300 sleep
300 milliseconds sleep
search-value \ set-word-prop eq?
] with-grafted-gadget
] unit-test

6
basis/ui/ui.factor
View File

@ -1,10 +1,10 @@
! Copyright (C) 2006, 2007 Slava Pestov.
! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs io kernel math models namespaces make
prettyprint dlists deques sequences threads sequences words
debugger ui.gadgets ui.gadgets.worlds ui.gadgets.tracks
ui.gestures ui.backend ui.render continuations init combinators
hashtables concurrency.flags sets accessors ;
hashtables concurrency.flags sets accessors calendar ;
IN: ui
! Assoc mapping aliens to gadgets
@ -142,7 +142,7 @@ SYMBOL: ui-hook
[ notify-queued layout-queued redraw-worlds ] assert-depth ;
: ui-wait ( -- )
10 sleep ;
10 milliseconds sleep ;
: ui-try ( quot -- ) [ ui-error ] recover ;

8
basis/unix/time/time.factor
View File

@ -11,14 +11,14 @@ C-STRUCT: timespec
{ "time_t" "sec" }
{ "long" "nsec" } ;
: make-timeval ( ms -- timeval )
1000 /mod 1000 *
: make-timeval ( us -- timeval )
1000000 /mod
"timeval" <c-object>
[ set-timeval-usec ] keep
[ set-timeval-sec ] keep ;
: make-timespec ( ms -- timespec )
1000 /mod 1000000 *
: make-timespec ( us -- timespec )
1000000 /mod 1000 *
"timespec" <c-object>
[ set-timespec-nsec ] keep
[ set-timespec-sec ] keep ;

4
core/alien/alien-docs.factor
View File

@ -281,8 +281,8 @@ $nl
"Gives all Factor threads a chance to run."
} }
{ {
{ $code "void factor_sleep(long ms)" }
"Gives all Factor threads a chance to run for " { $snippet "ms" } " milliseconds."
{ $code "void factor_sleep(long us)" }
"Gives all Factor threads a chance to run for " { $snippet "us" } " microseconds."
} }
} ;

2
core/bootstrap/primitives.factor
View File

@ -443,7 +443,7 @@ tuple
{ "exit" "system" }
{ "data-room" "memory" }
{ "code-room" "memory" }
{ "millis" "system" }
{ "micros" "system" }
{ "modify-code-heap" "compiler.units" }
{ "dlopen" "alien" }
{ "dlsym" "alien" }

4
core/io/backend/backend-docs.factor
View File

@ -2,8 +2,8 @@ USING: help.markup help.syntax io io.backend strings
byte-arrays ;
HELP: io-multiplex
{ $values { "ms" "a non-negative integer" } }
{ $contract "Waits up to " { $snippet "ms" } " milliseconds for pending I/O requests to complete." } ;
{ $values { "us" "a non-negative integer" } }
{ $contract "Waits up to " { $snippet "us" } " microseconds for pending I/O requests to complete." } ;
HELP: init-io
{ $contract "Initializes the I/O system. Called on startup." } ;

2
core/io/streams/c/c.factor
View File

@ -67,7 +67,7 @@ M: c-io-backend init-io ;
M: c-io-backend (init-stdio) init-c-stdio ;
M: c-io-backend io-multiplex 60 60 * 1000 * or (sleep) ;
M: c-io-backend io-multiplex 60 60 * 1000 * 1000 * or (sleep) ;
M: c-io-backend (file-reader)
"rb" fopen <c-reader> ;

11
core/system/system-docs.factor
View File

@ -11,7 +11,7 @@ ARTICLE: "system" "System interface"
{ $subsection vm }
{ $subsection image }
"Getting the current time:"
{ $subsection millis }
{ $subsection micros }
"Exiting the Factor VM:"
{ $subsection exit } ;
@ -64,8 +64,13 @@ HELP: exit ( n -- )
{ $values { "n" "an integer exit code" } }
{ $description "Exits the Factor process." } ;
HELP: millis ( -- n )
{ $values { "n" integer } }
HELP: micros ( -- us )
{ $values { "us" integer } }
{ $description "Outputs the number of microseconds ellapsed 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: millis ( -- ms )
{ $values { "us" integer } }
{ $description "Outputs the number of milliseconds ellapsed 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." } ;

2
core/system/system.factor
View File

@ -65,3 +65,5 @@ PRIVATE>
] "system" add-init-hook
: embedded? ( -- ? ) 15 getenv ;
: millis ( -- ms ) micros 1000 /i ;

4
extra/crypto/timing/timing.factor
View File

@ -1,6 +1,6 @@
USING: kernel math threads system ;
USING: kernel math threads system calendar ;
IN: crypto.timing
: with-timing ( quot n -- )
#! force the quotation to execute in, at minimum, n milliseconds
millis 2slip millis - + sleep ; inline
millis 2slip millis - + milliseconds sleep ; inline

2
extra/jamshred/jamshred.factor
View File

@ -23,7 +23,7 @@ M: jamshred-gadget draw-gadget* ( gadget -- )
] [
[ jamshred>> jamshred-update ]
[ relayout-1 ]
[ 10 sleep yield jamshred-loop ] tri
[ 10 milliseconds sleep yield jamshred-loop ] tri
] if ;
: fullscreen ( gadget -- )

13
extra/mason/test/test.factor
View File

@ -40,14 +40,17 @@ M: method-body word-vocabulary "method-generic" word-prop word-vocabulary ;
: do-benchmarks ( -- )
run-benchmarks benchmarks-file to-file ;
: benchmark-ms ( quot -- ms )
benchmark 1000 /i ; inline
: do-all ( -- )
".." [
bootstrap-time get boot-time-file to-file
[ do-load do-compile-errors ] benchmark load-time-file to-file
[ generate-help ] benchmark html-help-time-file to-file
[ do-tests ] benchmark test-time-file to-file
[ do-help-lint ] benchmark help-lint-time-file to-file
[ do-benchmarks ] benchmark benchmark-time-file to-file
[ do-load do-compile-errors ] benchmark-ms load-time-file to-file
[ generate-help ] html-help-time-file to-file
[ do-tests ] benchmark-ms test-time-file to-file
[ do-help-lint ] benchmark-ms help-lint-time-file to-file
[ do-benchmarks ] benchmark-ms benchmark-time-file to-file
] with-directory ;
MAIN: do-all

5
extra/nehe/4/4.factor
View File

@ -1,12 +1,13 @@
USING: arrays kernel math opengl opengl.gl opengl.glu
opengl.demo-support ui ui.gadgets ui.render threads accessors ;
opengl.demo-support ui ui.gadgets ui.render threads accessors
calendar ;
IN: nehe.4
TUPLE: nehe4-gadget < gadget rtri rquad thread quit? ;
: width 256 ;
: height 256 ;
: redraw-interval 10 ;
: redraw-interval 10 milliseconds ;
: <nehe4-gadget> ( -- gadget )
nehe4-gadget new-gadget

5
extra/nehe/5/5.factor
View File

@ -1,11 +1,12 @@
USING: arrays kernel math opengl opengl.gl opengl.glu
opengl.demo-support ui ui.gadgets ui.render threads accessors ;
opengl.demo-support ui ui.gadgets ui.render threads accessors
calendar ;
IN: nehe.5
TUPLE: nehe5-gadget < gadget rtri rquad thread quit? ;
: width 256 ;
: height 256 ;
: redraw-interval 10 ;
: redraw-interval 10 milliseconds ;
: <nehe5-gadget> ( -- gadget )
nehe5-gadget new-gadget

6
extra/openal/example/example.factor
View File

@ -2,17 +2,17 @@
! See http://factorcode.org/license.txt for BSD license.
!
IN: openal.example
USING: openal kernel alien threads sequences ;
USING: openal kernel alien threads sequences calendar ;
: play-hello ( -- )
init-openal
1 gen-sources
first dup AL_BUFFER alutCreateBufferHelloWorld set-source-param
source-play
1000 sleep ;
1000 milliseconds sleep ;
: (play-file) ( source -- )
100 sleep
100 milliseconds sleep
dup source-playing? [ (play-file) ] [ drop ] if ;
: play-file ( filename -- )

12
vm/data_gc.c
View File

@ -793,7 +793,7 @@ void garbage_collection(CELL gen,
return;
}
s64 start = current_millis();
s64 start = current_micros();
performing_gc = true;
growing_data_heap = growing_data_heap_;
@ -860,7 +860,7 @@ void garbage_collection(CELL gen,
while(scan < newspace->here)
scan = collect_next(scan);
CELL gc_elapsed = (current_millis() - start);
CELL gc_elapsed = (current_micros() - start);
end_gc(gc_elapsed);
@ -887,14 +887,14 @@ void primitive_gc_stats(void)
GROWABLE_ARRAY(stats);
CELL i;
CELL total_gc_time = 0;
u64 total_gc_time = 0;
for(i = 0; i < MAX_GEN_COUNT; i++)
{
F_GC_STATS *s = &gc_stats[i];
GROWABLE_ARRAY_ADD(stats,allot_cell(s->collections));
GROWABLE_ARRAY_ADD(stats,allot_cell(s->gc_time));
GROWABLE_ARRAY_ADD(stats,allot_cell(s->max_gc_time));
GROWABLE_ARRAY_ADD(stats,tag_bignum(long_long_to_bignum(s->gc_time)));
GROWABLE_ARRAY_ADD(stats,tag_bignum(long_long_to_bignum(s->max_gc_time)));
GROWABLE_ARRAY_ADD(stats,allot_cell(s->collections == 0 ? 0 : s->gc_time / s->collections));
GROWABLE_ARRAY_ADD(stats,allot_cell(s->object_count));
GROWABLE_ARRAY_ADD(stats,tag_bignum(long_long_to_bignum(s->bytes_copied)));
@ -902,7 +902,7 @@ void primitive_gc_stats(void)
total_gc_time += s->gc_time;
}
GROWABLE_ARRAY_ADD(stats,allot_cell(total_gc_time));
GROWABLE_ARRAY_ADD(stats,tag_bignum(long_long_to_bignum(total_gc_time)));
GROWABLE_ARRAY_ADD(stats,tag_bignum(long_long_to_bignum(cards_scanned)));
GROWABLE_ARRAY_ADD(stats,tag_bignum(long_long_to_bignum(decks_scanned)));
GROWABLE_ARRAY_ADD(stats,allot_cell(code_heap_scans));

4
vm/data_gc.h
View File

@ -161,8 +161,8 @@ void init_data_heap(CELL gens,
/* statistics */
typedef struct {
CELL collections;
CELL gc_time;
CELL max_gc_time;
u64 gc_time;
u64 max_gc_time;
CELL object_count;
u64 bytes_copied;
} F_GC_STATS;

6
vm/factor.c
View File

@ -91,7 +91,7 @@ void init_factor(F_PARAMETERS *p)
if(p->image == NULL)
p->image = default_image_path();
srand(current_millis());
srand(current_micros());
init_ffi();
init_stacks(p->ds_size,p->rs_size);
load_image(p);
@ -216,8 +216,8 @@ void factor_yield(void)
callback();
}
void factor_sleep(long ms)
void factor_sleep(long us)
{
void (*callback)() = alien_offset(userenv[SLEEP_CALLBACK_ENV]);
callback(ms);
callback(us);
}

8
vm/os-unix.c
View File

@ -16,16 +16,16 @@ void start_thread(void *(*start_routine)(void *))
static void *null_dll;
s64 current_millis(void)
s64 current_micros(void)
{
struct timeval t;
gettimeofday(&t,NULL);
return (s64)t.tv_sec * 1000 + t.tv_usec / 1000;
return (s64)t.tv_sec * 1000000 + t.tv_usec;
}
void sleep_millis(CELL msec)
void sleep_micros(CELL usec)
{
usleep(msec * 1000);
usleep(usec);
}
void init_ffi(void)

4
vm/os-unix.h
View File

@ -50,7 +50,7 @@ void unix_init_signals(void);
void signal_handler(int signal, siginfo_t* siginfo, void* uap);
void dump_stack_signal(int signal, siginfo_t* siginfo, void* uap);
s64 current_millis(void);
void sleep_millis(CELL msec);
s64 current_micros(void);
void sleep_micros(CELL usec);
void open_console(void);

4
vm/os-windows-ce.c
View File

@ -1,13 +1,13 @@
#include "master.h"
s64 current_millis(void)
s64 current_micros(void)
{
SYSTEMTIME st;
FILETIME ft;
GetSystemTime(&st);
SystemTimeToFileTime(&st, &ft);
return (((s64)ft.dwLowDateTime
| (s64)ft.dwHighDateTime<<32) - EPOCH_OFFSET) / 10000;
| (s64)ft.dwHighDateTime<<32) - EPOCH_OFFSET) / 10;
}
char *strerror(int err)

2
vm/os-windows-ce.h
View File

@ -22,6 +22,6 @@ char *getenv(char *name);
#define snprintf _snprintf
#define snwprintf _snwprintf
s64 current_millis(void);
s64 current_micros(void);
void c_to_factor_toplevel(CELL quot);
void open_console(void);

4
vm/os-windows-nt.c
View File

@ -1,11 +1,11 @@
#include "master.h"
s64 current_millis(void)
s64 current_micros(void)
{
FILETIME t;
GetSystemTimeAsFileTime(&t);
return (((s64)t.dwLowDateTime | (s64)t.dwHighDateTime<<32)
- EPOCH_OFFSET) / 10000;
- EPOCH_OFFSET) / 10;
}
long exception_handler(PEXCEPTION_POINTERS pe)

4
vm/os-windows.c
View File

@ -166,7 +166,7 @@ long getpagesize(void)
return g_pagesize;
}
void sleep_millis(DWORD msec)
void sleep_micros(DWORD usec)
{
Sleep(msec);
Sleep(msec / 1000);
}

4
vm/os-windows.h
View File

@ -49,7 +49,7 @@ void ffi_dlopen(F_DLL *dll);
void *ffi_dlsym(F_DLL *dll, F_SYMBOL *symbol);
void ffi_dlclose(F_DLL *dll);
void sleep_millis(DWORD msec);
void sleep_micros(DWORD msec);
INLINE void init_signals(void) {}
INLINE void early_init(void) {}
@ -57,5 +57,5 @@ const F_CHAR *vm_executable_path(void);
const F_CHAR *default_image_path(void);
long getpagesize (void);
s64 current_millis(void);
s64 current_micros(void);

2
vm/primitives.c
View File

@ -68,7 +68,7 @@ void *primitives[] = {
primitive_exit,
primitive_data_room,
primitive_code_room,
primitive_millis,
primitive_micros,
primitive_modify_code_heap,
primitive_dlopen,
primitive_dlsym,

6
vm/run.c
View File

@ -153,14 +153,14 @@ void primitive_exit(void)
exit(to_fixnum(dpop()));
}
void primitive_millis(void)
void primitive_micros(void)
{
box_unsigned_8(current_millis());
box_unsigned_8(current_micros());
}
void primitive_sleep(void)
{
sleep_millis(to_cell(dpop()));
sleep_micros(to_cell(dpop()));
}
void primitive_set_slot(void)

2
vm/run.h
View File

@ -236,7 +236,7 @@ void primitive_os_envs(void);
void primitive_set_os_env(void);
void primitive_unset_os_env(void);
void primitive_set_os_envs(void);
void primitive_millis(void);
void primitive_micros(void);
void primitive_sleep(void);
void primitive_set_slot(void);