Merge branch 'master' into simd-cleanup

basis/alarms/alarms-docs.factor

@@ -1,16 +1,37 @@
+USING: help.markup help.syntax calendar quotations system ;
 IN: alarms
-USING: help.markup help.syntax calendar quotations ;
 
 HELP: alarm
 { $class-description "An alarm. Can be passed to " { $link cancel-alarm } "." } ;
 
+HELP: current-alarm
+{ $description "A symbol that contains the currently executing alarm, availble only to the alarm quotation. One use for this symbol is if a repeated alarm wishes to cancel itself from executing in the future."
+}
+{ $examples
+    { $unchecked-example
+        """USING: alarms calendar io threads ;"""
+        """["""
+        """    "Hi, this should only get printed once..." print flush"""
+        """    current-alarm get cancel-alarm"""
+        """] 1 seconds every"""
+        ""
+    }
+} ;
+
 HELP: add-alarm
-{ $values { "quot" quotation } { "time" timestamp } { "frequency" { $maybe duration } } { "alarm" alarm } }
-{ $description "Creates and registers an alarm. If " { $snippet "frequency" } " is " { $link f } ", this will be a one-time alarm, otherwise it will fire with the given frequency. The quotation will be called from the alarm thread." } ;
+{ $values { "quot" quotation } { "start" duration } { "interval" { $maybe "duration/f" } } { "alarm" alarm } }
+{ $description "Creates and registers an alarm to start at " { $snippet "start" } " offset from the current time. If " { $snippet "interval" } " is " { $link f } ", this will be a one-time alarm, otherwise it will fire with the given frequency, with scheduling happening before the quotation is called in order to ensure that the next event will happen on time. The quotation will be called from a new thread spawned by the alarm thread. If a repeated alarm's quotation throws an exception, the alarm will not be rescheduled." } ;
 
 HELP: later
 { $values { "quot" quotation } { "duration" duration } { "alarm" alarm } }
-{ $description "Creates and registers an alarm which calls the quotation once at " { $snippet "time" } " from now." } ;
+{ $description "Creates and registers an alarm which calls the quotation once at " { $snippet "duration" } " offset from now." }
+{ $examples
+    { $unchecked-example
+        "USING: alarms io calendar ;"
+        """[ "Break's over!" print flush ] 15 minutes drop"""
+        ""
+    }
+} ;
 
 HELP: cancel-alarm
 { $values { "alarm" alarm } }
@@ -20,16 +41,29 @@ HELP: every
 { $values
      { "quot" quotation } { "duration" duration }
      { "alarm" alarm } }
-{ $description "Creates and registers an alarm which calls the quotation repeatedly, using " { $snippet "dt" } " as the frequency." } ;
+{ $description "Creates and registers an alarm which calls the quotation repeatedly, using " { $snippet "dt" } " as the frequency. If the quotation throws an exception that is not caught inside it, the alarm scheduler will cancel the alarm and will not reschedule it again." }
+{ $examples
+    { $unchecked-example
+        "USING: alarms io calendar ;"
+        """[ "Hi Buddy." print flush ] 10 seconds every drop"""
+        ""
+    }
+} ;
 
 ARTICLE: "alarms" "Alarms"
-"The " { $vocab-link "alarms" } " vocabulary provides a lightweight way to schedule one-time and recurring tasks without spawning a new thread."
-{ $subsections
-    alarm
-    add-alarm
-    later
-    cancel-alarm
-}
+"The " { $vocab-link "alarms" } " vocabulary provides a lightweight way to schedule one-time and recurring tasks without spawning a new thread. Alarms use " { $link nano-count } ", so they continue to work across system clock changes." $nl
+"The alarm class:"
+{ $subsections alarm }
+"Register a recurring alarm:"
+{ $subsections every }
+"Register a one-time alarm:"
+{ $subsections later }
+"The currently executing alarm:"
+{ $subsections current-alarm }
+"Low-level interface to add alarms:"
+{ $subsections add-alarm }
+"Cancelling an alarm:"
+{ $subsections cancel-alarm }
 "Alarms do not persist across image saves. Saving and restoring an image has the effect of calling " { $link cancel-alarm } " on all " { $link alarm } " instances." ;
 
 ABOUT: "alarms"

basis/alarms/alarms.factor

@@ -1,48 +1,66 @@
 ! Copyright (C) 2005, 2008 Slava Pestov, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs boxes calendar
-combinators.short-circuit fry heaps init kernel math.order
-namespaces quotations threads ;
+USING: accessors assocs boxes calendar combinators.short-circuit
+continuations fry heaps init kernel math.order
+namespaces quotations threads math system ;
 IN: alarms
 
 TUPLE: alarm
     { quot callable initial: [ ] }
-    { time timestamp }
+    { start integer }
     interval
     { entry box } ;
 
-<PRIVATE
-
 SYMBOL: alarms
 SYMBOL: alarm-thread
+SYMBOL: current-alarm
+
+: cancel-alarm ( alarm -- )
+    entry>> [ alarms get-global heap-delete ] if-box? ;
+
+<PRIVATE
 
 : notify-alarm-thread ( -- )
     alarm-thread get-global interrupt ;
 
-ERROR: bad-alarm-frequency frequency ;
-: check-alarm ( frequency/f -- frequency/f )
-    dup { [ duration? ] [ not ] } 1|| [ bad-alarm-frequency ] unless ;
+GENERIC: >nanoseconds ( obj -- duration/f )
+M: f >nanoseconds ;
+M: real >nanoseconds >integer ;
+M: duration >nanoseconds duration>nanoseconds >integer ;
 
-: <alarm> ( quot time frequency -- alarm )
-    check-alarm <box> alarm boa ;
+: <alarm> ( quot start interval -- alarm )
+    alarm new
+        swap >nanoseconds >>interval
+        swap >nanoseconds nano-count + >>start
+        swap >>quot
+        <box> >>entry ;
 
 : register-alarm ( alarm -- )
-    [ dup time>> alarms get-global heap-push* ]
+    [ dup start>> alarms get-global heap-push* ]
     [ entry>> >box ] bi
     notify-alarm-thread ;
 
-: alarm-expired? ( alarm now -- ? )
-    [ time>> ] dip before=? ;
+: alarm-expired? ( alarm n -- ? )
+    [ start>> ] dip <= ;
 
 : reschedule-alarm ( alarm -- )
-    dup '[ _ interval>> time+ now max ] change-time register-alarm ;
+    dup interval>> nano-count + >>start register-alarm ;
 
 : call-alarm ( alarm -- )
     [ entry>> box> drop ]
-    [ quot>> "Alarm execution" spawn drop ]
-    [ dup interval>> [ reschedule-alarm ] [ drop ] if ] tri ;
+    [ dup interval>> [ reschedule-alarm ] [ drop ] if ]
+    [
+        [ ] [ quot>> ] [ ] tri
+        '[
+            _ current-alarm
+            [
+                _ [ _ dup interval>> [ cancel-alarm ] [ drop ] if rethrow ]
+                recover
+            ] with-variable
+        ] "Alarm execution" spawn drop
+    ] tri ;
 
-: (trigger-alarms) ( alarms now -- )
+: (trigger-alarms) ( alarms n -- )
     over heap-empty? [
         2drop
     ] [
@@ -54,11 +72,10 @@ ERROR: bad-alarm-frequency frequency ;
     ] if ;
 
 : trigger-alarms ( alarms -- )
-    now (trigger-alarms) ;
+    nano-count (trigger-alarms) ;
 
-: next-alarm ( alarms -- timestamp/f )
-    dup heap-empty?
-    [ drop f ] [ heap-peek drop time>> ] if ;
+: next-alarm ( alarms -- nanos/f )
+    dup heap-empty? [ drop f ] [ heap-peek drop start>> ] if ;
 
 : alarm-thread-loop ( -- )
     alarms get-global
@@ -75,18 +92,13 @@ ERROR: bad-alarm-frequency frequency ;
     [ alarm-thread-loop t ] "Alarms" spawn-server
     alarm-thread set-global ;
 
-[ init-alarms ] "alarms" add-init-hook
+[ init-alarms ] "alarms" add-startup-hook
 
 PRIVATE>
 
-: add-alarm ( quot time frequency -- alarm )
+: add-alarm ( quot start interval -- alarm )
     <alarm> [ register-alarm ] keep ;
 
-: later ( quot duration -- alarm )
-    hence f add-alarm ;
+: later ( quot duration -- alarm ) f add-alarm ;
 
-: every ( quot duration -- alarm )
-    [ hence ] keep add-alarm ;
-
-: cancel-alarm ( alarm -- )
-    entry>> [ alarms get-global heap-delete ] if-box? ;
+: every ( quot duration -- alarm ) dup add-alarm ;

basis/alien/c-types/c-types-docs.factor

@@ -66,12 +66,12 @@ HELP: unbox-return
 { $notes "This is an internal word used by the compiler when compiling callbacks." } ;
 
 HELP: define-deref
-{ $values { "name" "a word name" } }
+{ $values { "c-type" "a C type" } }
 { $description "Defines a word " { $snippet "*name" } " with stack effect " { $snippet "( c-ptr -- value )" } " for reading a value with C type " { $snippet "name" } " stored at an alien pointer." }
 { $notes "This is an internal word called when defining C types, there is no need to call it on your own." } ;
 
 HELP: define-out
-{ $values { "name" "a word name" } }
+{ $values { "c-type" "a C type" } }
 { $description "Defines a word " { $snippet "<" { $emphasis "name" } ">" } " with stack effect " { $snippet "( value -- array )" } ". This word allocates a byte array large enough to hold a value with C type " { $snippet "name" } ", and writes the value at the top of the stack to the array." }
 { $notes "This is an internal word called when defining C types, there is no need to call it on your own." } ;
 

basis/alien/c-types/c-types.factor

@@ -218,13 +218,13 @@ M: c-type-name unbox-return c-type unbox-return ;
 
 : little-endian? ( -- ? ) 1 <int> *char 1 = ; foldable
 
-GENERIC: heap-size ( name -- size ) foldable
+GENERIC: heap-size ( name -- size )
 
 M: c-type-name heap-size c-type heap-size ;
 
 M: abstract-c-type heap-size size>> ;
 
-GENERIC: stack-size ( name -- size ) foldable
+GENERIC: stack-size ( name -- size )
 
 M: c-type-name stack-size c-type stack-size ;
 
@@ -297,20 +297,17 @@ M: long-long-type box-parameter ( n c-type -- )
 M: long-long-type box-return ( c-type -- )
     f swap box-parameter ;
 
-: define-deref ( name -- )
-    [ CHAR: * prefix "alien.c-types" create ] [ c-getter 0 prefix ] bi
+: define-deref ( c-type -- )
+    [ name>> CHAR: * prefix "alien.c-types" create ] [ c-getter 0 prefix ] bi
     (( c-ptr -- value )) define-inline ;
 
-: define-out ( name -- )
-    [ "alien.c-types" constructor-word ]
+: define-out ( c-type -- )
+    [ name>> "alien.c-types" constructor-word ]
     [ dup c-setter '[ _ heap-size (byte-array) [ 0 @ ] keep ] ] bi
     (( value -- c-ptr )) define-inline ;
 
 : define-primitive-type ( c-type name -- )
-    [ typedef ]
-    [ name>> define-deref ]
-    [ name>> define-out ]
-    tri ;
+    [ typedef ] [ define-deref ] [ define-out ] tri ;
 
 : if-void ( c-type true false -- )
     pick void? [ drop nip call ] [ nip call ] if ; inline

basis/bootstrap/bootstrap-error.factor

@@ -2,7 +2,8 @@ USING: continuations kernel io debugger vocabs words system namespaces ;
 
 :c
 :error
+
 "listener" vocab
 [ restarts. vocab-main execute ]
-[ die ] if*
+[ error get die ] if*
 1 exit

basis/bootstrap/finish-bootstrap.factor

@@ -3,7 +3,7 @@ namespaces eval kernel vocabs.loader io ;
 
 [
     boot
-    do-init-hooks
+    do-startup-hooks
     [
         (command-line) parse-command-line
         load-vocab-roots
@@ -14,4 +14,4 @@ namespaces eval kernel vocabs.loader io ;
         output-stream get [ stream-flush ] when*
         0 exit
     ] [ print-error 1 exit ] recover
-] set-boot-quot
+] set-startup-quot

basis/bootstrap/finish-staging.factor

@@ -1,11 +1,10 @@
-USING: init command-line system namespaces kernel vocabs.loader
-io ;
+USING: init command-line system namespaces kernel vocabs.loader io ;
 
 [
     boot
-    do-init-hooks
+    do-startup-hooks
     (command-line) parse-command-line
     "run" get run
     output-stream get [ stream-flush ] when*
     0 exit
-] set-boot-quot
+] set-startup-quot

basis/bootstrap/image/image.factor

@@ -145,7 +145,7 @@ SYMBOL: architecture
 RESET
 
 ! Boot quotation, set in stage1.factor
-USERENV: bootstrap-boot-quot 20
+USERENV: bootstrap-startup-quot 20
 
 ! Bootstrap global namesapce
 USERENV: bootstrap-global 21

basis/bootstrap/stage2.factor

@@ -35,8 +35,8 @@ SYMBOL: bootstrap-time
 : count-words ( pred -- )
     all-words swap count number>string write ; inline
 
-: print-time ( ms -- )
-    1000 /i
+: print-time ( us -- )
+    1,000,000,000 /i
     60 /mod swap
     number>string write
     " minutes and " write number>string write " seconds." print ;
@@ -56,9 +56,10 @@ SYMBOL: bootstrap-time
     error-continuation set-global
     error set-global ; inline
 
+
 [
     ! We time bootstrap
-    millis
+    nano-count
 
     default-image-name "output-image" set-global
 
@@ -83,14 +84,14 @@ SYMBOL: bootstrap-time
 
     load-components
 
-    millis over - core-bootstrap-time set-global
+    nano-count over - core-bootstrap-time set-global
 
     run-bootstrap-init
 
     f error set-global
     f error-continuation set-global
 
-    millis swap - bootstrap-time set-global
+    nano-count swap - bootstrap-time set-global
     print-report
 
     "deploy-vocab" get [

basis/cairo/cairo.factor

@@ -16,7 +16,7 @@ ERROR: cairo-error message ;
 
 : check-surface ( surface -- ) cairo_surface_status (check-cairo) ;
 
-: width>stride ( width -- stride ) "uint" heap-size * ; inline
+: width>stride ( width -- stride ) uint heap-size * ; inline
 
 : <image-surface> ( data dim -- surface )
     [ CAIRO_FORMAT_ARGB32 ] dip first2 over width>stride

basis/calendar/calendar-docs.factor

@@ -355,7 +355,7 @@ HELP: before
 
 HELP: <zero>
 { $values { "timestamp" timestamp } }
-{ $description "Outputs a zero timestamp that consists of zeros for every slot.  Used to see if timestamps are valid." } ;
+{ $description "Returns a zero timestamp that consists of zeros for every slot.  Used to see if timestamps are valid." } ;
 
 HELP: valid-timestamp?
 { $values { "timestamp" timestamp } { "?" "a boolean" } }
@@ -363,7 +363,7 @@ HELP: valid-timestamp?
 
 HELP: unix-1970
 { $values { "timestamp" timestamp } }
-{ $description "Outputs the beginning of UNIX time, or midnight, January 1, 1970." } ;
+{ $description "Returns the beginning of UNIX time, or midnight, January 1, 1970." } ;
 
 HELP: micros>timestamp
 { $values { "x" number } { "timestamp" timestamp } }
@@ -377,13 +377,13 @@ HELP: micros>timestamp
 
 HELP: gmt
 { $values { "timestamp" timestamp } }
-{ $description "Outputs the time right now, but in the GMT timezone." } ;
+{ $description "Returns the time right now, but in the GMT timezone." } ;
 
 { gmt now } related-words
 
 HELP: now
 { $values { "timestamp" timestamp } }
-{ $description "Outputs the time right now in your computer's timezone." }
+{ $description "Returns the time right now in your computer's timezone." }
 { $examples
     { $unchecked-example "USING: calendar prettyprint ;"
         "now ."
@@ -490,23 +490,23 @@ HELP: saturday
 
 HELP: midnight
 { $values { "timestamp" timestamp } { "new-timestamp" timestamp } }
-{ $description "Returns a timestamp that represents today at midnight, or the beginning of the day." } ;
+{ $description "Returns a new timestamp that represents today at midnight, or the beginning of the day." } ;
 
 HELP: noon
 { $values { "timestamp" timestamp } { "new-timestamp" timestamp } }
-{ $description "Returns a timestamp that represents today at noon, or the middle of the day." } ;
+{ $description "Returns a new timestamp that represents today at noon, or the middle of the day." } ;
 
 HELP: beginning-of-month
 { $values { "timestamp" timestamp } { "new-timestamp" timestamp } }
-{ $description "Outputs a timestamp with the day set to one." } ;
+{ $description "Returns a new timestamp with the day set to one." } ;
 
 HELP: beginning-of-week
 { $values { "timestamp" timestamp } { "new-timestamp" timestamp } }
-{ $description "Outputs a timestamp where the day of the week is Sunday." } ;
+{ $description "Returns a new timestamp where the day of the week is Sunday." } ;
 
 HELP: beginning-of-year
-{ $values { "timestamp" timestamp } { "new-timestamp" timestamp } }
-{ $description "Outputs a timestamp with the month and day set to one, or January 1 of the input timestamp." } ;
+{ $values { "object" object } { "new-timestamp" timestamp } }
+{ $description "Returns a new timestamp with the month and day set to one, or January 1 of the input timestamp, given a year or a timestamp." } ;
 
 HELP: time-since-midnight
 { $values { "timestamp" timestamp } { "duration" duration } }

basis/calendar/calendar-tests.factor

@@ -1,5 +1,6 @@
 USING: arrays calendar kernel math sequences tools.test
-continuations system math.order threads accessors ;
+continuations system math.order threads accessors
+random ;
 IN: calendar.tests
 
 [ f ] [ 2004 12 32 0   0  0 instant <timestamp> valid-timestamp? ] unit-test
@@ -139,7 +140,7 @@ 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>micros micros - 1000000 < ] unit-test
+[ t ] [ now timestamp>micros system-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
@@ -170,3 +171,8 @@ IN: calendar.tests
 [ f ] [ now dup midnight eq? ] unit-test
 [ f ] [ now dup easter eq? ] unit-test
 [ f ] [ now dup beginning-of-year eq? ] unit-test
+
+[ t ] [ 1325376000 unix-time>timestamp 2012 <year-gmt> = ] unit-test
+[ t ] [ 1356998399 unix-time>timestamp 2013 <year-gmt> 1 seconds time- = ] unit-test
+
+[ t ] [ 1500000000 random [ unix-time>timestamp timestamp>unix-time ] keep = ] unit-test

basis/calendar/calendar.factor

@@ -17,6 +17,8 @@ TUPLE: duration
 
 C: <duration> duration
 
+: instant ( -- duration ) 0 0 0 0 0 0 <duration> ;
+
 TUPLE: timestamp
     { year integer }
     { month integer }
@@ -34,6 +36,15 @@ C: <timestamp> timestamp
 : <date> ( year month day -- timestamp )
     0 0 0 gmt-offset-duration <timestamp> ;
 
+: <date-gmt> ( year month day -- timestamp )
+    0 0 0 instant <timestamp> ;
+
+: <year> ( year -- timestamp )
+    1 1 <date> ;
+
+: <year-gmt> ( year -- timestamp )
+    1 1 <date-gmt> ;
+
 ERROR: not-a-month ;
 M: not-a-month summary
     drop "Months are indexed starting at 1" ;
@@ -132,8 +143,7 @@ GENERIC: easter ( obj -- obj' )
     32 2 e * + 2 i * + h - k - 7 mod :> l
     a 11 h * + 22 l * + 451 /i :> m
 
-    h l + 7 m * - 114 + 31 /mod 1 + :> ( month day )
-    month day ;
+    h l + 7 m * - 114 + 31 /mod 1 + ;
 
 M: integer easter ( year -- timestamp )
     dup easter-month-day <date> ;
@@ -149,7 +159,6 @@ M: timestamp easter ( timestamp -- timestamp )
 : >time< ( timestamp -- hour minute second )
     [ hour>> ] [ minute>> ] [ second>> ] tri ;
 
-: instant ( -- duration ) 0 0 0 0 0 0 <duration> ;
 : years ( x -- duration ) instant clone swap >>year ;
 : months ( x -- duration ) instant clone swap >>month ;
 : days ( x -- duration ) instant clone swap >>day ;
@@ -376,7 +385,7 @@ M: duration time-
 
 : 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+ ;
@@ -430,6 +439,9 @@ M: timestamp day-name day-of-week day-names nth ;
 : beginning-of-month ( timestamp -- new-timestamp )
     midnight 1 >>day ;
 
+: end-of-month ( timestamp -- new-timestamp )
+    [ midnight ] [ days-in-month ] bi >>day ;
+
 <PRIVATE
 
 : day-offset ( timestamp m -- new-timestamp n )
@@ -522,8 +534,13 @@ M: timestamp december clone 12 >>month ;
 : beginning-of-week ( timestamp -- new-timestamp )
     midnight sunday ;
 
-: beginning-of-year ( timestamp -- new-timestamp )
-    beginning-of-month 1 >>month ;
+GENERIC: beginning-of-year ( object -- new-timestamp )
+M: timestamp beginning-of-year beginning-of-month 1 >>month ;
+M: integer beginning-of-year <year> ;
+
+GENERIC: end-of-year ( object -- new-timestamp )
+M: timestamp end-of-year 12 >>month 31 >>day ;
+M: integer end-of-year 12 31 <date> ;
 
 : time-since-midnight ( timestamp -- duration )
     dup midnight time- ;
@@ -531,9 +548,13 @@ M: timestamp december clone 12 >>month ;
 : since-1970 ( duration -- timestamp )
     unix-1970 time+ >local-time ;
 
-M: timestamp sleep-until timestamp>micros sleep-until ;
+: timestamp>unix-time ( timestamp -- seconds )
+    unix-1970 time- second>> ;
 
-M: duration sleep hence sleep-until ;
+: unix-time>timestamp ( seconds -- timestamp )
+    seconds unix-1970 time+ ;
+
+M: duration sleep duration>nanoseconds nano-count + sleep-until ;
 
 {
     { [ os unix? ] [ "calendar.unix" ] }

basis/calendar/model/model.factor

@@ -16,4 +16,4 @@ SYMBOL: time
     ] "Time model update" spawn drop ;
 
 f <model> time set-global
-[ time-thread ] "calendar.model" add-init-hook
+[ time-thread ] "calendar.model" add-startup-hook

basis/calendar/unix/unix.factor

@@ -14,6 +14,9 @@ IN: calendar.unix
 : timespec>seconds ( timespec -- seconds )
     [ sec>> seconds ] [ nsec>> nanoseconds ] bi time+ ;
 
+: timespec>nanoseconds ( timespec -- seconds )
+    [ sec>> 1000000000 * ] [ nsec>> ] bi + ;
+
 : timespec>unix-time ( timespec -- timestamp )
     timespec>seconds since-1970 ;
 

basis/channels/remote/remote.factor

@@ -69,4 +69,4 @@ M: remote-channel from ( remote-channel -- value )
 [
     H{ } clone \ remote-channels set-global
     start-channel-node
-] "channel-registry" add-init-hook
+] "channel-registry" add-startup-hook

basis/classes/struct/struct.factor

@@ -278,8 +278,9 @@ M: struct binary-zero? >c-ptr [ 0 = ] all? ;
     slots empty? [ struct-must-have-slots ] when
     class redefine-struct-tuple-class
     slots make-slots dup check-struct-slots :> slot-specs
+    slot-specs offsets-quot call :> unaligned-size
     slot-specs struct-alignment :> alignment
-    slot-specs offsets-quot call alignment align :> size
+    unaligned-size alignment align :> size
 
     class  slot-specs  size  alignment  c-type-for-class :> c-type
 

basis/cocoa/application/application.factor

@@ -49,7 +49,7 @@ TUPLE: objc-error alien reason ;
 M: objc-error summary ( error -- )
     drop "Objective C exception" ;
 
-[ [ objc-error ] 19 setenv ] "cocoa.application" add-init-hook
+[ [ objc-error ] 19 setenv ] "cocoa.application" add-startup-hook
 
 : running.app? ( -- ? )
     #! Test if we're running a .app.

basis/cocoa/cocoa.factor

@@ -27,7 +27,7 @@ SYMBOL: frameworks
 
 frameworks [ V{ } clone ] initialize
 
-[ frameworks get [ load-framework ] each ] "cocoa" add-init-hook
+[ frameworks get [ load-framework ] each ] "cocoa" add-startup-hook
 
 SYNTAX: FRAMEWORK: scan [ load-framework ] [ frameworks get push ] bi ;
 

basis/cocoa/messages/messages.factor

@@ -76,13 +76,13 @@ MACRO: (send) ( selector super? -- quot )
 : super-send ( receiver args... selector -- return... ) t (send) ; inline
 
 ! Runtime introspection
-SYMBOL: class-init-hooks
+SYMBOL: class-startup-hooks
 
-class-init-hooks [ H{ } clone ] initialize
+class-startup-hooks [ H{ } clone ] initialize
 
 : (objc-class) ( name word -- class )
     2dup execute dup [ 2nip ] [
-        drop over class-init-hooks get at [ call( -- ) ] when*
+        drop over class-startup-hooks get at [ call( -- ) ] when*
         2dup execute dup [ 2nip ] [
             2drop "No such class: " prepend throw
         ] if
@@ -229,7 +229,7 @@ ERROR: no-objc-type name ;
 : class-exists? ( string -- class ) objc_getClass >boolean ;
 
 : define-objc-class-word ( quot name -- )
-    [ class-init-hooks get set-at ]
+    [ class-startup-hooks get set-at ]
     [
         [ "cocoa.classes" create ] [ '[ _ objc-class ] ] bi
         (( -- class )) define-declared

basis/command-line/command-line.factor

@@ -69,4 +69,4 @@ SYMBOL: main-vocab-hook
 : ignore-cli-args? ( -- ? )
     os macosx? "run" get "ui" = and ;
 
-[ default-cli-args ] "command-line" add-init-hook
+[ default-cli-args ] "command-line" add-startup-hook

basis/compiler/cfg/cfg.factor

@@ -4,7 +4,7 @@ USING: kernel math vectors arrays accessors namespaces ;
 IN: compiler.cfg
 
 TUPLE: basic-block < identity-tuple
-id
+{ id integer }
 number
 { instructions vector }
 { successors vector }

basis/compiler/tree/propagation/transforms/transforms.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008, 2009 Slava Pestov, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences words fry generic accessors
+USING: alien.c-types kernel sequences words fry generic accessors
 classes.tuple classes classes.algebra definitions
 stack-checker.dependencies quotations classes.tuple.private math
 math.partial-dispatch math.private math.intervals sets.private
@@ -8,6 +8,7 @@ math.floats.private math.integers.private layouts math.order
 vectors hashtables combinators effects generalizations assocs
 sets combinators.short-circuit sequences.private locals growable
 stack-checker namespaces compiler.tree.propagation.info ;
+FROM: math => float ;
 IN: compiler.tree.propagation.transforms
 
 \ equal? [
@@ -307,3 +308,11 @@ CONSTANT: lookup-table-at-max 256
     in-d>> second value-info class>> growable class<=
     [ \ push def>> ] [ f ] if
 ] "custom-inlining" set-word-prop
+
+! We want to constant-fold calls to heap-size, and recompile those
+! calls when a C type is redefined
+\ heap-size [
+    dup word? [
+        [ inlined-dependency depends-on ] [ heap-size '[ _ ] ] bi
+    ] [ drop f ] if
+] 1 define-partial-eval

basis/concurrency/distributed/distributed.factor

@@ -60,6 +60,4 @@ M: thread (serialize) ( obj -- )
 
 [
     H{ } clone \ registered-remote-threads set-global
-] "remote-thread-registry" add-init-hook
-
-
+] "remote-thread-registry" add-startup-hook

basis/core-foundation/fsevents/fsevents.factor

@@ -156,7 +156,7 @@ SYMBOL: event-stream-callbacks
 [
     event-stream-callbacks
     [ [ drop expired? not ] assoc-filter H{ } assoc-like ] change-global
-] "core-foundation" add-init-hook
+] "core-foundation" add-startup-hook
 
 : add-event-source-callback ( quot -- id )
     event-stream-counter <alien>

basis/core-foundation/run-loop/run-loop.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien alien.c-types alien.syntax kernel math
 namespaces sequences destructors combinators threads heaps
-deques calendar core-foundation core-foundation.strings
+deques calendar system core-foundation core-foundation.strings
 core-foundation.file-descriptors core-foundation.timers
 core-foundation.time ;
 IN: core-foundation.run-loop
@@ -96,12 +96,15 @@ TUPLE: run-loop fds sources timers ;
 : ((reset-timer)) ( timer counter timestamp -- )
     nip >CFAbsoluteTime CFRunLoopTimerSetNextFireDate ;
 
+: nano-count>timestamp ( x -- timestamp )
+    nano-count - nanoseconds now time+ ;
+
 : (reset-timer) ( timer counter -- )
     yield {
         { [ dup 0 = ] [ now ((reset-timer)) ] }
         { [ run-queue deque-empty? not ] [ 1 - (reset-timer) ] }
         { [ sleep-queue heap-empty? ] [ 5 minutes hence ((reset-timer)) ] }
-        [ sleep-queue heap-peek nip micros>timestamp ((reset-timer)) ]
+        [ sleep-queue heap-peek nip nano-count>timestamp ((reset-timer)) ]
     } cond ;
 
 : reset-timer ( timer -- )
@@ -121,8 +124,8 @@ PRIVATE>
 : init-thread-timer ( -- )
     timer-callback <CFTimer> add-timer-to-run-loop ;
 
-: run-one-iteration ( us -- handled? )
+: run-one-iteration ( nanos -- handled? )
     reset-run-loop
     CFRunLoopDefaultMode
-    swap [ microseconds ] [ 5 minutes ] if* >CFTimeInterval
+    swap [ nanoseconds ] [ 5 minutes ] if* >CFTimeInterval
     t CFRunLoopRunInMode kCFRunLoopRunHandledSource = ;

basis/core-text/core-text.factor

@@ -149,4 +149,4 @@ SYMBOL: cached-lines
 : cached-line ( font string -- line )
     cached-lines get [ <line> ] 2cache ;
 
-[ <cache-assoc> cached-lines set-global ] "core-text" add-init-hook
+[ <cache-assoc> cached-lines set-global ] "core-text" add-startup-hook

basis/core-text/fonts/fonts.factor

@@ -127,4 +127,4 @@ MEMO: (cache-font-metrics) ( font -- metrics )
 [
     \ (cache-font) reset-memoized
     \ (cache-font-metrics) reset-memoized
-] "core-text.fonts" add-init-hook
+] "core-text.fonts" add-startup-hook

basis/cpu/x86/64/winnt/bootstrap.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: bootstrap.image.private kernel namespaces system
-layouts vocabs parser sequences cpu.x86.assembler parser
+USING: bootstrap.image.private kernel namespaces system layouts
+vocabs sequences cpu.x86.assembler parser
 cpu.x86.assembler.operands ;
 IN: bootstrap.x86
 

basis/cpu/x86/features/features.factor

@@ -17,7 +17,7 @@ MEMO: sse-version ( -- n )
     sse_version
     "sse-version" get string>number [ min ] when* ;
 
-[ \ sse-version reset-memoized ] "cpu.x86.features" add-init-hook
+[ \ sse-version reset-memoized ] "cpu.x86.features" add-startup-hook
 
 : sse? ( -- ? ) sse-version 10 >= ;
 : sse2? ( -- ? ) sse-version 20 >= ;

basis/cpu/x86/x86.factor

@@ -1413,7 +1413,7 @@ enable-fixnum-log2
             flush
             1 exit
         ] when
-    ] "cpu.x86" add-init-hook ;
+    ] "cpu.x86" add-startup-hook ;
 
 : enable-sse2 ( version -- )
     20 >= [

basis/db/sqlite/lib/lib.factor

@@ -32,14 +32,14 @@ ERROR: sqlite-sql-error < sql-error n string ;
 
 : sqlite-open ( path -- db )
     normalize-path
-    "void*" <c-object>
+    void* <c-object>
     [ sqlite3_open sqlite-check-result ] keep *void* ;
 
 : sqlite-close ( db -- )
     sqlite3_close sqlite-check-result ;
 
 : sqlite-prepare ( db sql -- handle )
-    utf8 encode dup length "void*" <c-object> "void*" <c-object>
+    utf8 encode dup length void* <c-object> void* <c-object>
     [ sqlite3_prepare_v2 sqlite-check-result ] 2keep
     drop *void* ;
 

basis/debugger/windows/tags.txt

@@ -0,0 +1 @@
+unportable

basis/editors/editors.factor

@@ -49,7 +49,7 @@ M: cannot-find-source error.
 
 : edit-error ( error -- )
     [ error-file ] [ error-line ] bi
-    2dup and [ edit-location ] [ 2drop ] if ;
+    over [ 1 or edit-location ] [ 2drop ] if ;
 
 : :edit ( -- )
     error get edit-error ;

basis/environment/environment.factor

@@ -32,4 +32,4 @@ HOOK: (set-os-envs) os ( seq -- )
         os windows? ";" ":" ? split
         [ add-vocab-root ] each
     ] when*    
-] "environment" add-init-hook
+] "environment" add-startup-hook

basis/furnace/cache/cache.factor

@@ -22,7 +22,7 @@ server-state f
 
 : expire-state ( class -- )
     new
-        -1/0. millis [a,b] >>expires
+        -1/0. system-micros [a,b] >>expires
     delete-tuples ;
 
 TUPLE: server-state-manager < filter-responder timeout ;
@@ -33,4 +33,4 @@ TUPLE: server-state-manager < filter-responder timeout ;
         20 minutes >>timeout ; inline
 
 : touch-state ( state manager -- )
-    timeout>> hence timestamp>millis >>expires drop ;
+    timeout>> hence timestamp>micros >>expires drop ;

basis/game/input/input.factor

@@ -35,7 +35,7 @@ M: f (reset-game-input) ;
 : reset-game-input ( -- )
     (reset-game-input) ;
 
-[ reset-game-input ] "game-input" add-init-hook
+[ reset-game-input ] "game-input" add-startup-hook
 
 PRIVATE>
 

basis/game/input/iokit/iokit.factor

@@ -4,7 +4,7 @@ sequences locals combinators.short-circuit threads
 namespaces assocs arrays combinators hints alien
 core-foundation.run-loop accessors sequences.private
 alien.c-types alien.data math parser game.input vectors
-bit-arrays ;
+bit-arrays unix.types ;
 IN: game.input.iokit
 
 SINGLETON: iokit-game-input-backend