: 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 ;
[
! We time bootstrap
- millis
+ micros
default-image-name "output-image" set-global
[
load-components
- millis over - core-bootstrap-time set-global
+ micros over - core-bootstrap-time set-global
run-bootstrap-init
] with-compiler-errors
] [ 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
{ $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"
}
} ;
[ +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 = ;
: 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+ ;
: 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 ;
\r
: (time-thread) ( -- )\r
now time get set-model\r
- 1000 sleep (time-thread) ;\r
+ 1 seconds sleep (time-thread) ;\r
\r
: time-thread ( -- )\r
[\r
[ 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
\r
[ { 1 4 9 } ] [ { 1 2 3 } [ sq ] parallel-map ] unit-test\r
\r
-[ { 1 4 9 } ] [ { 1 2 3 } [ 1000 random sleep sq ] parallel-map ] unit-test\r
+[ { 1 4 9 } ] [ { 1 2 3 } [ 1000000 random sleep sq ] parallel-map ] unit-test\r
\r
[ { 1 2 3 } [ dup 2 mod 0 = [ "Even" throw ] when ] parallel-map ]\r
[ error>> "Even" = ] must-fail-with\r
IN: concurrency.flags.tests\r
USING: tools.test concurrency.flags concurrency.combinators\r
-kernel threads locals accessors ;\r
+kernel threads locals accessors calendar ;\r
\r
:: flag-test-1 ( -- )\r
[let | f [ <flag> ] |\r
\r
:: flag-test-2 ( -- )\r
[let | f [ <flag> ] |\r
- [ 1000 sleep f raise-flag ] "Flag test" spawn drop\r
+ [ 1 seconds sleep f raise-flag ] "Flag test" spawn drop\r
f lower-flag\r
f value>>\r
] ;\r
\r
:: flag-test-5 ( -- )\r
[let | f [ <flag> ] |\r
- [ 1000 sleep f raise-flag ] "Flag test" spawn drop\r
+ [ 1 seconds sleep f raise-flag ] "Flag test" spawn drop\r
f wait-for-flag\r
f value>>\r
] ;\r
\r
[ ] [\r
{ 1 2 } <flag>\r
- [ [ 1000 sleep raise-flag ] curry "Flag test" spawn drop ]\r
+ [ [ 1 seconds sleep raise-flag ] curry "Flag test" spawn drop ]\r
[ [ wait-for-flag drop ] curry parallel-each ] bi\r
] unit-test\r
! Copyright (C) 2005, 2008 Chris Double, Slava Pestov.\r
! See http://factorcode.org/license.txt for BSD license.\r
USING: concurrency.promises concurrency.messaging kernel arrays\r
-continuations help.markup help.syntax quotations ;\r
+continuations help.markup help.syntax quotations calendar ;\r
IN: concurrency.futures\r
\r
HELP: future\r
"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 } "." } ;\r
\r
HELP: ?future-timeout\r
-{ $values { "future" future } { "timeout" "a timeout in milliseconds or " { $link f } } { "value" object } }\r
-{ $description "Waits for a deferred computation to complete, blocking indefinitely if " { $snippet "timeout" } " is " { $link f } ", otherwise waiting up to " { $snippet "timeout" } " milliseconds." }\r
+{ $values { "future" future } { "timeout" { $maybe duration } } { "value" object } }\r
+{ $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." }\r
{ $errors "Throws an error if the timeout expires before the computation completes. Also throws an error if the future quotation threw an error." } ;\r
\r
HELP: ?future\r
c await\r
l [\r
4 v push\r
- 1000 sleep\r
+ 1 seconds sleep\r
5 v push\r
] with-write-lock\r
c'' count-down\r
l [\r
1 v push\r
c count-down\r
- 1000 sleep\r
+ 1 seconds sleep\r
2 v push\r
] with-write-lock\r
c' count-down\r
\r
HELP: ?promise-timeout\r
{ $values { "promise" promise } { "timeout" { $maybe duration } } { "result" object } }\r
-{ $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." }\r
+{ $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." }\r
{ $errors "Throws an error if the timeout expires before the promise has been fulfilled." } ;\r
\r
HELP: ?promise\r
! 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
: run-loop-thread ( -- )
CFRunLoopDefaultMode 0 f CFRunLoopRunInMode
- kCFRunLoopRunHandledSource = [ 1000 sleep ] unless
+ kCFRunLoopRunHandledSource = [ 1 seconds sleep ] unless
run-loop-thread ;
: start-run-loop-thread ( -- )
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
: 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
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 ;
: 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 ;
[ 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 ;
"-" %
32 random-bits #
"-" %
- millis #
+ micros #
] "" make ;
M: winnt (pipe) ( -- pipe )
"<" %
64 random-bits #
"-" %
- millis #
+ micros #
"@" %
smtp-domain get [ host-name ] unless* %
">" %
\ 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
: 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 ;
{ $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
{
{ [ 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
: 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 ;
GENERIC: sleep ( dt -- )
M: real sleep
- millis + >integer sleep-until ;
+ micros + >integer sleep-until ;
: interrupt ( thread -- )
dup state>> [
IN: tools.deploy.test.1\r
USING: threads ;\r
\r
-: deploy-test-1 ( -- ) 1000 sleep ;\r
+: deploy-test-1 ( -- ) 1000000 sleep ;\r
\r
MAIN: deploy-test-1\r
[ ] [ [ 10 [ gc ] times ] profile ] unit-test
-[ ] [ [ 1000 sleep ] profile ] unit-test
+[ ] [ [ 1000000 sleep ] profile ] unit-test
[ ] [ profile. ] unit-test
] with-cell\r
[\r
sleep-entry>> [\r
- key>> millis [-] number>string write\r
- " ms" write\r
+ key>> micros [-] number>string write\r
+ " us" write\r
] when*\r
] with-cell ;\r
\r
"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" } ;
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 } "." } ;
{ $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
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
] 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
{ $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." } ;
{ 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 ;
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 = ;
1 hand-click# set
] if
hand-last-button set
- millis hand-last-time set
+ now hand-last-time set
] bind ;
: update-clicked ( -- )
[ ] [ [ "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
] 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
] in-thread
] unit-test
-[ ] [ 100 sleep ] unit-test
+[ ] [ 100 milliseconds sleep ] unit-test
[ ] [ "interactor" get evaluate-input ] unit-test
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
[ ] [ "listener" get restart-listener ] unit-test
- [ ] [ 1000 sleep ] unit-test
+ [ ] [ 1 seconds sleep ] unit-test
[ ] [ "listener" get com-end ] unit-test
] with-grafted-gadget
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 ] [
: update-live-search ( search -- seq )
dup [
- 300 sleep
+ 300 milliseconds sleep
list>> control-value
] with-grafted-gadget ;
"" 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
-! 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
[ notify-queued layout-queued redraw-worlds ] assert-depth ;
: ui-wait ( -- )
- 10 sleep ;
+ 10 milliseconds sleep ;
: ui-try ( quot -- ) [ ui-error ] recover ;
{ "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 ;
"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."
} }
} ;
{ "exit" "system" }
{ "data-room" "memory" }
{ "code-room" "memory" }
- { "millis" "system" }
+ { "micros" "system" }
{ "modify-code-heap" "compiler.units" }
{ "dlopen" "alien" }
{ "dlsym" "alien" }
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." } ;
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> ;
{ $subsection vm }
{ $subsection image }
"Getting the current time:"
-{ $subsection millis }
+{ $subsection micros }
"Exiting the Factor VM:"
{ $subsection exit } ;
{ $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." } ;
] "system" add-init-hook
: embedded? ( -- ? ) 15 getenv ;
+
+: millis ( -- ms ) micros 1000 /i ;
-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
] [
[ jamshred>> jamshred-update ]
[ relayout-1 ]
- [ 10 sleep yield jamshred-loop ] tri
+ [ 10 milliseconds sleep yield jamshred-loop ] tri
] if ;
: fullscreen ( gadget -- )
: 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
\ No newline at end of file
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
USING: arrays kernel math opengl opengl.gl opengl.glu\r
-opengl.demo-support ui ui.gadgets ui.render threads accessors ;\r
+opengl.demo-support ui ui.gadgets ui.render threads accessors\r
+calendar ;\r
IN: nehe.5\r
\r
TUPLE: nehe5-gadget < gadget rtri rquad thread quit? ;\r
: width 256 ;\r
: height 256 ;\r
-: redraw-interval 10 ;\r
+: redraw-interval 10 milliseconds ;\r
\r
: <nehe5-gadget> ( -- gadget )\r
nehe5-gadget new-gadget\r
! See http://factorcode.org/license.txt for BSD license.\r
!\r
IN: openal.example\r
-USING: openal kernel alien threads sequences ;\r
+USING: openal kernel alien threads sequences calendar ;\r
\r
: play-hello ( -- )\r
init-openal\r
1 gen-sources\r
first dup AL_BUFFER alutCreateBufferHelloWorld set-source-param\r
source-play\r
- 1000 sleep ;\r
+ 1000 milliseconds sleep ;\r
\r
: (play-file) ( source -- )\r
- 100 sleep\r
+ 100 milliseconds sleep\r
dup source-playing? [ (play-file) ] [ drop ] if ;\r
\r
: play-file ( filename -- )\r
return;
}
- s64 start = current_millis();
+ s64 start = current_micros();
performing_gc = true;
growing_data_heap = growing_data_heap_;
while(scan < newspace->here)
scan = collect_next(scan);
- CELL gc_elapsed = (current_millis() - start);
+ CELL gc_elapsed = (current_micros() - start);
end_gc(gc_elapsed);
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)));
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));
/* 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;
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);
callback();
}
-void factor_sleep(long ms)
+void factor_sleep(long us)
{
void (*callback)() = alien_offset(userenv[SLEEP_CALLBACK_ENV]);
- callback(ms);
+ callback(us);
}
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)
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);
#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)
#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);
#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)
return g_pagesize;
}
-void sleep_millis(DWORD msec)
+void sleep_micros(DWORD usec)
{
- Sleep(msec);
+ Sleep(msec / 1000);
}
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) {}
const F_CHAR *default_image_path(void);
long getpagesize (void);
-s64 current_millis(void);
+s64 current_micros(void);
primitive_exit,
primitive_data_room,
primitive_code_room,
- primitive_millis,
+ primitive_micros,
primitive_modify_code_heap,
primitive_dlopen,
primitive_dlsym,
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)
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);
projects / factor.git / commitdiff