[
! We time bootstrap
- millis
+ system-millis
default-image-name "output-image" set-global
load-components
- millis over - core-bootstrap-time set-global
+ system-millis over - core-bootstrap-time set-global
run-bootstrap-init
f error set-global
f error-continuation set-global
- millis swap - bootstrap-time set-global
+ system-millis swap - bootstrap-time set-global
print-report
"deploy-vocab" get [
: gmt ( -- timestamp )
#! GMT time, right now
- unix-1970 micros microseconds time+ ;
+ unix-1970 system-micros microseconds time+ ;
: now ( -- timestamp ) gmt >local-time ;
: hence ( duration -- timestamp ) now swap time+ ;
: expire-state ( class -- )
new
- -1/0. millis [a,b] >>expires
+ -1/0. system-millis [a,b] >>expires
delete-tuples ;
TUPLE: server-state-manager < filter-responder timeout ;
\ code-room { } { byte-array } define-primitive
\ code-room make-flushable
-\ micros { } { integer } define-primitive
-\ micros make-flushable
+\ system-micros { } { integer } define-primitive
+\ system-micros make-flushable
-\ nanos { } { integer } define-primitive
-\ nanos make-flushable
+\ nano-count { } { integer } define-primitive
+\ nano-count make-flushable
\ tag { object } { fixnum } define-primitive
\ tag make-foldable
{
{ [ run-queue deque-empty? not ] [ 0 ] }
{ [ sleep-queue heap-empty? ] [ f ] }
- [ sleep-queue heap-peek nip micros [-] ]
+ [ sleep-queue heap-peek nip system-micros [-] ]
} cond ;
DEFER: stop
: expire-sleep? ( heap -- ? )
dup heap-empty?
- [ drop f ] [ heap-peek nip micros <= ] if ;
+ [ drop f ] [ heap-peek nip system-micros <= ] if ;
: expire-sleep ( thread -- )
f >>sleep-entry resume ;
GENERIC: sleep ( dt -- )
M: real sleep
- micros + >integer sleep-until ;
+ system-micros + >integer sleep-until ;
: interrupt ( thread -- )
dup state>> [
: kilobytes ( n -- str )
1024 /i commas " KB" append ;
-: micros>string ( n -- str )
- commas " µs" append ;
+: nanos>string ( n -- str )
+ 1000 /i commas " µs" append ;
: copying-room. ( copying-sizes -- )
{
[ collections>> ]
[
times>> {
- [ sum micros>string ]
- [ mean >integer micros>string ]
- [ median >integer micros>string ]
- [ infimum micros>string ]
- [ supremum micros>string ]
+ [ sum nanos>string ]
+ [ mean >integer nanos>string ]
+ [ median >integer nanos>string ]
+ [ infimum nanos>string ]
+ [ supremum nanos>string ]
} cleave
] bi
] bi
: gc-event. ( event -- )
{
{ "Event type:" [ op>> gc-op-string ] }
- { "Total time:" [ total-time>> micros>string ] }
+ { "Total time:" [ total-time>> nanos>string ] }
{ "Space reclaimed:" [ space-reclaimed kilobytes ] }
} object-table. ;
{ "Cards scanned:" [ [ cards-scanned>> ] map-sum commas ] }
{ "Decks scanned:" [ [ decks-scanned>> ] map-sum commas ] }
{ "Code blocks scanned:" [ [ code-blocks-scanned>> ] map-sum commas ] }
- { "Total time:" [ [ total-time>> ] map-sum micros>string ] }
- { "Card scan time:" [ [ card-scan-time>> ] map-sum micros>string ] }
- { "Code block scan time:" [ [ code-scan-time>> ] map-sum micros>string ] }
- { "Data heap sweep time:" [ [ data-sweep-time>> ] map-sum micros>string ] }
- { "Code heap sweep time:" [ [ code-sweep-time>> ] map-sum micros>string ] }
- { "Compaction time:" [ [ compaction-time>> ] map-sum micros>string ] }
+ { "Total time:" [ [ total-time>> ] map-sum nanos>string ] }
+ { "Card scan time:" [ [ card-scan-time>> ] map-sum nanos>string ] }
+ { "Code block scan time:" [ [ code-scan-time>> ] map-sum nanos>string ] }
+ { "Data heap sweep time:" [ [ data-sweep-time>> ] map-sum nanos>string ] }
+ { "Code heap sweep time:" [ [ code-sweep-time>> ] map-sum nanos>string ] }
+ { "Compaction time:" [ [ compaction-time>> ] map-sum nanos>string ] }
} object-table. ;
] with-cell\r
[\r
sleep-entry>> [\r
- key>> micros [-] number>string write\r
+ key>> nano-count 1000 /i [-] number>string write\r
" us" write\r
] when*\r
] with-cell ;\r
"A lower-level word puts timings on the stack, intead of printing:"
{ $subsections benchmark }
"You can also read the system clock directly:"
-{ $subsections micros }
+{ $subsections system-micros }
{ $see-also "profiling" "calendar" } ;
ABOUT: "timing"
{ $values { "quot" quotation } }
{ $description "Runs a quotation, gathering statistics about method dispatch and garbage collection, and then prints the total run time." } ;
-{ benchmark micros time } related-words
+{ benchmark system-micros system-millis time } related-words
HELP: collect-gc-events
{ $values { "quot" quotation } }
IN: tools.time
: benchmark ( quot -- runtime )
- micros [ call micros ] dip - ; inline
+ nano-count [ call nano-count ] dip - ; inline
: time. ( time -- )
- "Running time: " write 1000000 /f pprint " seconds" print ;
+ "Running time: " write 1000000000 /f pprint " seconds" print ;
: time-banner. ( -- )
"Additional information was collected." print
{ $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 micros } "." } ;
+{ $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 system-micros } "." } ;
HELP: hand-buttons
{ $var-description "Global variable. A vector of mouse buttons currently held down." } ;
{ "(exit)" "system" (( n -- )) }
{ "data-room" "memory" (( -- data-room )) }
{ "code-room" "memory" (( -- code-room )) }
- { "micros" "system" (( -- us )) }
- { "nanos" "system" (( -- us )) }
+ { "system-micros" "system" (( -- us )) }
+ { "nano-count" "system" (( -- ns )) }
{ "modify-code-heap" "compiler.units" (( alist -- )) }
{ "(dlopen)" "alien.libraries" (( path -- dll )) }
{ "(dlsym)" "alien.libraries" (( name dll -- alien )) }
}
"Getting the current time:"
{ $subsections
- micros
- millis
+ system-micros
+ system-micros
}
"Exiting the Factor VM:"
{ $subsections exit } ;
{ $values { "n" "an integer exit code" } }
{ $description "Exits the Factor process." } ;
-HELP: micros ( -- us )
+HELP: system-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 )
+HELP: system-millis ( -- ms )
{ $values { "ms" 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." } ;
: embedded? ( -- ? ) 15 getenv ;
-: millis ( -- ms ) micros 1000 /i ;
+: system-millis ( -- ms ) system-micros 1000 /i ;
: exit ( n -- ) do-shutdown-hooks (exit) ;
+++ /dev/null
-USING: help.markup help.syntax ;
-IN: animations
-
-HELP: animate ( quot duration -- )
-
-{ $values
- { "quot" "a quot which uses " { $link progress } }
- { "duration" "a duration of time" }
-}
-{ $description
- { $link animate } " calls " { $link reset-progress }
- " , then continously calls the given quot until the"
- " duration of time has elapsed. The quot should use "
- { $link progress } " at least once."
-}
-{ $examples
- { $unchecked-example
- "USING: animations calendar threads prettyprint ;"
- "[ 1 sleep progress unparse write \" ms elapsed\" print ] "
- "1/20 seconds animate ;"
- "46 ms elapsed\n17 ms elapsed"
- }
- { $notes "The amount of time elapsed between these iterations will very." }
-} ;
-
-HELP: reset-progress ( -- )
-{ $description
- "Initiates the timer. Call this before using "
- "a loop which makes use of " { $link progress } "."
-} ;
-
-HELP: progress
-{ $values { "time" "an integer" } }
-{ $description
- "Gives the time elapsed since the last time"
- " this word was called, in milliseconds."
-}
-{ $examples
- { $unchecked-example
- "USING: animations threads prettyprint ;"
- "reset-progress 3 "
- "[ 1 sleep progress unparse write \"ms elapsed\" print ] "
- "times ;"
- "31 ms elapsed\n18 ms elapsed\n16 ms elapsed"
- }
- { $notes "The amount of time elapsed between these iterations will very." }
-} ;
-
-ARTICLE: "animations" "Animations"
-"Provides a lightweight framework for properly simulating continuous"
-" functions of real time. This framework helps one create animations "
-"that use rates which do not change across platforms. The speed of the "
-"computer should correlate with the smoothness of the animation, not "
-"the speed of the animation!"
-{ $subsections
- animate
- reset-progress
- progress
-}
-! A little talk about when to use progress and when to use animate
- { $link progress } " specifically provides the length of time since "
- { $link reset-progress } " was called, and also calls "
- { $link reset-progress } " as its last action. This can be directly "
- "used when one's quote runs for a specific number of iterations, instead "
- "of a length of time. If the animation is like most, and is expected to "
- "run for a specific length of time, " { $link animate } " should be used." ;
-ABOUT: "animations"
\ No newline at end of file
+++ /dev/null
-! Small library for cross-platform continuous functions of real time
-
-USING: kernel shuffle system locals
-prettyprint math io namespaces threads calendar ;
-IN: animations
-
-SYMBOL: last-loop
-SYMBOL: sleep-period
-
-: reset-progress ( -- ) millis last-loop set ;
-! : my-progress ( -- progress ) millis
-: progress ( -- time ) millis last-loop get - reset-progress ;
-: progress-peek ( -- progress ) millis last-loop get - ;
-: set-end ( duration -- end-time ) duration>milliseconds millis + ;
-: loop ( quot end -- ) dup millis > [ [ dup call ] dip loop ] [ 2drop ] if ; inline
-: animate ( quot duration -- ) reset-progress set-end loop ; inline
-: sample ( revs quot -- avg ) reset-progress dupd times progress swap / ; inline
+++ /dev/null
-Reginald Ford
\ No newline at end of file
SYMBOL: game-loop
: since-last-tick ( loop -- milliseconds )
- last-tick>> millis swap - ;
+ last-tick>> system-millis swap - ;
: tick-slice ( loop -- slice )
[ since-last-tick ] [ tick-length>> ] bi /f 1.0 min ;
drop ;
: ?tick ( loop count -- )
- [ millis >>last-tick drop ] [
+ [ system-millis >>last-tick drop ] [
over [ since-last-tick ] [ tick-length>> ] bi >=
[ [ drop increment-tick ] [ drop tick ] [ 1 - ?tick ] 2tri ]
[ 2drop ] if
with-variable ;
: benchmark-millis ( loop -- millis )
- millis swap benchmark-time>> - ;
+ system-millis swap benchmark-time>> - ;
PRIVATE>
: reset-loop-benchmark ( loop -- )
- millis >>benchmark-time
+ system-millis >>benchmark-time
dup tick-number>> >>benchmark-tick-number
dup frame-number>> >>benchmark-frame-number
drop ;
[ frame-number>> ] [ benchmark-frame-number>> - ] [ benchmark-millis ] tri /f ;
: start-loop ( loop -- )
- millis >>last-tick
+ system-millis >>last-tick
t >>running?
[ reset-loop-benchmark ]
[ [ run-loop ] curry "game loop" spawn ]
drop ;
: <game-loop> ( tick-length delegate -- loop )
- millis f f 0 0 millis 0 0
+ system-millis f f 0 0 system-millis 0 0
game-loop boa ;
M: game-loop dispose
>>tunnel to-tunnel-start ;
: update-time ( player -- seconds-passed )
- millis swap [ last-move>> - 1000 / ] [ (>>last-move) ] 2bi ;
+ system-millis swap [ last-move>> - 1000 / ] [ (>>last-move) ] 2bi ;
-: moved ( player -- ) millis swap (>>last-move) ;
+: moved ( player -- ) system-millis swap (>>last-move) ;
: speed-range ( -- range )
max-speed [0,b] ;
: sync-frame ( millis -- millis )
#! Sleep until the time for the next frame arrives.
- 1000 60 / >fixnum + system:millis - dup 0 >
- [ milliseconds threads:sleep ] [ drop threads:yield ] if system:millis ;
+ 1000 60 / >fixnum + system:system-millis - dup 0 >
+ [ milliseconds threads:sleep ] [ drop threads:yield ] if system:system-millis ;
: invaders-process ( millis gadget -- )
#! Run a space invaders gadget inside a
M: invaders-gadget graft* ( gadget -- )
dup cpu>> init-sounds
f over (>>quit?)
- [ system:millis swap invaders-process ] curry
+ [ system:system-millis swap invaders-process ] curry
"Space invaders" threads:spawn drop ;
M: invaders-gadget ungraft* ( gadget -- )
dup { 0 1 } tetris-move [ move-drop ] [ lock-piece ] if ;
: update ( tetris -- )
- millis over last-update>> -
+ system-millis over last-update>> -
over update-interval > [
dup move-down
- millis >>last-update
+ system-millis >>last-update
] when drop ;
: ?update ( tetris -- )
--- /dev/null
+USING: help.markup help.syntax ;
+IN: animations
+
+HELP: animate ( quot duration -- )
+
+{ $values
+ { "quot" "a quot which uses " { $link progress } }
+ { "duration" "a duration of time" }
+}
+{ $description
+ { $link animate } " calls " { $link reset-progress }
+ " , then continously calls the given quot until the"
+ " duration of time has elapsed. The quot should use "
+ { $link progress } " at least once."
+}
+{ $examples
+ { $unchecked-example
+ "USING: animations calendar threads prettyprint ;"
+ "[ 1 sleep progress unparse write \" ms elapsed\" print ] "
+ "1/20 seconds animate ;"
+ "46 ms elapsed\n17 ms elapsed"
+ }
+ { $notes "The amount of time elapsed between these iterations will very." }
+} ;
+
+HELP: reset-progress ( -- )
+{ $description
+ "Initiates the timer. Call this before using "
+ "a loop which makes use of " { $link progress } "."
+} ;
+
+HELP: progress
+{ $values { "time" "an integer" } }
+{ $description
+ "Gives the time elapsed since the last time"
+ " this word was called, in milliseconds."
+}
+{ $examples
+ { $unchecked-example
+ "USING: animations threads prettyprint ;"
+ "reset-progress 3 "
+ "[ 1 sleep progress unparse write \"ms elapsed\" print ] "
+ "times ;"
+ "31 ms elapsed\n18 ms elapsed\n16 ms elapsed"
+ }
+ { $notes "The amount of time elapsed between these iterations will very." }
+} ;
+
+ARTICLE: "animations" "Animations"
+"Provides a lightweight framework for properly simulating continuous"
+" functions of real time. This framework helps one create animations "
+"that use rates which do not change across platforms. The speed of the "
+"computer should correlate with the smoothness of the animation, not "
+"the speed of the animation!"
+{ $subsections
+ animate
+ reset-progress
+ progress
+}
+! A little talk about when to use progress and when to use animate
+ { $link progress } " specifically provides the length of time since "
+ { $link reset-progress } " was called, and also calls "
+ { $link reset-progress } " as its last action. This can be directly "
+ "used when one's quote runs for a specific number of iterations, instead "
+ "of a length of time. If the animation is like most, and is expected to "
+ "run for a specific length of time, " { $link animate } " should be used." ;
+ABOUT: "animations"
\ No newline at end of file
--- /dev/null
+! Small library for cross-platform continuous functions of real time
+
+USING: kernel shuffle system locals
+prettyprint math io namespaces threads calendar ;
+IN: animations
+
+SYMBOL: last-loop
+SYMBOL: sleep-period
+
+: reset-progress ( -- ) millis last-loop set ;
+! : my-progress ( -- progress ) millis
+: progress ( -- time ) millis last-loop get - reset-progress ;
+: progress-peek ( -- progress ) millis last-loop get - ;
+: set-end ( duration -- end-time ) duration>milliseconds millis + ;
+: loop ( quot end -- ) dup millis > [ [ dup call ] dip loop ] [ 2drop ] if ; inline
+: animate ( quot duration -- ) reset-progress set-end loop ; inline
+: sample ( revs quot -- avg ) reset-progress dupd times progress swap / ; inline
--- /dev/null
+Reginald Ford
\ No newline at end of file
if(p->image_path == NULL)
p->image_path = default_image_path();
- srand(current_micros());
+ srand(system_micros());
init_ffi();
init_stacks(p->ds_size,p->rs_size);
init_callbacks(p->callback_size);
cards_scanned(0),
decks_scanned(0),
code_blocks_scanned(0),
- start_time(current_micros()),
+ start_time(nano_count()),
card_scan_time(0),
code_scan_time(0),
data_sweep_time(0),
{
data_heap_before = parent->data_room();
code_heap_before = parent->code_room();
- start_time = current_micros();
+ start_time = nano_count();
}
void gc_event::started_card_scan()
{
- temp_time = current_micros();
+ temp_time = nano_count();
}
void gc_event::ended_card_scan(cell cards_scanned_, cell decks_scanned_)
{
cards_scanned += cards_scanned_;
decks_scanned += decks_scanned_;
- card_scan_time = (current_micros() - temp_time);
+ card_scan_time = (nano_count() - temp_time);
}
void gc_event::started_code_scan()
{
- temp_time = current_micros();
+ temp_time = nano_count();
}
void gc_event::ended_code_scan(cell code_blocks_scanned_)
{
code_blocks_scanned += code_blocks_scanned_;
- code_scan_time = (current_micros() - temp_time);
+ code_scan_time = (nano_count() - temp_time);
}
void gc_event::started_data_sweep()
{
- temp_time = current_micros();
+ temp_time = nano_count();
}
void gc_event::ended_data_sweep()
{
- data_sweep_time = (current_micros() - temp_time);
+ data_sweep_time = (nano_count() - temp_time);
}
void gc_event::started_code_sweep()
{
- temp_time = current_micros();
+ temp_time = nano_count();
}
void gc_event::ended_code_sweep()
{
- code_sweep_time = (current_micros() - temp_time);
+ code_sweep_time = (nano_count() - temp_time);
}
void gc_event::started_compaction()
{
- temp_time = current_micros();
+ temp_time = nano_count();
}
void gc_event::ended_compaction()
{
- compaction_time = (current_micros() - temp_time);
+ compaction_time = (nano_count() - temp_time);
}
void gc_event::ended_gc(factor_vm *parent)
{
data_heap_after = parent->data_room();
code_heap_after = parent->code_room();
- total_time = current_micros() - start_time;
+ total_time = nano_count() - start_time;
}
-gc_state::gc_state(gc_op op_, factor_vm *parent) : op(op_), start_time(current_micros())
+gc_state::gc_state(gc_op op_, factor_vm *parent) : op(op_), start_time(nano_count())
{
event = new gc_event(op,parent);
}
return new_path;
}
-u64 current_nanos()
+u64 nano_count()
{
struct timespec t;
int ret;
return nil;
}
-u64 current_nanos()
+u64 nano_count()
{
u64 t;
mach_timebase_info_data_t info;
static void *null_dll;
-s64 current_micros()
+u64 system_micros()
{
struct timeval t;
gettimeofday(&t,NULL);
- return (s64)t.tv_sec * 1000000 + t.tv_usec;
+ return (u64)t.tv_sec * 1000000 + t.tv_usec;
}
void sleep_micros(cell usec)
usleep(usec);
}
-void sleep_nanos(cell nsec)
+void sleep_nanos(timespec ts)
{
- //nanosleep(n
+ timespec ts_rem;
+ int ret;
+ ret = nanosleep(&ts,&ts_rem);
+ while(ret == -1 && errno == EINTR)
+ {
+ memcpy(&ts, &ts_rem, sizeof(ts));
+ ret = nanosleep(&ts, &ts_rem);
+ }
+
+ if(ret == -1)
+ fatal_error("nanosleep failed", 0);
}
void factor_vm::init_ffi()
void signal_handler(int signal, siginfo_t* siginfo, void* uap);
void dump_stack_signal(int signal, siginfo_t* siginfo, void* uap);
-s64 current_micros();
-u64 current_nanos();
+u64 system_micros();
+u64 nano_count();
void sleep_micros(cell usec);
+void sleep_nanos(cell nsec);
void init_platform_globals();
namespace factor
{
-s64 current_micros()
+u64 system_micros()
{
SYSTEMTIME st;
FILETIME ft;
#define snprintf _snprintf
#define snwprintf _snwprintf
-s64 current_micros();
+u64 system_micros();
void c_to_factor_toplevel(cell quot);
void open_console();
return vm;
}
-s64 current_micros()
+u64 system_micros()
{
FILETIME t;
GetSystemTimeAsFileTime(&t);
- return (((s64)t.dwLowDateTime | (s64)t.dwHighDateTime<<32)
+ return (((u64)t.dwLowDateTime | (u64)t.dwHighDateTime<<32)
- EPOCH_OFFSET) / 10;
}
-u64 current_nanos()
+u64 nano_count()
{
LARGE_INTEGER count;
LARGE_INTEGER frequency;
inline static void init_signals() {}
inline static void early_init() {}
-s64 current_micros();
-u64 current_nanos();
+u64 system_micros();
+u64 nano_count();
long getpagesize();
}
PRIMITIVE_FORWARD(exit)
PRIMITIVE_FORWARD(data_room)
PRIMITIVE_FORWARD(code_room)
-PRIMITIVE_FORWARD(micros)
-PRIMITIVE_FORWARD(nanos)
+PRIMITIVE_FORWARD(system_micros)
+PRIMITIVE_FORWARD(nano_count)
PRIMITIVE_FORWARD(modify_code_heap)
PRIMITIVE_FORWARD(dlopen)
PRIMITIVE_FORWARD(dlsym)
primitive_exit,
primitive_data_room,
primitive_code_room,
- primitive_micros,
- primitive_nanos,
+ primitive_system_micros,
+ primitive_nano_count,
primitive_modify_code_heap,
primitive_dlopen,
primitive_dlsym,
exit(to_fixnum(dpop()));
}
-void factor_vm::primitive_micros()
+void factor_vm::primitive_system_micros()
{
- box_unsigned_8(current_micros());
+ box_unsigned_8(system_micros());
}
-void factor_vm::primitive_nanos()
+void factor_vm::primitive_nano_count()
{
- box_unsigned_8(current_nanos());
+ box_unsigned_8(nano_count());
}
void factor_vm::primitive_sleep()
// run
void primitive_exit();
- void primitive_micros();
- void primitive_nanos();
+ void primitive_system_micros();
+ void primitive_nano_count();
void primitive_sleep();
void primitive_set_slot();
projects / factor.git / commitdiff