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 -- ) : count-words ( pred -- )
all-words swap count number>string write ; all-words swap count number>string write ;
: print-time ( time -- ) : print-time ( us -- )
1000 /i 1000000 /i
60 /mod swap 60 /mod swap
number>string write number>string write
" minutes and " write number>string write " seconds." print ; " minutes and " write number>string write " seconds." print ;
@ -52,7 +52,7 @@ SYMBOL: bootstrap-time
[ [
! We time bootstrap ! We time bootstrap
millis micros
default-image-name "output-image" set-global default-image-name "output-image" set-global
@ -77,7 +77,7 @@ SYMBOL: bootstrap-time
[ [
load-components load-components
millis over - core-bootstrap-time set-global micros over - core-bootstrap-time set-global
run-bootstrap-init run-bootstrap-init
] with-compiler-errors ] with-compiler-errors
@ -100,7 +100,7 @@ SYMBOL: bootstrap-time
] [ print-error 1 exit ] recover ] [ print-error 1 exit ] recover
] set-boot-quot ] set-boot-quot
millis swap - bootstrap-time set-global micros swap - bootstrap-time set-global
print-report print-report
"output-image" get save-image-and-exit "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 } } { $values { "timestamp" timestamp } }
{ $description "Outputs the beginning of UNIX time, or midnight, January 1, 1970." } ; { $description "Outputs the beginning of UNIX time, or midnight, January 1, 1970." } ;
HELP: millis>timestamp HELP: micros>timestamp
{ $values { "x" number } { "timestamp" 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 { $examples
{ $example "USING: accessors calendar prettyprint ;" { $example "USING: accessors calendar prettyprint ;"
"1000 millis>timestamp year>> ." "1000 micros>timestamp year>> ."
"1970" "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> [ +gt+ ] [ 2005 1 1 12 30 0 instant <timestamp>
2004 1 1 13 30 0 instant <timestamp> <=> ] unit-test 2004 1 1 13 30 0 instant <timestamp> <=> ] unit-test
[ t ] [ now timestamp>millis millis - 1000 < ] unit-test [ t ] [ now timestamp>micros micros - 1000000 < ] unit-test
[ t ] [ 0 millis>timestamp unix-1970 = ] unit-test [ t ] [ 0 micros>timestamp unix-1970 = ] unit-test
[ t ] [ 123456789000 [ millis>timestamp timestamp>millis ] keep = ] unit-test [ t ] [ 123456789000000 [ micros>timestamp timestamp>micros ] keep = ] unit-test
[ t ] [ 123456789123456 [ millis>timestamp timestamp>millis ] keep = ] unit-test [ t ] [ 123456789123456000 [ micros>timestamp timestamp>micros ] keep = ] unit-test
: checktime+ now dup clone [ rot time+ drop ] keep = ; : 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 ) : timestamp>millis ( timestamp -- n )
unix-1970 (time-) 1000 * >integer ; 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 ( -- timestamp )
#! GMT time, right now #! GMT time, right now
unix-1970 millis milliseconds time+ ; unix-1970 micros microseconds time+ ;
: now ( -- timestamp ) gmt >local-time ; : now ( -- timestamp ) gmt >local-time ;
: hence ( duration -- timestamp ) now swap time+ ; : hence ( duration -- timestamp ) now swap time+ ;
@ -404,7 +410,7 @@ PRIVATE>
: since-1970 ( duration -- timestamp ) : since-1970 ( duration -- timestamp )
unix-1970 time+ >local-time ; 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 ; M: duration sleep hence sleep-until ;

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

@ -7,7 +7,7 @@ SYMBOL: time
: (time-thread) ( -- ) : (time-thread) ( -- )
now time get set-model now time get set-model
1000 sleep (time-thread) ; 1 seconds sleep (time-thread) ;
: 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 [ 1 2 3 ] [ callback-6 callback_test_1 1 2 3 ] unit-test
: callback-7 ( -- callback ) : 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 [ 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 } [ 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 ] [ { 1 2 3 } [ dup 2 mod 0 = [ "Even" throw ] when ] parallel-map ]
[ error>> "Even" = ] must-fail-with [ error>> "Even" = ] must-fail-with

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

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

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

@ -1,7 +1,7 @@
! Copyright (C) 2005, 2008 Chris Double, Slava Pestov. ! Copyright (C) 2005, 2008 Chris Double, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: concurrency.promises concurrency.messaging kernel arrays USING: concurrency.promises concurrency.messaging kernel arrays
continuations help.markup help.syntax quotations ; continuations help.markup help.syntax quotations calendar ;
IN: concurrency.futures IN: concurrency.futures
HELP: future 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 } "." } ; "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 HELP: ?future-timeout
{ $values { "future" future } { "timeout" "a timeout in milliseconds or " { $link f } } { "value" object } } { $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 " { $snippet "timeout" } " milliseconds." } { $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." } ; { $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 HELP: ?future

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

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

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

@ -13,7 +13,7 @@ HELP: promise-fulfilled?
HELP: ?promise-timeout HELP: ?promise-timeout
{ $values { "promise" promise } { "timeout" { $maybe duration } } { "result" object } } { $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." } ; { $errors "Throws an error if the timeout expires before the promise has been fulfilled." } ;
HELP: ?promise HELP: ?promise

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

@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov ! Copyright (C) 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax kernel threads init namespaces alien USING: alien.syntax kernel threads init namespaces alien
core-foundation ; core-foundation calendar ;
IN: core-foundation.run-loop IN: core-foundation.run-loop
: kCFRunLoopRunFinished 1 ; inline : kCFRunLoopRunFinished 1 ; inline
@ -30,7 +30,7 @@ FUNCTION: SInt32 CFRunLoopRunInMode (
: run-loop-thread ( -- ) : run-loop-thread ( -- )
CFRunLoopDefaultMode 0 f CFRunLoopRunInMode CFRunLoopDefaultMode 0 f CFRunLoopRunInMode
kCFRunLoopRunHandledSource = [ 1000 sleep ] unless kCFRunLoopRunHandledSource = [ 1 seconds sleep ] unless
run-loop-thread ; run-loop-thread ;
: start-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 assocs combinators vocabs.loader init threads continuations
math accessors concurrency.flags destructors environment math accessors concurrency.flags destructors environment
io io.backend io.timeouts io.pipes io.pipes.private io.encodings 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 IN: io.launcher
TUPLE: process < identity-tuple TUPLE: process < identity-tuple
@ -65,7 +66,7 @@ SYMBOL: wait-flag
: wait-loop ( -- ) : wait-loop ( -- )
processes get assoc-empty? processes get assoc-empty?
[ wait-flag get-global lower-flag ] [ wait-flag get-global lower-flag ]
[ wait-for-processes [ 100 sleep ] when ] if ; [ wait-for-processes [ 100 milliseconds sleep ] when ] if ;
: start-wait-thread ( -- ) : start-wait-thread ( -- )
<flag> wait-flag set-global <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 ; dup length [ over [ pick set-timeval-nth ] [ 2drop ] if ] 2each ;
: timestamp>timeval ( timestamp -- timeval ) : timestamp>timeval ( timestamp -- timeval )
unix-1970 time- duration>milliseconds make-timeval ; unix-1970 time- duration>microseconds make-timeval ;
: timestamps>byte-array ( timestamps -- byte-array ) : timestamps>byte-array ( timestamps -- byte-array )
[ dup [ timestamp>timeval ] when ] map make-timeval-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 -- ) : handle-kevents ( mx n -- )
[ over events>> kevent-nth handle-kevent ] with each ; [ 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 swap dup [ make-timespec ] when
dupd wait-kevent handle-kevents ; 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 [ write-fdset/tasks [ init-fdset ] [ underlying>> ] bi ] tri
f ; f ;
M:: select-mx wait-for-events ( ms mx -- ) M:: select-mx wait-for-events ( us mx -- )
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 ] [ [ read-fdset/tasks ] keep [ input-available ] check-fdset ]
[ [ write-fdset/tasks ] keep [ output-available ] check-fdset ] [ [ write-fdset/tasks ] keep [ output-available ] check-fdset ]
tri ; tri ;

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

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

2
basis/smtp/smtp.factor
View File

@ -145,7 +145,7 @@ ERROR: invalid-header-string string ;
"<" % "<" %
64 random-bits # 64 random-bits #
"-" % "-" %
millis # micros #
"@" % "@" %
smtp-domain get [ host-name ] unless* % 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 { } { integer integer integer integer } define-primitive
\ code-room make-flushable \ code-room make-flushable
\ millis { } { integer } define-primitive \ micros { } { integer } define-primitive
\ millis make-flushable \ micros make-flushable
\ tag { object } { fixnum } define-primitive \ tag { object } { fixnum } define-primitive
\ tag make-foldable \ tag make-foldable

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

@ -24,4 +24,7 @@ M: callable infer ( quot -- effect )
: forget-effects ( -- ) : forget-effects ( -- )
forget-errors 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." } ; { $var-description "A " { $link min-heap } " storing the queue of sleeping threads." } ;
HELP: sleep-time 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 } "." } ; { $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 HELP: stop

6
basis/threads/threads.factor
View File

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

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

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

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

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

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

@ -14,8 +14,8 @@ IN: tools.threads
] with-cell ] with-cell
[ [
sleep-entry>> [ sleep-entry>> [
key>> millis [-] number>string write key>> micros [-] number>string write
" ms" write " us" write
] when* ] when*
] with-cell ; ] 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:" "A lower-level word puts timings on the stack, intead of printing:"
{ $subsection benchmark } { $subsection benchmark }
"You can also read the system clock and garbage collection statistics directly:" "You can also read the system clock and garbage collection statistics directly:"
{ $subsection millis } { $subsection micros }
{ $subsection gc-stats } { $subsection gc-stats }
{ $see-also "profiling" } ; { $see-also "profiling" } ;
@ -15,7 +15,7 @@ ABOUT: "timing"
HELP: benchmark HELP: benchmark
{ $values { "quot" "a quotation" } { $values { "quot" "a quotation" }
{ "runtime" "an integer denoting milliseconds" } } { "runtime" "the runtime in microseconds" } }
{ $description "Runs a quotation, measuring the total wall clock time." } { $description "Runs a quotation, measuring the total wall clock time." }
{ $notes "A nicer word for interactive use is " { $link time } "." } ; { $notes "A nicer word for interactive use is " { $link time } "." } ;
@ -23,4 +23,4 @@ HELP: time
{ $values { "quot" "a quotation" } } { $values { "quot" "a quotation" } }
{ $description "Runs a quotation and then prints the total run time and some garbage collection statistics." } ; { $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 IN: tools.time
: benchmark ( quot -- runtime ) : benchmark ( quot -- runtime )
millis >r call millis r> - ; inline micros >r call micros r> - ; inline
: time. ( data -- ) : time. ( data -- )
unclip unclip
"==== RUNNING TIME" print nl pprint " ms" print nl "==== RUNNING TIME" print nl pprint " us" print nl
4 cut* 4 cut*
"==== GARBAGE COLLECTION" print nl "==== GARBAGE COLLECTION" print nl
[ [
6 group 6 group
{ {
"GC count:" "GC count:"
"Cumulative GC time (ms):" "Cumulative GC time (us):"
"Longest GC pause (ms):" "Longest GC pause (us):"
"Average GC pause (ms):" "Average GC pause (us):"
"Objects copied:" "Objects copied:"
"Bytes copied:" "Bytes copied:"
} prefix } prefix
@ -37,4 +37,4 @@ IN: tools.time
] bi* ; ] bi* ;
: time ( quot -- ) : 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." } ; { $var-description "Global variable. The mouse button most recently pressed." } ;
HELP: hand-last-time 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 HELP: hand-buttons
{ $var-description "Global variable. A vector of mouse buttons currently held down." } ; { $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 { 0 0 } scroll-direction set-global
SYMBOL: double-click-timeout SYMBOL: double-click-timeout
300 double-click-timeout set-global 300 milliseconds double-click-timeout set-global
: hand-moved? ( -- ? ) : hand-moved? ( -- ? )
hand-loc get hand-click-loc get = not ; hand-loc get hand-click-loc get = not ;
@ -182,7 +182,7 @@ SYMBOL: drag-timer
hand-click-loc get-global swap screen-loc v- ; hand-click-loc get-global swap screen-loc v- ;
: multi-click-timeout? ( -- ? ) : 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 ? ) : multi-click-button? ( button -- button ? )
dup hand-last-button get = ; dup hand-last-button get = ;
@ -207,7 +207,7 @@ SYMBOL: drag-timer
1 hand-click# set 1 hand-click# set
] if ] if
hand-last-button set hand-last-button set
millis hand-last-time set now hand-last-time set
] bind ; ] bind ;
: update-clicked ( -- ) : 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 [ ] [ [ "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 [ ] [ "interactor" get interactor-eof ] unit-test
@ -57,11 +57,11 @@ tools.test kernel calendar parser accessors calendar io ;
] in-thread ] in-thread
] unit-test ] unit-test
[ ] [ 100 sleep ] unit-test [ ] [ 100 milliseconds sleep ] unit-test
[ ] [ "interactor" get evaluate-input ] unit-test [ ] [ "interactor" get evaluate-input ] unit-test
[ ] [ 100 sleep ] unit-test [ ] [ 100 milliseconds sleep ] unit-test
[ ] [ "interactor" get interactor-eof ] unit-test [ ] [ "interactor" get interactor-eof ] unit-test
@ -80,7 +80,7 @@ tools.test kernel calendar parser accessors calendar io ;
] in-thread ] in-thread
] unit-test ] unit-test
[ ] [ 100 sleep ] unit-test [ ] [ 100 milliseconds sleep ] unit-test
[ ] [ "interactor" get evaluate-input ] 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 ui.tools.listener hashtables kernel namespaces parser sequences
tools.test ui.commands ui.gadgets ui.gadgets.editors tools.test ui.commands ui.gadgets ui.gadgets.editors
ui.gadgets.panes vocabs words tools.test.ui slots.private 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 IN: ui.tools.listener.tests
[ f ] [ "word" source-editor command-map commands>> empty? ] unit-test [ 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 [ ] [ "listener" get restart-listener ] unit-test
[ ] [ 1000 sleep ] unit-test [ ] [ 1 seconds sleep ] unit-test
[ ] [ "listener" get com-end ] unit-test [ ] [ "listener" get com-end ] unit-test
] with-grafted-gadget ] 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 USING: assocs ui.tools.search help.topics io.files io.styles
kernel namespaces sequences source-files threads kernel namespaces sequences source-files threads
tools.test ui.gadgets ui.gestures vocabs accessors 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 IN: ui.tools.search.tests
[ f ] [ [ f ] [
@ -14,7 +14,7 @@ IN: ui.tools.search.tests
: update-live-search ( search -- seq ) : update-live-search ( search -- seq )
dup [ dup [
300 sleep 300 milliseconds sleep
list>> control-value list>> control-value
] with-grafted-gadget ; ] with-grafted-gadget ;
@ -30,7 +30,7 @@ IN: ui.tools.search.tests
"" all-words t <definition-search> "" all-words t <definition-search>
dup [ dup [
{ "set-word-prop" } over field>> set-control-value { "set-word-prop" } over field>> set-control-value
300 sleep 300 milliseconds sleep
search-value \ set-word-prop eq? search-value \ set-word-prop eq?
] with-grafted-gadget ] with-grafted-gadget
] unit-test ] 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. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs io kernel math models namespaces make USING: arrays assocs io kernel math models namespaces make
prettyprint dlists deques sequences threads sequences words prettyprint dlists deques sequences threads sequences words
debugger ui.gadgets ui.gadgets.worlds ui.gadgets.tracks debugger ui.gadgets ui.gadgets.worlds ui.gadgets.tracks
ui.gestures ui.backend ui.render continuations init combinators ui.gestures ui.backend ui.render continuations init combinators
hashtables concurrency.flags sets accessors ; hashtables concurrency.flags sets accessors calendar ;
IN: ui IN: ui
! Assoc mapping aliens to gadgets ! Assoc mapping aliens to gadgets
@ -142,7 +142,7 @@ SYMBOL: ui-hook
[ notify-queued layout-queued redraw-worlds ] assert-depth ; [ notify-queued layout-queued redraw-worlds ] assert-depth ;
: ui-wait ( -- ) : ui-wait ( -- )
10 sleep ; 10 milliseconds sleep ;
: ui-try ( quot -- ) [ ui-error ] recover ; : ui-try ( quot -- ) [ ui-error ] recover ;

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

@ -11,14 +11,14 @@ C-STRUCT: timespec
{ "time_t" "sec" } { "time_t" "sec" }
{ "long" "nsec" } ; { "long" "nsec" } ;
: make-timeval ( ms -- timeval ) : make-timeval ( us -- timeval )
1000 /mod 1000 * 1000000 /mod
"timeval" <c-object> "timeval" <c-object>
[ set-timeval-usec ] keep [ set-timeval-usec ] keep
[ set-timeval-sec ] keep ; [ set-timeval-sec ] keep ;
: make-timespec ( ms -- timespec ) : make-timespec ( us -- timespec )
1000 /mod 1000000 * 1000000 /mod 1000 *
"timespec" <c-object> "timespec" <c-object>
[ set-timespec-nsec ] keep [ set-timespec-nsec ] keep
[ set-timespec-sec ] 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." "Gives all Factor threads a chance to run."
} } } }
{ { { {
{ $code "void factor_sleep(long ms)" } { $code "void factor_sleep(long us)" }
"Gives all Factor threads a chance to run for " { $snippet "ms" } " milliseconds." "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" } { "exit" "system" }
{ "data-room" "memory" } { "data-room" "memory" }
{ "code-room" "memory" } { "code-room" "memory" }
{ "millis" "system" } { "micros" "system" }
{ "modify-code-heap" "compiler.units" } { "modify-code-heap" "compiler.units" }
{ "dlopen" "alien" } { "dlopen" "alien" }
{ "dlsym" "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 ; byte-arrays ;
HELP: io-multiplex HELP: io-multiplex
{ $values { "ms" "a non-negative integer" } } { $values { "us" "a non-negative integer" } }
{ $contract "Waits up to " { $snippet "ms" } " milliseconds for pending I/O requests to complete." } ; { $contract "Waits up to " { $snippet "us" } " microseconds for pending I/O requests to complete." } ;
HELP: init-io HELP: init-io
{ $contract "Initializes the I/O system. Called on startup." } ; { $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 (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) M: c-io-backend (file-reader)
"rb" fopen <c-reader> ; "rb" fopen <c-reader> ;

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

@ -11,7 +11,7 @@ ARTICLE: "system" "System interface"
{ $subsection vm } { $subsection vm }
{ $subsection image } { $subsection image }
"Getting the current time:" "Getting the current time:"
{ $subsection millis } { $subsection micros }
"Exiting the Factor VM:" "Exiting the Factor VM:"
{ $subsection exit } ; { $subsection exit } ;
@ -64,8 +64,13 @@ HELP: exit ( n -- )
{ $values { "n" "an integer exit code" } } { $values { "n" "an integer exit code" } }
{ $description "Exits the Factor process." } ; { $description "Exits the Factor process." } ;
HELP: millis ( -- n ) HELP: micros ( -- us )
{ $values { "n" integer } } { $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." } { $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." } ; { $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 ] "system" add-init-hook
: embedded? ( -- ? ) 15 getenv ; : 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 IN: crypto.timing
: with-timing ( quot n -- ) : with-timing ( quot n -- )
#! force the quotation to execute in, at minimum, n milliseconds #! 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 ] [ jamshred>> jamshred-update ]
[ relayout-1 ] [ relayout-1 ]
[ 10 sleep yield jamshred-loop ] tri [ 10 milliseconds sleep yield jamshred-loop ] tri
] if ; ] if ;
: fullscreen ( gadget -- ) : 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 ( -- ) : do-benchmarks ( -- )
run-benchmarks benchmarks-file to-file ; run-benchmarks benchmarks-file to-file ;
: benchmark-ms ( quot -- ms )
benchmark 1000 /i ; inline
: do-all ( -- ) : do-all ( -- )
".." [ ".." [
bootstrap-time get boot-time-file to-file bootstrap-time get boot-time-file to-file
[ do-load do-compile-errors ] benchmark load-time-file to-file [ do-load do-compile-errors ] benchmark-ms load-time-file to-file
[ generate-help ] benchmark html-help-time-file to-file [ generate-help ] html-help-time-file to-file
[ do-tests ] benchmark test-time-file to-file [ do-tests ] benchmark-ms test-time-file to-file
[ do-help-lint ] benchmark help-lint-time-file to-file [ do-help-lint ] benchmark-ms help-lint-time-file to-file
[ do-benchmarks ] benchmark benchmark-time-file to-file [ do-benchmarks ] benchmark-ms benchmark-time-file to-file
] with-directory ; ] with-directory ;
MAIN: do-all MAIN: do-all

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

@ -1,12 +1,13 @@
USING: arrays kernel math opengl opengl.gl opengl.glu 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 IN: nehe.4
TUPLE: nehe4-gadget < gadget rtri rquad thread quit? ; TUPLE: nehe4-gadget < gadget rtri rquad thread quit? ;
: width 256 ; : width 256 ;
: height 256 ; : height 256 ;
: redraw-interval 10 ; : redraw-interval 10 milliseconds ;
: <nehe4-gadget> ( -- gadget ) : <nehe4-gadget> ( -- gadget )
nehe4-gadget new-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 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 IN: nehe.5
TUPLE: nehe5-gadget < gadget rtri rquad thread quit? ; TUPLE: nehe5-gadget < gadget rtri rquad thread quit? ;
: width 256 ; : width 256 ;
: height 256 ; : height 256 ;
: redraw-interval 10 ; : redraw-interval 10 milliseconds ;
: <nehe5-gadget> ( -- gadget ) : <nehe5-gadget> ( -- gadget )
nehe5-gadget new-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. ! See http://factorcode.org/license.txt for BSD license.
! !
IN: openal.example IN: openal.example
USING: openal kernel alien threads sequences ; USING: openal kernel alien threads sequences calendar ;
: play-hello ( -- ) : play-hello ( -- )
init-openal init-openal
1 gen-sources 1 gen-sources
first dup AL_BUFFER alutCreateBufferHelloWorld set-source-param first dup AL_BUFFER alutCreateBufferHelloWorld set-source-param
source-play source-play
1000 sleep ; 1000 milliseconds sleep ;
: (play-file) ( source -- ) : (play-file) ( source -- )
100 sleep 100 milliseconds sleep
dup source-playing? [ (play-file) ] [ drop ] if ; dup source-playing? [ (play-file) ] [ drop ] if ;
: play-file ( filename -- ) : play-file ( filename -- )

12
vm/data_gc.c
View File

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

6
vm/factor.c
View File

@ -91,7 +91,7 @@ void init_factor(F_PARAMETERS *p)
if(p->image == NULL) if(p->image == NULL)
p->image = default_image_path(); p->image = default_image_path();
srand(current_millis()); srand(current_micros());
init_ffi(); init_ffi();
init_stacks(p->ds_size,p->rs_size); init_stacks(p->ds_size,p->rs_size);
load_image(p); load_image(p);
@ -216,8 +216,8 @@ void factor_yield(void)
callback(); callback();
} }
void factor_sleep(long ms) void factor_sleep(long us)
{ {
void (*callback)() = alien_offset(userenv[SLEEP_CALLBACK_ENV]); 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; static void *null_dll;
s64 current_millis(void) s64 current_micros(void)
{ {
struct timeval t; struct timeval t;
gettimeofday(&t,NULL); 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) 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 signal_handler(int signal, siginfo_t* siginfo, void* uap);
void dump_stack_signal(int signal, siginfo_t* siginfo, void* uap); void dump_stack_signal(int signal, siginfo_t* siginfo, void* uap);
s64 current_millis(void); s64 current_micros(void);
void sleep_millis(CELL msec); void sleep_micros(CELL usec);
void open_console(void); void open_console(void);

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

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

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

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

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

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

4
vm/os-windows.c
View File

@ -166,7 +166,7 @@ long getpagesize(void)
return g_pagesize; 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_dlsym(F_DLL *dll, F_SYMBOL *symbol);
void ffi_dlclose(F_DLL *dll); void ffi_dlclose(F_DLL *dll);
void sleep_millis(DWORD msec); void sleep_micros(DWORD msec);
INLINE void init_signals(void) {} INLINE void init_signals(void) {}
INLINE void early_init(void) {} INLINE void early_init(void) {}
@ -57,5 +57,5 @@ const F_CHAR *vm_executable_path(void);
const F_CHAR *default_image_path(void); const F_CHAR *default_image_path(void);
long getpagesize (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_exit,
primitive_data_room, primitive_data_room,
primitive_code_room, primitive_code_room,
primitive_millis, primitive_micros,
primitive_modify_code_heap, primitive_modify_code_heap,
primitive_dlopen, primitive_dlopen,
primitive_dlsym, primitive_dlsym,

6
vm/run.c
View File

@ -153,14 +153,14 @@ void primitive_exit(void)
exit(to_fixnum(dpop())); 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) void primitive_sleep(void)
{ {
sleep_millis(to_cell(dpop())); sleep_micros(to_cell(dpop()));
} }
void primitive_set_slot(void) 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_set_os_env(void);
void primitive_unset_os_env(void); void primitive_unset_os_env(void);
void primitive_set_os_envs(void); void primitive_set_os_envs(void);
void primitive_millis(void); void primitive_micros(void);
void primitive_sleep(void); void primitive_sleep(void);
void primitive_set_slot(void); void primitive_set_slot(void);