diff --git a/extra/builder/test/test.factor b/extra/builder/test/test.factor index 957af28dc1..2a0769f278 100644 --- a/extra/builder/test/test.factor +++ b/extra/builder/test/test.factor @@ -3,6 +3,7 @@ USING: kernel namespaces assocs io.files io.encodings.utf8 prettyprint help.lint benchmark + tools.time bootstrap.stage2 tools.test tools.vocabs builder.util ; @@ -26,8 +27,8 @@ IN: builder.test : do-all ( -- ) bootstrap-time get "../boot-time" utf8 [ . ] with-file-writer - [ do-load ] runtime "../load-time" utf8 [ . ] with-file-writer - [ do-tests ] runtime "../test-time" utf8 [ . ] with-file-writer + [ do-load ] benchmark "../load-time" utf8 [ . ] with-file-writer + [ do-tests ] benchmark "../test-time" utf8 [ . ] with-file-writer do-help-lint do-benchmarks ; diff --git a/extra/builder/util/util.factor b/extra/builder/util/util.factor index c40efaaa04..f9ab6c1d1d 100644 --- a/extra/builder/util/util.factor +++ b/extra/builder/util/util.factor @@ -12,8 +12,6 @@ IN: builder.util ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: runtime ( quot -- time ) benchmark nip ; - : minutes>ms ( min -- ms ) 60 * 1000 * ; : file>string ( file -- string ) utf8 file-contents ; diff --git a/extra/io/launcher/launcher.factor b/extra/io/launcher/launcher.factor index e9fbdaea62..e8eb973e34 100755 --- a/extra/io/launcher/launcher.factor +++ b/extra/io/launcher/launcher.factor @@ -221,3 +221,9 @@ M: duplex-stream underlying-handle [ in>> underlying-handle ] [ out>> underlying-handle ] bi [ = [ "Invalid duplex stream" throw ] when ] keep ; + +M: encoder underlying-handle + stream>> underlying-handle ; + +M: decoder underlying-handle + stream>> underlying-handle ; diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor index a09ebb46c9..b361974a20 100755 --- a/extra/io/unix/files/files.factor +++ b/extra/io/unix/files/files.factor @@ -45,9 +45,10 @@ M: unix (file-appender) ( path -- stream ) M: unix touch-file ( path -- ) normalize-path - touch-mode file-mode open - dup 0 < [ err_no EEXIST = [ err_no io-error ] unless ] when - close ; + dup exists? + [ f utime ] + [ touch-mode file-mode open close ] + if ; M: unix move-file ( from to -- ) [ normalize-path ] bi@ rename io-error ; diff --git a/extra/tools/time/time-docs.factor b/extra/tools/time/time-docs.factor index c0afa920c4..5fedba1700 100644 --- a/extra/tools/time/time-docs.factor +++ b/extra/tools/time/time-docs.factor @@ -14,7 +14,8 @@ ARTICLE: "timing" "Timing code" ABOUT: "timing" HELP: benchmark -{ $values { "quot" "a quotation" } { "gctime" "an integer denoting milliseconds" } { "runtime" "an integer denoting milliseconds" } } +{ $values { "quot" "a quotation" } + { "runtime" "an integer denoting milliseconds" } } { $description "Runs a quotation, measuring the total wall clock time and the total time spent in the garbage collector." } { $notes "A nicer word for interactive use is " { $link time } "." } ; diff --git a/extra/tools/time/time.factor b/extra/tools/time/time.factor index 0a0121c74e..82d3491743 100644 --- a/extra/tools/time/time.factor +++ b/extra/tools/time/time.factor @@ -4,7 +4,7 @@ USING: kernel math math.vectors memory io io.styles prettyprint namespaces system sequences splitting assocs strings ; IN: tools.time -: benchmark ( quot -- gctime runtime ) +: benchmark ( quot -- runtime ) millis >r call millis r> - ; inline : simple-table. ( values -- ) diff --git a/extra/ui/ui.factor b/extra/ui/ui.factor index e864d39f39..7aca45a210 100755 --- a/extra/ui/ui.factor +++ b/extra/ui/ui.factor @@ -41,8 +41,9 @@ SYMBOL: stop-after-last-window? windows global [ [ first = not ] with filter ] change-at ; : raised-window ( world -- ) - windows get-global [ second eq? ] with find drop - windows get-global [ length 1- ] keep exchange ; + windows get-global + [ [ second eq? ] with find drop ] keep + [ nth ] [ delete-nth ] [ nip ] 2tri push ; : focus-gestures ( new old -- ) drop-prefix diff --git a/extra/unix/ffi/ffi.factor b/extra/unix/ffi/ffi.factor index 11a8405b1d..ec3daab880 100644 --- a/extra/unix/ffi/ffi.factor +++ b/extra/unix/ffi/ffi.factor @@ -3,4 +3,10 @@ USING: alien.syntax ; IN: unix.ffi -FUNCTION: int open ( char* path, int flags, int prot ) ; \ No newline at end of file +FUNCTION: int open ( char* path, int flags, int prot ) ; + +C-STRUCT: utimbuf + { "time_t" "actime" } + { "time_t" "modtime" } ; + +FUNCTION: int utime ( char* path, utimebuf* buf ) ; \ No newline at end of file diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor index bc3e3ca162..fcbd96177b 100755 --- a/extra/unix/unix.factor +++ b/extra/unix/unix.factor @@ -86,6 +86,12 @@ ERROR: open-error path flags prot message ; 3dup unix.ffi:open dup 0 >= [ >r 3drop r> ] [ drop err_no strerror open-error ] if ; +ERROR: utime-error path message ; + +: utime ( path buf -- ) + dupd unix.ffi:utime + 0 = [ drop ] [ err_no strerror utime-error ] if ; + FUNCTION: int pclose ( void* file ) ; FUNCTION: int pipe ( int* filedes ) ; FUNCTION: void* popen ( char* command, char* type ) ; diff --git a/extra/windows/com/wrapper/wrapper.factor b/extra/windows/com/wrapper/wrapper.factor old mode 100644 new mode 100755 index 7f63f529a6..ae5f03a594 --- a/extra/windows/com/wrapper/wrapper.factor +++ b/extra/windows/com/wrapper/wrapper.factor @@ -29,7 +29,7 @@ unless >r find-com-interface-definition family-tree r> 1quotation [ >r iid>> r> 2array ] curry map ] map-index concat - [ f ] add , + [ f ] prefix , \ case , "void*" heap-size [ * rot com-add-ref 0 rot set-void*-nth S_OK ] @@ -99,7 +99,7 @@ unless PRIVATE> : ( implementations -- wrapper ) - (make-vtbls) f com-wrapper construct-boa ; + (make-vtbls) f com-wrapper boa ; M: com-wrapper dispose t >>freed?