From 2235eadf0452f8842fbf324f606c7a794d65b106 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Tue, 17 Dec 2019 20:03:45 -0800 Subject: [PATCH 01/40] timers: simplify by setting delay-nanos directly. --- basis/timers/timers.factor | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/basis/timers/timers.factor b/basis/timers/timers.factor index 57006c1bd9..65064adb29 100644 --- a/basis/timers/timers.factor +++ b/basis/timers/timers.factor @@ -29,11 +29,7 @@ M: duration >nanoseconds duration>nanoseconds >integer ; [ dupd [ mod ] [ swap - ] bi + + ] [ 2drop f ] if* ; : next-nanos ( timer -- timer n/f ) - dup thread>> self eq? [ - dup next-nanos>> dup t eq? [ - drop dup delay-nanos [ >>next-nanos ] keep - ] when - ] [ f ] if ; + dup thread>> self eq? [ dup next-nanos>> ] [ f ] if ; : run-timer ( timer -- timer ) dup interval-nanos >>next-nanos @@ -65,7 +61,7 @@ ERROR: timer-already-started timer ; : start-timer ( timer -- ) dup thread>> [ timer-already-started ] when - t >>next-nanos + dup delay-nanos >>next-nanos dup '[ _ timer-loop ] "Timer" [ >>thread drop ] [ (spawn) ] bi ; @@ -74,7 +70,8 @@ ERROR: timer-already-started timer ; : restart-timer ( timer -- ) dup thread>> [ - t >>next-nanos [ thread>> ] [ ?interrupt ] bi + dup delay-nanos >>next-nanos + [ thread>> ] [ ?interrupt ] bi ] [ start-timer ] if ; From 3419d34cbffe32bfd9245b966e27d1ede03870a8 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 3 Jan 2020 10:48:24 -0600 Subject: [PATCH 02/40] mason.disk: Better handling of free disk space. - Works if the build directory does not exist, assuming it would be created on the root disk containing the path of the first existing parent directory - Space calculation is wrong, we should be using the available space - MB is GB, comment was wrong - Call find-mount-point-info to get the real disk mount point even if the dir does not exist --- basis/io/files/info/info.factor | 14 ++++++++++ basis/io/files/info/unix/linux/linux.factor | 13 +-------- extra/mason/disk/disk.factor | 31 +++++++++++---------- 3 files changed, 32 insertions(+), 26 deletions(-) diff --git a/basis/io/files/info/info.factor b/basis/io/files/info/info.factor index f5c45881b6..57f7e730d2 100644 --- a/basis/io/files/info/info.factor +++ b/basis/io/files/info/info.factor @@ -34,6 +34,20 @@ HOOK: file-readable? os ( path -- ? ) HOOK: file-writable? os ( path -- ? ) HOOK: file-executable? os ( path -- ? ) +: mount-points ( -- assoc ) + file-systems [ [ mount-point>> ] keep ] H{ } map>assoc ; + +: (find-mount-point-info) ( path assoc -- mtab-entry ) + [ resolve-symlinks ] dip + 2dup at* [ + 2nip + ] [ + drop [ parent-directory ] dip (find-mount-point-info) + ] if ; + +: find-mount-point-info ( path -- file-system-info ) + mount-points (find-mount-point-info) ; + { { [ os unix? ] [ "io.files.info.unix" ] } { [ os windows? ] [ "io.files.info.windows" ] } diff --git a/basis/io/files/info/unix/linux/linux.factor b/basis/io/files/info/unix/linux/linux.factor index dd04aecf6d..1bf37532f1 100644 --- a/basis/io/files/info/unix/linux/linux.factor +++ b/basis/io/files/info/unix/linux/linux.factor @@ -81,17 +81,6 @@ frequency pass-number ; M: linux file-systems parse-mtab [ mtab-entry>file-system-info ] map sift ; -: (find-mount-point) ( path mtab-paths -- mtab-entry ) - 2dup at* [ - 2nip - ] [ - drop [ parent-directory ] dip (find-mount-point) - ] if ; - -: find-mount-point ( path -- mtab-entry ) - resolve-symlinks - parse-mtab [ [ mount-point>> ] keep ] H{ } map>assoc (find-mount-point) ; - M: linux file-system-info ( path -- file-system-info ) normalize-path [ @@ -100,7 +89,7 @@ M: linux file-system-info ( path -- file-system-info ) [ file-system-statvfs statvfs>file-system-info ] bi file-system-calculations ] keep - find-mount-point + find-mount-point-info { [ file-system-name>> >>device-name drop ] [ mount-point>> >>mount-point drop ] diff --git a/extra/mason/disk/disk.factor b/extra/mason/disk/disk.factor index 214b8f13fe..88b0414fe4 100644 --- a/extra/mason/disk/disk.factor +++ b/extra/mason/disk/disk.factor @@ -1,26 +1,29 @@ -! Copyright (C) 2010 Slava Pestov. +! Copyright (C) 2010 Slava Pestov, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors io.files.info io.pathnames kernel mason.config -math math.parser namespaces sequences ; +USING: accessors formatting io.files.info io.pathnames kernel +mason.config math namespaces ; IN: mason.disk -: gb ( -- n ) 30 2^ ; inline +: Gi ( n -- gibibits ) 30 2^ * ; inline : sufficient-disk-space? ( -- ? ) - ! We want at least 300Mb to be available before starting - ! a build. - "." file-system-info available-space>> gb > ; + current-directory get find-mount-point-info + file-system-info available-space>> + 1 Gi > ; : check-disk-space ( -- ) sufficient-disk-space? [ - "Less than 1 Gb free disk space." throw + "Less than 1 Gi free disk space." throw ] unless ; -: mb-str ( n -- string ) gb /i number>string ; +: Gi-str ( n -- string ) 1 Gi /f ; + +: path>disk-usage ( path -- string ) + find-mount-point-info + [ used-space>> ] [ available-space>> ] [ total-space>> ] tri + 2dup /f 100 * + [ [ Gi-str ] tri@ ] dip + "%0.2fGi used, %0.2fGi avail, %0.2fGi total, %0.2f%% free" sprintf ; : disk-usage ( -- string ) - builds-dir get file-system-info - [ used-space>> ] [ total-space>> ] bi - [ [ mb-str ] bi@ " / " glue " Gb used" append ] - [ [ 100 * ] dip /i number>string "(" "%)" surround ] 2bi - " " glue ; + builds-dir get path>disk-usage ; \ No newline at end of file From 16c153411ddebb697a3430683a7ae102b78c962d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 3 Jan 2020 12:42:11 -0600 Subject: [PATCH 03/40] io: Trim using lists. --- basis/io/files/info/info.factor | 4 ++-- basis/io/files/temp/macosx/macosx.factor | 4 ++-- basis/io/mmap/unix/unix.factor | 3 +-- basis/io/ports/ports.factor | 6 +++--- core/io/files/files.factor | 5 +++-- 5 files changed, 11 insertions(+), 11 deletions(-) diff --git a/basis/io/files/info/info.factor b/basis/io/files/info/info.factor index 57f7e730d2..917327fa43 100644 --- a/basis/io/files/info/info.factor +++ b/basis/io/files/info/info.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman, Eduardo Cavazos. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel system sequences combinators -vocabs vocabs.loader io.files io.files.types math ; +USING: accessors assocs combinators io.files io.files.types +io.pathnames kernel math system vocabs ; IN: io.files.info ! File info diff --git a/basis/io/files/temp/macosx/macosx.factor b/basis/io/files/temp/macosx/macosx.factor index ef88fbe532..07451b2f8b 100644 --- a/basis/io/files/temp/macosx/macosx.factor +++ b/basis/io/files/temp/macosx/macosx.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2012 Joe Groff. ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types alien.syntax cocoa.plists cocoa.runtime -cocoa.types core-foundation.strings io.directories io.files -io.files.temp io.pathnames kernel sequences system ; +cocoa.types core-foundation.strings io.files io.files.temp +io.pathnames kernel sequences system ; IN: io.files.temp.macosx Date: Fri, 3 Jan 2020 13:02:57 -0600 Subject: [PATCH 04/40] Revert "windows.errors: streamline error handling and throwing" This reverts commit ca474dd154c8ce59b4a1e40281a4b9fc6e182a1a. --- basis/windows/errors/authors.txt | 1 - basis/windows/errors/errors.factor | 19 ++++++++++++------- 2 files changed, 12 insertions(+), 8 deletions(-) diff --git a/basis/windows/errors/authors.txt b/basis/windows/errors/authors.txt index d652f68ac8..7c1b2f2279 100644 --- a/basis/windows/errors/authors.txt +++ b/basis/windows/errors/authors.txt @@ -1,2 +1 @@ Doug Coleman -Alexander Ilin diff --git a/basis/windows/errors/errors.factor b/basis/windows/errors/errors.factor index ffb735be08..f5e5314e2f 100644 --- a/basis/windows/errors/errors.factor +++ b/basis/windows/errors/errors.factor @@ -719,18 +719,23 @@ CONSTANT: FORMAT_MESSAGE_MAX_WIDTH_MASK 0x000000FF ERROR: windows-error n string ; -: throw-windows-error ( n -- * ) - dup n>win32-error-string windows-error ; +: (win32-error) ( n -- ) + [ dup win32-error-string windows-error ] unless-zero ; -: n>win32-error-check ( n -- ) - [ throw-windows-error ] unless-zero ; +: win32-error ( -- ) + GetLastError (win32-error) ; -! Note that win32-error* words throw GetLastError code. -: win32-error ( -- ) GetLastError n>win32-error-check ; : win32-error=0/f ( n -- ) { 0 f } member? [ win32-error ] when ; : win32-error>0 ( n -- ) 0 > [ win32-error ] when ; : win32-error<0 ( n -- ) 0 < [ win32-error ] when ; -: win32-error<>0 ( n -- ) [ win32-error ] unless-zero ; +: win32-error<>0 ( n -- ) zero? [ win32-error ] unless ; + +: n>win32-error-check ( n -- ) + dup ERROR_SUCCESS = [ + drop + ] [ + dup n>win32-error-string windows-error + ] if ; : check-invalid-handle ( handle -- handle ) dup INVALID_HANDLE_VALUE = [ win32-error ] when ; From 7f395ba7f0e3e0bf24d902f3193c0e65ba0a2527 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 3 Jan 2020 13:03:10 -0600 Subject: [PATCH 05/40] Revert "Replace "win32-error-string throw" with windows-error instance throwing" This reverts commit 2dfb3b3a73bd2ac1200b9f5f7161a2510a98cebc. --- basis/alien/libraries/windows/windows.factor | 5 ++--- basis/calendar/windows/windows.factor | 2 +- basis/io/files/info/windows/windows.factor | 4 ++-- basis/io/sockets/secure/windows/windows.factor | 2 +- basis/windows/errors/errors.factor | 3 +++ extra/talks/tc-lisp-talk/tc-lisp-talk.factor | 2 +- 6 files changed, 10 insertions(+), 8 deletions(-) diff --git a/basis/alien/libraries/windows/windows.factor b/basis/alien/libraries/windows/windows.factor index 03a2e8b8d4..249bcff57a 100644 --- a/basis/alien/libraries/windows/windows.factor +++ b/basis/alien/libraries/windows/windows.factor @@ -1,9 +1,8 @@ -USING: alien.libraries io.pathnames system windows.errors -windows.kernel32 ; +USING: alien.libraries io.pathnames system windows.errors ; IN: alien.libraries.windows M: windows >deployed-library-path file-name ; M: windows dlerror ( -- message ) - GetLastError n>win32-error-string ; + win32-error-string ; diff --git a/basis/calendar/windows/windows.factor b/basis/calendar/windows/windows.factor index f866fe81fa..80253ea91b 100644 --- a/basis/calendar/windows/windows.factor +++ b/basis/calendar/windows/windows.factor @@ -31,7 +31,7 @@ IN: calendar.windows M: windows gmt-offset ( -- hours minutes seconds ) TIME_ZONE_INFORMATION dup GetTimeZoneInformation { - { TIME_ZONE_ID_INVALID [ win32-error ] } + { TIME_ZONE_ID_INVALID [ win32-error-string throw ] } { TIME_ZONE_ID_UNKNOWN [ Bias>> ] } { TIME_ZONE_ID_STANDARD [ Bias>> ] } { TIME_ZONE_ID_DAYLIGHT [ [ Bias>> ] [ DaylightBias>> ] bi + ] } diff --git a/basis/io/files/info/windows/windows.factor b/basis/io/files/info/windows/windows.factor index 99eccd1c0f..90d17a03d5 100644 --- a/basis/io/files/info/windows/windows.factor +++ b/basis/io/files/info/windows/windows.factor @@ -19,7 +19,7 @@ TUPLE: windows-file-info < file-info-tuple attributes ; : get-compressed-file-size ( path -- n ) { DWORD } [ GetCompressedFileSize ] with-out-parameters - over INVALID_FILE_SIZE = [ win32-error ] [ >64bit ] if ; + over INVALID_FILE_SIZE = [ win32-error-string throw ] [ >64bit ] if ; : set-windows-size-on-disk ( file-info path -- file-info ) over attributes>> +compressed+ swap member? [ @@ -183,7 +183,7 @@ CONSTANT: names-buf-length 16384 [ path-length FindNextVolume ] with-out-parameters swap 0 = [ GetLastError ERROR_NO_MORE_FILES = - [ drop f ] [ win32-error ] if + [ drop f ] [ win32-error-string throw ] if ] [ alien>native-string ] if ; : find-volumes ( -- array ) diff --git a/basis/io/sockets/secure/windows/windows.factor b/basis/io/sockets/secure/windows/windows.factor index c1b8e3936d..59eccfed19 100644 --- a/basis/io/sockets/secure/windows/windows.factor +++ b/basis/io/sockets/secure/windows/windows.factor @@ -14,7 +14,7 @@ M: openssl ssl-certificate-verification-supported? f ; : load-windows-cert-store ( string -- HCERTSTORE ) [ f ] dip CertOpenSystemStore - [ win32-error ] when-zero ; + [ win32-error-string throw ] when-zero ; : X509-NAME. ( X509_NAME -- ) f 0 X509_NAME_oneline diff --git a/basis/windows/errors/errors.factor b/basis/windows/errors/errors.factor index f5e5314e2f..5679a62eba 100644 --- a/basis/windows/errors/errors.factor +++ b/basis/windows/errors/errors.factor @@ -717,6 +717,9 @@ CONSTANT: FORMAT_MESSAGE_MAX_WIDTH_MASK 0x000000FF [ drop "Unknown error 0x" id 0xffff,ffff bitand >hex append ] [ alien>native-string [ blank? ] trim ] if ; +: win32-error-string ( -- str ) + GetLastError n>win32-error-string ; + ERROR: windows-error n string ; : (win32-error) ( n -- ) diff --git a/extra/talks/tc-lisp-talk/tc-lisp-talk.factor b/extra/talks/tc-lisp-talk/tc-lisp-talk.factor index c0353a3e40..8a6b5d97e5 100644 --- a/extra/talks/tc-lisp-talk/tc-lisp-talk.factor +++ b/extra/talks/tc-lisp-talk/tc-lisp-talk.factor @@ -456,7 +456,7 @@ xyz \"TIME_ZONE_INFORMATION\" dup GetTimeZoneInformation { { TIME_ZONE_ID_INVALID [ - win32-error + win32-error-string throw ] } { TIME_ZONE_ID_STANDARD [ TIME_ZONE_INFORMATION-Bias From c308d794dbb78fb60d7a541e80c4455d27f46d2f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 3 Jan 2020 13:03:52 -0600 Subject: [PATCH 06/40] Revert "Replace "n>win32-error-string throw" with windows-error instance throwing" This reverts commit 70d08ce743d8bae6001f28baf8cc0f13afc93c10. --- basis/io/files/windows/windows.factor | 4 ++-- basis/windows/registry/registry.factor | 8 ++++++-- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/basis/io/files/windows/windows.factor b/basis/io/files/windows/windows.factor index 9b5006701d..518fa8daab 100644 --- a/basis/io/files/windows/windows.factor +++ b/basis/io/files/windows/windows.factor @@ -76,7 +76,7 @@ SYMBOL: master-completion-port { [ dup integer? ] [ ] } { [ dup array? ] [ first dup eof? - [ drop 0 ] [ throw-windows-error ] if + [ drop 0 ] [ n>win32-error-string throw ] if ] } } cond ] with-timeout ; @@ -147,7 +147,7 @@ M: windows handle-length ( handle -- n/f ) GetLastError { { [ dup expected-io-error? ] [ drop f ] } { [ dup eof? ] [ drop t ] } - [ throw-windows-error ] + [ n>win32-error-string throw ] } cond ] [ f ] if ; diff --git a/basis/windows/registry/registry.factor b/basis/windows/registry/registry.factor index 932e09d823..be91098276 100644 --- a/basis/windows/registry/registry.factor +++ b/basis/windows/registry/registry.factor @@ -45,7 +45,11 @@ CONSTANT: registry-value-max-length 16384 f 0 KEY_ALL_ACCESS f create-key* drop ; : close-key ( hkey -- ) - RegCloseKey n>win32-error-check ; + RegCloseKey dup ERROR_SUCCESS = [ + drop + ] [ + n>win32-error-string throw + ] if ; :: with-open-registry-key ( key subkey mode quot -- ) key subkey mode open-key :> hkey @@ -78,7 +82,7 @@ PRIVATE> key value-name ptr1 lpType buffer grow-buffer reg-query-value-ex ] [ - ret throw-windows-error + ret n>win32-error-string throw ] if ] if ; From d9f1093cf8f9a34d8ad85024836c57c62a81ecc8 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 3 Jan 2020 13:04:01 -0600 Subject: [PATCH 07/40] Revert "Delete throw-win32-error, replace with win32-error calls" This reverts commit e1be081ec93061d1e236d6d6f4c1778feef854c2. --- basis/io/directories/windows/windows.factor | 2 +- basis/io/files/windows/windows.factor | 4 ++-- basis/windows/errors/errors.factor | 9 ++++++++- 3 files changed, 11 insertions(+), 4 deletions(-) diff --git a/basis/io/directories/windows/windows.factor b/basis/io/directories/windows/windows.factor index 083c5187fb..76cc8f33f0 100644 --- a/basis/io/directories/windows/windows.factor +++ b/basis/io/directories/windows/windows.factor @@ -31,7 +31,7 @@ ERROR: file-delete-failed path error ; : (delete-file) ( path -- ) dup DeleteFile 0 = [ GetLastError ERROR_ACCESS_DENIED = - [ delete-read-only-file ] [ win32-error ] if + [ delete-read-only-file ] [ throw-win32-error ] if ] [ drop ] if ; M: windows delete-file ( path -- ) diff --git a/basis/io/files/windows/windows.factor b/basis/io/files/windows/windows.factor index 518fa8daab..0531551b60 100644 --- a/basis/io/files/windows/windows.factor +++ b/basis/io/files/windows/windows.factor @@ -117,7 +117,7 @@ M: windows init-io ( -- ) : handle>file-size ( handle -- n/f ) (handle>file-size) [ GetLastError ERROR_INVALID_FUNCTION = - [ f ] [ win32-error ] if + [ f ] [ throw-win32-error ] if ] unless* ; ERROR: seek-before-start n ; @@ -400,7 +400,7 @@ M: windows home 0 [ FindFirstStream ] keepd over INVALID_HANDLE_VALUE = [ - 2drop win32-error + 2drop throw-win32-error ] [ 1vector swap file-streams-rest ] if ; diff --git a/basis/windows/errors/errors.factor b/basis/windows/errors/errors.factor index 5679a62eba..82e8701d16 100644 --- a/basis/windows/errors/errors.factor +++ b/basis/windows/errors/errors.factor @@ -740,6 +740,9 @@ ERROR: windows-error n string ; dup n>win32-error-string windows-error ] if ; +: throw-win32-error ( -- * ) + win32-error-string throw ; + : check-invalid-handle ( handle -- handle ) dup INVALID_HANDLE_VALUE = [ win32-error ] when ; @@ -755,7 +758,11 @@ CONSTANT: expected-io-errors expected-io-errors member? ; : expected-io-error ( error-code -- ) - expected-io-error? [ win32-error ] unless ; + dup expected-io-error? [ + drop + ] [ + throw-win32-error + ] if ; : io-error ( return-value -- ) { 0 f } member? [ GetLastError expected-io-error ] when ; From 8a3b7cbd18800c5656d69d31cd8fee4059e62a62 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 3 Jan 2020 13:04:11 -0600 Subject: [PATCH 08/40] Revert "io.files.windows: replace "-1 " with INVALID_HANDLE_VALUE" This reverts commit a6f0b74f03059cab725e13ff83bdfc4b242f8de3. --- basis/io/files/windows/windows.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/io/files/windows/windows.factor b/basis/io/files/windows/windows.factor index 0531551b60..684d8f13d7 100644 --- a/basis/io/files/windows/windows.factor +++ b/basis/io/files/windows/windows.factor @@ -399,7 +399,7 @@ M: windows home WIN32_FIND_STREAM_DATA 0 [ FindFirstStream ] keepd - over INVALID_HANDLE_VALUE = [ + over -1 = [ 2drop throw-win32-error ] [ 1vector swap file-streams-rest From 75e98b4bc3ec937639fc951228e99d7b5c13793f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 3 Jan 2020 13:04:29 -0600 Subject: [PATCH 09/40] Revert "Replace inline INVALID_HANDLE_VALUE checks with check-invalid-handle calls" This reverts commit 1e61dbfd2af3dcd16053f0f55eabc745dce6f30d. --- basis/io/directories/windows/windows.factor | 3 ++- basis/io/files/info/windows/windows.factor | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/basis/io/directories/windows/windows.factor b/basis/io/directories/windows/windows.factor index 76cc8f33f0..ec76156775 100644 --- a/basis/io/directories/windows/windows.factor +++ b/basis/io/directories/windows/windows.factor @@ -48,7 +48,8 @@ M: windows delete-directory ( path -- ) RemoveDirectory win32-error=0/f ; : find-first-file ( path WIN32_FIND_DATA -- WIN32_FIND_DATA HANDLE ) - [ nip ] [ FindFirstFile ] 2bi check-invalid-handle ; + [ nip ] [ FindFirstFile ] 2bi + [ INVALID_HANDLE_VALUE = [ win32-error-string throw ] when ] keep ; : find-next-file ( HANDLE WIN32_FIND_DATA -- WIN32_FIND_DATA/f ) [ nip ] [ FindNextFile ] 2bi 0 = [ diff --git a/basis/io/files/info/windows/windows.factor b/basis/io/files/info/windows/windows.factor index 90d17a03d5..71f8e06f69 100644 --- a/basis/io/files/info/windows/windows.factor +++ b/basis/io/files/info/windows/windows.factor @@ -42,7 +42,8 @@ TUPLE: windows-file-info < file-info-tuple attributes ; : find-first-file-stat ( path -- WIN32_FIND_DATA ) WIN32_FIND_DATA [ - FindFirstFile check-invalid-handle + FindFirstFile + [ INVALID_HANDLE_VALUE = [ win32-error ] when ] keep FindClose win32-error=0/f ] keep ; From 0625b85b47e65fed1648d9e20aadf5a0849d69cf Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 3 Jan 2020 13:04:38 -0600 Subject: [PATCH 10/40] Revert "windows.errors: make check-invalid-handle throw windows-error instances" This reverts commit 38ab7289b5db4bdc33b9a0ac76fa4c4daa6c092c. --- basis/windows/errors/errors.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/windows/errors/errors.factor b/basis/windows/errors/errors.factor index 82e8701d16..83a8df0148 100644 --- a/basis/windows/errors/errors.factor +++ b/basis/windows/errors/errors.factor @@ -744,7 +744,7 @@ ERROR: windows-error n string ; win32-error-string throw ; : check-invalid-handle ( handle -- handle ) - dup INVALID_HANDLE_VALUE = [ win32-error ] when ; + dup INVALID_HANDLE_VALUE = [ throw-win32-error ] when ; CONSTANT: expected-io-errors ${ From 894bab914e0d941c3bdf3b3e391c040d216f6ddd Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 3 Jan 2020 15:18:14 -0600 Subject: [PATCH 11/40] mason.disk: Fix usage of word --- extra/mason/disk/disk.factor | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/extra/mason/disk/disk.factor b/extra/mason/disk/disk.factor index 88b0414fe4..4e4f24b7af 100644 --- a/extra/mason/disk/disk.factor +++ b/extra/mason/disk/disk.factor @@ -8,8 +8,7 @@ IN: mason.disk : sufficient-disk-space? ( -- ? ) current-directory get find-mount-point-info - file-system-info available-space>> - 1 Gi > ; + available-space>> 1 Gi > ; : check-disk-space ( -- ) sufficient-disk-space? [ @@ -26,4 +25,4 @@ IN: mason.disk "%0.2fGi used, %0.2fGi avail, %0.2fGi total, %0.2f%% free" sprintf ; : disk-usage ( -- string ) - builds-dir get path>disk-usage ; \ No newline at end of file + builds-dir get path>disk-usage ; From d7af258eb7c1e115a228cb92098c1ee1b2328917 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 3 Jan 2020 15:26:02 -0600 Subject: [PATCH 12/40] build.cmd: github is source of truth now --- build.cmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/build.cmd b/build.cmd index 6d964ec660..eb8cd39990 100644 --- a/build.cmd +++ b/build.cmd @@ -39,7 +39,7 @@ echo Deleting staging images from temp/... del temp\staging.*.image echo Updating working copy from %GIT_BRANCH%... -call git pull git://factorcode.org/git/factor.git %GIT_BRANCH% +call git pull https://github.com/factor/factor %GIT_BRANCH% if errorlevel 1 goto fail echo Building vm... From 16442c27ace60ca31abde6cba6f5cde6ffe84b3d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 3 Jan 2020 16:30:00 -0600 Subject: [PATCH 13/40] io: Fix word to find disk space if a file is missing. Add canonicalize-drive because Windows likes C: instead of c:. Add >windows-path for path string comparison. Add canonicalize-path-full for fixing the path, drive, and / to \\ on Windows. --- basis/io/files/info/info.factor | 7 ++++--- basis/io/files/windows/windows.factor | 13 +++++++++---- core/io/pathnames/pathnames.factor | 28 ++++++++++++++++++--------- 3 files changed, 32 insertions(+), 16 deletions(-) diff --git a/basis/io/files/info/info.factor b/basis/io/files/info/info.factor index 917327fa43..baf41ab88c 100644 --- a/basis/io/files/info/info.factor +++ b/basis/io/files/info/info.factor @@ -35,14 +35,15 @@ HOOK: file-writable? os ( path -- ? ) HOOK: file-executable? os ( path -- ? ) : mount-points ( -- assoc ) - file-systems [ [ mount-point>> ] keep ] H{ } map>assoc ; + file-systems [ [ mount-point>> canonicalize-path-full ] keep ] H{ } map>assoc ; : (find-mount-point-info) ( path assoc -- mtab-entry ) - [ resolve-symlinks ] dip + [ resolve-symlinks canonicalize-path-full ] dip 2dup at* [ 2nip ] [ - drop [ parent-directory ] dip (find-mount-point-info) + drop [ parent-directory ] dip + (find-mount-point-info) ] if ; : find-mount-point-info ( path -- file-system-info ) diff --git a/basis/io/files/windows/windows.factor b/basis/io/files/windows/windows.factor index 684d8f13d7..0045e98429 100644 --- a/basis/io/files/windows/windows.factor +++ b/basis/io/files/windows/windows.factor @@ -1,12 +1,12 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien alien.c-types alien.data alien.strings -alien.syntax arrays assocs classes.struct combinators +alien.syntax arrays ascii assocs classes.struct combinators combinators.short-circuit continuations destructors environment io io.backend io.binary io.buffers io.files io.files.private -io.files.types io.pathnames io.ports io.streams.c io.streams.null -io.timeouts kernel libc literals locals math math.bitwise namespaces -sequences specialized-arrays system threads tr vectors windows +io.files.types io.pathnames io.pathnames.private io.ports io.streams.c +io.streams.null io.timeouts kernel libc literals locals math math.bitwise +namespaces sequences specialized-arrays system threads tr vectors windows windows.errors windows.handles windows.kernel32 windows.shell32 windows.time windows.types windows.winsock splitting ; SPECIALIZED-ARRAY: ushort @@ -346,6 +346,11 @@ PRIVATE> M: windows canonicalize-path remove-unicode-prefix canonicalize-path* ; +M: windows canonicalize-drive + dup windows-absolute-path? [ ":" split1 [ >upper ] dip ":" glue ] when ; + +M: windows canonicalize-path-full canonicalize-path canonicalize-drive >windows-path ; + M: windows root-path remove-unicode-prefix root-path* ; M: windows relative-path remove-unicode-prefix relative-path* ; diff --git a/core/io/pathnames/pathnames.factor b/core/io/pathnames/pathnames.factor index d1aed3ad82..bbd9298dcd 100644 --- a/core/io/pathnames/pathnames.factor +++ b/core/io/pathnames/pathnames.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2004, 2009 Slava Pestov, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors combinators io.backend kernel math math.order -namespaces sequences splitting strings system ; +USING: accessors assocs combinators io.backend kernel math +math.order namespaces sequences splitting strings system ; IN: io.pathnames SYMBOL: current-directory @@ -61,13 +61,13 @@ ERROR: no-parent-directory path ; [ nip ] } cond ; -: windows-absolute-path? ( path -- path ? ) +: windows-absolute-path? ( path -- ? ) { { [ dup "\\\\?\\" head? ] [ t ] } { [ dup length 2 < ] [ f ] } { [ dup second CHAR: : = ] [ t ] } [ f ] - } cond ; + } cond nip ; : special-path? ( path -- rest ? ) { @@ -80,12 +80,12 @@ PRIVATE> : absolute-path? ( path -- ? ) { - { [ dup empty? ] [ f ] } - { [ dup special-path? nip ] [ t ] } + { [ dup empty? ] [ drop f ] } + { [ dup special-path? nip ] [ drop t ] } { [ os windows? ] [ windows-absolute-path? ] } - { [ dup first path-separator? ] [ t ] } - [ f ] - } cond nip ; + { [ dup first path-separator? ] [ drop t ] } + [ drop f ] + } cond ; : append-relative-path ( path1 path2 -- path ) [ trim-tail-separators ] @@ -213,6 +213,16 @@ HOOK: canonicalize-path io-backend ( path -- path' ) M: object canonicalize-path canonicalize-path* ; +HOOK: canonicalize-drive io-backend ( path -- path' ) + +M: object canonicalize-drive ; + +HOOK: canonicalize-path-full io-backend ( path -- path' ) + +M: object canonicalize-path-full canonicalize-path canonicalize-drive ; + +: >windows-path ( path -- path' ) H{ { CHAR: / CHAR: \\ } } substitute ; + TUPLE: pathname string ; C: pathname From f621e69335d71e4beb68093663989b351acf0134 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 4 Jan 2020 08:27:16 -0600 Subject: [PATCH 14/40] mason.git: new repo location --- extra/mason/git/git.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/mason/git/git.factor b/extra/mason/git/git.factor index 8f4d03a564..1fb5339733 100644 --- a/extra/mason/git/git.factor +++ b/extra/mason/git/git.factor @@ -16,7 +16,7 @@ IN: mason.git { "git" "clone" - "git://factorcode.org/git/factor.git" + "git://factorcode.org/git/factor-github.git" } ; : git-clone ( -- ) @@ -28,7 +28,7 @@ IN: mason.git { "git" "pull" - "git://factorcode.org/git/factor.git" + "git://factorcode.org/git/factor-github.git" "master" } ; From 4da6f51c9175225e8a9c34d3e545e6a2c40c8b7b Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 4 Jan 2020 09:07:32 -0600 Subject: [PATCH 15/40] io.files.info: fix circularity regression in file-systems on linux --- basis/io/files/info/info.factor | 6 ++++-- basis/io/files/info/unix/linux/linux.factor | 3 +++ 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/basis/io/files/info/info.factor b/basis/io/files/info/info.factor index baf41ab88c..555620aa33 100644 --- a/basis/io/files/info/info.factor +++ b/basis/io/files/info/info.factor @@ -34,8 +34,10 @@ HOOK: file-readable? os ( path -- ? ) HOOK: file-writable? os ( path -- ? ) HOOK: file-executable? os ( path -- ? ) -: mount-points ( -- assoc ) - file-systems [ [ mount-point>> canonicalize-path-full ] keep ] H{ } map>assoc ; +HOOK: mount-points os ( -- assoc ) + +M: object mount-points + file-systems [ [ mount-point>> ] keep ] H{ } map>assoc ; : (find-mount-point-info) ( path assoc -- mtab-entry ) [ resolve-symlinks canonicalize-path-full ] dip diff --git a/basis/io/files/info/unix/linux/linux.factor b/basis/io/files/info/unix/linux/linux.factor index 1bf37532f1..e179354685 100644 --- a/basis/io/files/info/unix/linux/linux.factor +++ b/basis/io/files/info/unix/linux/linux.factor @@ -78,6 +78,9 @@ frequency pass-number ; } cleave ] [ { [ libc-error? ] [ errno>> EACCES = ] } 1&& ] ignore-error/f ; +M: linux mount-points + parse-mtab [ [ mount-point>> ] keep ] H{ } map>assoc ; + M: linux file-systems parse-mtab [ mtab-entry>file-system-info ] map sift ; From 596d44f5af04d876892a758f5ee94ab8bb7c3c8b Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 4 Jan 2020 13:21:28 -0600 Subject: [PATCH 16/40] Revert "build.cmd: github is source of truth now" This reverts commit d7af258eb7c1e115a228cb92098c1ee1b2328917. I renamed /git/factor-github.git to /git/factor.git --- build.cmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/build.cmd b/build.cmd index eb8cd39990..6d964ec660 100644 --- a/build.cmd +++ b/build.cmd @@ -39,7 +39,7 @@ echo Deleting staging images from temp/... del temp\staging.*.image echo Updating working copy from %GIT_BRANCH%... -call git pull https://github.com/factor/factor %GIT_BRANCH% +call git pull git://factorcode.org/git/factor.git %GIT_BRANCH% if errorlevel 1 goto fail echo Building vm... From 9beeedfe184a9b578a1784493ac9684c3dc1ff25 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 4 Jan 2020 13:33:45 -0600 Subject: [PATCH 17/40] io.files.info: Fix find-mount-point. --- basis/io/files/info/info.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/basis/io/files/info/info.factor b/basis/io/files/info/info.factor index 555620aa33..95da980649 100644 --- a/basis/io/files/info/info.factor +++ b/basis/io/files/info/info.factor @@ -39,17 +39,17 @@ HOOK: mount-points os ( -- assoc ) M: object mount-points file-systems [ [ mount-point>> ] keep ] H{ } map>assoc ; -: (find-mount-point-info) ( path assoc -- mtab-entry ) +: (find-mount-point) ( path assoc -- path ) [ resolve-symlinks canonicalize-path-full ] dip 2dup at* [ 2nip ] [ drop [ parent-directory ] dip - (find-mount-point-info) + (find-mount-point) ] if ; -: find-mount-point-info ( path -- file-system-info ) - mount-points (find-mount-point-info) ; +: find-mount-point ( path -- path' ) + mount-points (find-mount-point) mount-point>> ; { { [ os unix? ] [ "io.files.info.unix" ] } From 16135ef8d6513fe2f4ecbf47d4db6618cd2a5961 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 4 Jan 2020 13:40:26 -0600 Subject: [PATCH 18/40] mason.disk: fix word name --- extra/mason/disk/disk.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/extra/mason/disk/disk.factor b/extra/mason/disk/disk.factor index 4e4f24b7af..97e48ff88d 100644 --- a/extra/mason/disk/disk.factor +++ b/extra/mason/disk/disk.factor @@ -7,8 +7,8 @@ IN: mason.disk : Gi ( n -- gibibits ) 30 2^ * ; inline : sufficient-disk-space? ( -- ? ) - current-directory get find-mount-point-info - available-space>> 1 Gi > ; + current-directory get find-mount-point + file-system-info available-space>> 1 Gi > ; : check-disk-space ( -- ) sufficient-disk-space? [ @@ -18,7 +18,7 @@ IN: mason.disk : Gi-str ( n -- string ) 1 Gi /f ; : path>disk-usage ( path -- string ) - find-mount-point-info + find-mount-point file-system-info [ used-space>> ] [ available-space>> ] [ total-space>> ] tri 2dup /f 100 * [ [ Gi-str ] tri@ ] dip From 9bb19274b2e96ca085b94e6934efc11a7eaf6212 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 4 Jan 2020 13:47:13 -0600 Subject: [PATCH 19/40] build: Fix paths... --- build.cmd | 2 +- extra/mason/git/git.factor | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/build.cmd b/build.cmd index 6d964ec660..eb8cd39990 100644 --- a/build.cmd +++ b/build.cmd @@ -39,7 +39,7 @@ echo Deleting staging images from temp/... del temp\staging.*.image echo Updating working copy from %GIT_BRANCH%... -call git pull git://factorcode.org/git/factor.git %GIT_BRANCH% +call git pull https://github.com/factor/factor %GIT_BRANCH% if errorlevel 1 goto fail echo Building vm... diff --git a/extra/mason/git/git.factor b/extra/mason/git/git.factor index 1fb5339733..8f4d03a564 100644 --- a/extra/mason/git/git.factor +++ b/extra/mason/git/git.factor @@ -16,7 +16,7 @@ IN: mason.git { "git" "clone" - "git://factorcode.org/git/factor-github.git" + "git://factorcode.org/git/factor.git" } ; : git-clone ( -- ) @@ -28,7 +28,7 @@ IN: mason.git { "git" "pull" - "git://factorcode.org/git/factor-github.git" + "git://factorcode.org/git/factor.git" "master" } ; From b35a5466e15f0b09d61883601dc928bbcf2e1d94 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 4 Jan 2020 14:02:21 -0600 Subject: [PATCH 20/40] game.loop: Fix game loop for timers change --- extra/game/loop/loop.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/game/loop/loop.factor b/extra/game/loop/loop.factor index 9c28023194..c2612fd2b7 100644 --- a/extra/game/loop/loop.factor +++ b/extra/game/loop/loop.factor @@ -36,7 +36,7 @@ TUPLE: game-loop-error-state error game-loop ; > iteration-start-nanos>> nano-count swap - ] + [ draw-timer>> next-nanos>> nano-count swap - ] [ tick-interval-nanos>> ] bi /f 1.0 min ; GENERIC#: record-benchmarking 1 ( loop quot -- ) From f9c90583d09fe74bfeefba446c002c8f81f3cd38 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 5 Jan 2020 13:16:12 -0600 Subject: [PATCH 21/40] io.files.info: Fix linux file-system-info recursion --- basis/io/files/info/info.factor | 9 ++++----- basis/io/files/info/unix/linux/linux.factor | 18 +++++++++--------- extra/mason/disk/disk.factor | 4 ++-- 3 files changed, 15 insertions(+), 16 deletions(-) diff --git a/basis/io/files/info/info.factor b/basis/io/files/info/info.factor index 95da980649..57546b6ca9 100644 --- a/basis/io/files/info/info.factor +++ b/basis/io/files/info/info.factor @@ -39,17 +39,16 @@ HOOK: mount-points os ( -- assoc ) M: object mount-points file-systems [ [ mount-point>> ] keep ] H{ } map>assoc ; -: (find-mount-point) ( path assoc -- path ) +: (find-mount-point) ( path assoc -- object ) [ resolve-symlinks canonicalize-path-full ] dip 2dup at* [ 2nip ] [ - drop [ parent-directory ] dip - (find-mount-point) + drop [ parent-directory ] dip (find-mount-point) ] if ; -: find-mount-point ( path -- path' ) - mount-points (find-mount-point) mount-point>> ; +: find-mount-point ( path -- object ) + mount-points (find-mount-point) ; { { [ os unix? ] [ "io.files.info.unix" ] } diff --git a/basis/io/files/info/unix/linux/linux.factor b/basis/io/files/info/unix/linux/linux.factor index e179354685..52948eccc7 100644 --- a/basis/io/files/info/unix/linux/linux.factor +++ b/basis/io/files/info/unix/linux/linux.factor @@ -68,9 +68,15 @@ frequency pass-number ; CHAR: \s [ "/etc/mtab" utf8 file>csv ] with-delimiter [ mtab-csv>mtab-entry ] map ; +: (file-system-info) ( path -- file-system-info ) + [ new-file-system-info ] dip + [ file-system-statfs statfs>file-system-info ] + [ file-system-statvfs statvfs>file-system-info ] bi + file-system-calculations ; inline + : mtab-entry>file-system-info ( mtab-entry -- file-system-info/f ) '[ - _ [ mount-point>> file-system-info ] keep + _ [ mount-point>> (file-system-info) ] [ ] bi { [ file-system-name>> >>device-name ] [ mount-point>> >>mount-point ] @@ -85,14 +91,8 @@ M: linux file-systems parse-mtab [ mtab-entry>file-system-info ] map sift ; M: linux file-system-info ( path -- file-system-info ) - normalize-path - [ - [ new-file-system-info ] dip - [ file-system-statfs statfs>file-system-info ] - [ file-system-statvfs statvfs>file-system-info ] bi - file-system-calculations - ] keep - find-mount-point-info + normalize-path [ (file-system-info) ] [ ] bi + find-mount-point { [ file-system-name>> >>device-name drop ] [ mount-point>> >>mount-point drop ] diff --git a/extra/mason/disk/disk.factor b/extra/mason/disk/disk.factor index 97e48ff88d..a80556cd16 100644 --- a/extra/mason/disk/disk.factor +++ b/extra/mason/disk/disk.factor @@ -7,7 +7,7 @@ IN: mason.disk : Gi ( n -- gibibits ) 30 2^ * ; inline : sufficient-disk-space? ( -- ? ) - current-directory get find-mount-point + current-directory get find-mount-point mount-point>> file-system-info available-space>> 1 Gi > ; : check-disk-space ( -- ) @@ -18,7 +18,7 @@ IN: mason.disk : Gi-str ( n -- string ) 1 Gi /f ; : path>disk-usage ( path -- string ) - find-mount-point file-system-info + find-mount-point mount-point>> file-system-info [ used-space>> ] [ available-space>> ] [ total-space>> ] tri 2dup /f 100 * [ [ Gi-str ] tri@ ] dip From 86a35088de4d8a6121092330dac2c2498b4eb8a8 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 5 Jan 2020 13:42:31 -0600 Subject: [PATCH 22/40] gpu.demos.bunny: use while* instead of each-morsel --- extra/gpu/demos/bunny/bunny.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/gpu/demos/bunny/bunny.factor b/extra/gpu/demos/bunny/bunny.factor index 43de6d1141..813e846e32 100644 --- a/extra/gpu/demos/bunny/bunny.factor +++ b/extra/gpu/demos/bunny/bunny.factor @@ -104,7 +104,7 @@ UNIFORM-TUPLE: loading-uniforms V{ } clone swap (read-line-tokens) ; : each-line-tokens ( quot -- ) - input-stream get [ stream-read-line-tokens ] curry each-morsel ; inline + [ input-stream get [ stream-read-line-tokens ] curry ] dip while* ; inline : (parse-bunny-model) ( vs is -- vs is ) [ From d3b9974bedca9f90e340c79b8cd2e60d5d72708e Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Sun, 5 Jan 2020 19:14:22 -0800 Subject: [PATCH 23/40] llvm.ffi: fix cond. --- extra/llvm/ffi/ffi.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/llvm/ffi/ffi.factor b/extra/llvm/ffi/ffi.factor index 9709dc21c6..84583e7c06 100644 --- a/extra/llvm/ffi/ffi.factor +++ b/extra/llvm/ffi/ffi.factor @@ -7,7 +7,7 @@ IN: llvm.ffi << "llvm" { { [ os linux? ] [ "LLVM-3.9" find-so ] } { [ os macosx? ] [ "/usr/local/opt/llvm/lib/libLLVM.dylib" ] } - [ drop ] + [ drop f ] } cond [ cdecl add-library ] when* >> From 249b9166369453a964db8e49882687bd9ca7ecd6 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Mon, 6 Jan 2020 13:14:59 -0800 Subject: [PATCH 24/40] game.loop: using timer's next-nanos, which is in the future. Also, use clamp to make sure tick offset is always [0,1]. --- extra/game/loop/loop.factor | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/extra/game/loop/loop.factor b/extra/game/loop/loop.factor index c2612fd2b7..7047acf09d 100644 --- a/extra/game/loop/loop.factor +++ b/extra/game/loop/loop.factor @@ -1,9 +1,8 @@ ! Copyright (C) 2009 Joe Groff. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors timers alien.c-types calendar classes.struct -continuations destructors fry kernel math math.order memory -namespaces sequences system ui ui.gadgets.worlds vm -vocabs.loader arrays locals ; +USING: accessors calendar continuations destructors fry kernel +locals math math.order system timers ui ui.gadgets.worlds +vocabs.loader ; IN: game.loop TUPLE: game-loop @@ -36,8 +35,8 @@ TUPLE: game-loop-error-state error game-loop ; > next-nanos>> nano-count swap - ] - [ tick-interval-nanos>> ] bi /f 1.0 min ; + [ draw-timer>> next-nanos>> nano-count - ] + [ tick-interval-nanos>> ] bi /f 0.0 1.0 clamp ; GENERIC#: record-benchmarking 1 ( loop quot -- ) From 77db1b1df38149a34490708ef205b05c3d67e56c Mon Sep 17 00:00:00 2001 From: Alexander Iljin Date: Tue, 24 May 2016 20:30:02 +0300 Subject: [PATCH 25/40] windows.errors: make check-invalid-handle throw windows-error instances There are two consequences: - the thrown object is now a windows-error, previously it was a string; - if GetLastError returns zero, nothing is thrown. Previously the string "The operation completed successfully." was thrown in that case. --- basis/windows/errors/errors.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/windows/errors/errors.factor b/basis/windows/errors/errors.factor index 83a8df0148..82e8701d16 100644 --- a/basis/windows/errors/errors.factor +++ b/basis/windows/errors/errors.factor @@ -744,7 +744,7 @@ ERROR: windows-error n string ; win32-error-string throw ; : check-invalid-handle ( handle -- handle ) - dup INVALID_HANDLE_VALUE = [ throw-win32-error ] when ; + dup INVALID_HANDLE_VALUE = [ win32-error ] when ; CONSTANT: expected-io-errors ${ From 294be2cca3fe0d89e297a78de9821e59af909eec Mon Sep 17 00:00:00 2001 From: Alexander Iljin Date: Tue, 24 May 2016 20:33:19 +0300 Subject: [PATCH 26/40] Replace inline INVALID_HANDLE_VALUE checks with check-invalid-handle calls On error find-first-file will now throw a windows-error instance instead of a string. --- basis/io/directories/windows/windows.factor | 3 +-- basis/io/files/info/windows/windows.factor | 3 +-- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/basis/io/directories/windows/windows.factor b/basis/io/directories/windows/windows.factor index ec76156775..76cc8f33f0 100644 --- a/basis/io/directories/windows/windows.factor +++ b/basis/io/directories/windows/windows.factor @@ -48,8 +48,7 @@ M: windows delete-directory ( path -- ) RemoveDirectory win32-error=0/f ; : find-first-file ( path WIN32_FIND_DATA -- WIN32_FIND_DATA HANDLE ) - [ nip ] [ FindFirstFile ] 2bi - [ INVALID_HANDLE_VALUE = [ win32-error-string throw ] when ] keep ; + [ nip ] [ FindFirstFile ] 2bi check-invalid-handle ; : find-next-file ( HANDLE WIN32_FIND_DATA -- WIN32_FIND_DATA/f ) [ nip ] [ FindNextFile ] 2bi 0 = [ diff --git a/basis/io/files/info/windows/windows.factor b/basis/io/files/info/windows/windows.factor index 71f8e06f69..90d17a03d5 100644 --- a/basis/io/files/info/windows/windows.factor +++ b/basis/io/files/info/windows/windows.factor @@ -42,8 +42,7 @@ TUPLE: windows-file-info < file-info-tuple attributes ; : find-first-file-stat ( path -- WIN32_FIND_DATA ) WIN32_FIND_DATA [ - FindFirstFile - [ INVALID_HANDLE_VALUE = [ win32-error ] when ] keep + FindFirstFile check-invalid-handle FindClose win32-error=0/f ] keep ; From 407c7bc21638eedd10acaafe378f97df7923d2a7 Mon Sep 17 00:00:00 2001 From: Alexander Iljin Date: Tue, 24 May 2016 20:40:11 +0300 Subject: [PATCH 27/40] io.files.windows: replace "-1 " with INVALID_HANDLE_VALUE --- basis/io/files/windows/windows.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/io/files/windows/windows.factor b/basis/io/files/windows/windows.factor index 0045e98429..933c904df1 100644 --- a/basis/io/files/windows/windows.factor +++ b/basis/io/files/windows/windows.factor @@ -404,7 +404,7 @@ M: windows home WIN32_FIND_STREAM_DATA 0 [ FindFirstStream ] keepd - over -1 = [ + over INVALID_HANDLE_VALUE = [ 2drop throw-win32-error ] [ 1vector swap file-streams-rest From 135390968b65d4519294564c12e428c71e9fa51a Mon Sep 17 00:00:00 2001 From: Alexander Iljin Date: Tue, 24 May 2016 20:42:48 +0300 Subject: [PATCH 28/40] Delete throw-win32-error, replace with win32-error calls --- basis/io/directories/windows/windows.factor | 2 +- basis/io/files/windows/windows.factor | 4 ++-- basis/windows/errors/errors.factor | 9 +-------- 3 files changed, 4 insertions(+), 11 deletions(-) diff --git a/basis/io/directories/windows/windows.factor b/basis/io/directories/windows/windows.factor index 76cc8f33f0..083c5187fb 100644 --- a/basis/io/directories/windows/windows.factor +++ b/basis/io/directories/windows/windows.factor @@ -31,7 +31,7 @@ ERROR: file-delete-failed path error ; : (delete-file) ( path -- ) dup DeleteFile 0 = [ GetLastError ERROR_ACCESS_DENIED = - [ delete-read-only-file ] [ throw-win32-error ] if + [ delete-read-only-file ] [ win32-error ] if ] [ drop ] if ; M: windows delete-file ( path -- ) diff --git a/basis/io/files/windows/windows.factor b/basis/io/files/windows/windows.factor index 933c904df1..9aa45989aa 100644 --- a/basis/io/files/windows/windows.factor +++ b/basis/io/files/windows/windows.factor @@ -117,7 +117,7 @@ M: windows init-io ( -- ) : handle>file-size ( handle -- n/f ) (handle>file-size) [ GetLastError ERROR_INVALID_FUNCTION = - [ f ] [ throw-win32-error ] if + [ f ] [ win32-error ] if ] unless* ; ERROR: seek-before-start n ; @@ -405,7 +405,7 @@ M: windows home 0 [ FindFirstStream ] keepd over INVALID_HANDLE_VALUE = [ - 2drop throw-win32-error + 2drop win32-error ] [ 1vector swap file-streams-rest ] if ; diff --git a/basis/windows/errors/errors.factor b/basis/windows/errors/errors.factor index 82e8701d16..5679a62eba 100644 --- a/basis/windows/errors/errors.factor +++ b/basis/windows/errors/errors.factor @@ -740,9 +740,6 @@ ERROR: windows-error n string ; dup n>win32-error-string windows-error ] if ; -: throw-win32-error ( -- * ) - win32-error-string throw ; - : check-invalid-handle ( handle -- handle ) dup INVALID_HANDLE_VALUE = [ win32-error ] when ; @@ -758,11 +755,7 @@ CONSTANT: expected-io-errors expected-io-errors member? ; : expected-io-error ( error-code -- ) - dup expected-io-error? [ - drop - ] [ - throw-win32-error - ] if ; + expected-io-error? [ win32-error ] unless ; : io-error ( return-value -- ) { 0 f } member? [ GetLastError expected-io-error ] when ; From 563a3b1a470057fb7536720113602c158bfe0fc5 Mon Sep 17 00:00:00 2001 From: Alexander Iljin Date: Wed, 29 Jun 2016 01:20:38 +0300 Subject: [PATCH 29/40] Replace "n>win32-error-string throw" with windows-error instance throwing --- basis/io/files/windows/windows.factor | 4 ++-- basis/windows/registry/registry.factor | 8 ++------ 2 files changed, 4 insertions(+), 8 deletions(-) diff --git a/basis/io/files/windows/windows.factor b/basis/io/files/windows/windows.factor index 9aa45989aa..19c08cb3a8 100644 --- a/basis/io/files/windows/windows.factor +++ b/basis/io/files/windows/windows.factor @@ -76,7 +76,7 @@ SYMBOL: master-completion-port { [ dup integer? ] [ ] } { [ dup array? ] [ first dup eof? - [ drop 0 ] [ n>win32-error-string throw ] if + [ drop 0 ] [ throw-windows-error ] if ] } } cond ] with-timeout ; @@ -147,7 +147,7 @@ M: windows handle-length ( handle -- n/f ) GetLastError { { [ dup expected-io-error? ] [ drop f ] } { [ dup eof? ] [ drop t ] } - [ n>win32-error-string throw ] + [ throw-windows-error ] } cond ] [ f ] if ; diff --git a/basis/windows/registry/registry.factor b/basis/windows/registry/registry.factor index be91098276..932e09d823 100644 --- a/basis/windows/registry/registry.factor +++ b/basis/windows/registry/registry.factor @@ -45,11 +45,7 @@ CONSTANT: registry-value-max-length 16384 f 0 KEY_ALL_ACCESS f create-key* drop ; : close-key ( hkey -- ) - RegCloseKey dup ERROR_SUCCESS = [ - drop - ] [ - n>win32-error-string throw - ] if ; + RegCloseKey n>win32-error-check ; :: with-open-registry-key ( key subkey mode quot -- ) key subkey mode open-key :> hkey @@ -82,7 +78,7 @@ PRIVATE> key value-name ptr1 lpType buffer grow-buffer reg-query-value-ex ] [ - ret n>win32-error-string throw + ret throw-windows-error ] if ] if ; From 3733b13dafc66815539fad021e5589fd625b4cd3 Mon Sep 17 00:00:00 2001 From: Alexander Iljin Date: Wed, 29 Jun 2016 01:23:36 +0300 Subject: [PATCH 30/40] Replace "win32-error-string throw" with windows-error instance throwing Remove win32-error-string, because there was only one place it was used in. --- basis/alien/libraries/windows/windows.factor | 5 +++-- basis/calendar/windows/windows.factor | 2 +- basis/io/files/info/windows/windows.factor | 4 ++-- basis/io/sockets/secure/windows/windows.factor | 2 +- basis/windows/errors/errors.factor | 3 --- extra/talks/tc-lisp-talk/tc-lisp-talk.factor | 2 +- 6 files changed, 8 insertions(+), 10 deletions(-) diff --git a/basis/alien/libraries/windows/windows.factor b/basis/alien/libraries/windows/windows.factor index 249bcff57a..03a2e8b8d4 100644 --- a/basis/alien/libraries/windows/windows.factor +++ b/basis/alien/libraries/windows/windows.factor @@ -1,8 +1,9 @@ -USING: alien.libraries io.pathnames system windows.errors ; +USING: alien.libraries io.pathnames system windows.errors +windows.kernel32 ; IN: alien.libraries.windows M: windows >deployed-library-path file-name ; M: windows dlerror ( -- message ) - win32-error-string ; + GetLastError n>win32-error-string ; diff --git a/basis/calendar/windows/windows.factor b/basis/calendar/windows/windows.factor index 80253ea91b..f866fe81fa 100644 --- a/basis/calendar/windows/windows.factor +++ b/basis/calendar/windows/windows.factor @@ -31,7 +31,7 @@ IN: calendar.windows M: windows gmt-offset ( -- hours minutes seconds ) TIME_ZONE_INFORMATION dup GetTimeZoneInformation { - { TIME_ZONE_ID_INVALID [ win32-error-string throw ] } + { TIME_ZONE_ID_INVALID [ win32-error ] } { TIME_ZONE_ID_UNKNOWN [ Bias>> ] } { TIME_ZONE_ID_STANDARD [ Bias>> ] } { TIME_ZONE_ID_DAYLIGHT [ [ Bias>> ] [ DaylightBias>> ] bi + ] } diff --git a/basis/io/files/info/windows/windows.factor b/basis/io/files/info/windows/windows.factor index 90d17a03d5..99eccd1c0f 100644 --- a/basis/io/files/info/windows/windows.factor +++ b/basis/io/files/info/windows/windows.factor @@ -19,7 +19,7 @@ TUPLE: windows-file-info < file-info-tuple attributes ; : get-compressed-file-size ( path -- n ) { DWORD } [ GetCompressedFileSize ] with-out-parameters - over INVALID_FILE_SIZE = [ win32-error-string throw ] [ >64bit ] if ; + over INVALID_FILE_SIZE = [ win32-error ] [ >64bit ] if ; : set-windows-size-on-disk ( file-info path -- file-info ) over attributes>> +compressed+ swap member? [ @@ -183,7 +183,7 @@ CONSTANT: names-buf-length 16384 [ path-length FindNextVolume ] with-out-parameters swap 0 = [ GetLastError ERROR_NO_MORE_FILES = - [ drop f ] [ win32-error-string throw ] if + [ drop f ] [ win32-error ] if ] [ alien>native-string ] if ; : find-volumes ( -- array ) diff --git a/basis/io/sockets/secure/windows/windows.factor b/basis/io/sockets/secure/windows/windows.factor index 59eccfed19..c1b8e3936d 100644 --- a/basis/io/sockets/secure/windows/windows.factor +++ b/basis/io/sockets/secure/windows/windows.factor @@ -14,7 +14,7 @@ M: openssl ssl-certificate-verification-supported? f ; : load-windows-cert-store ( string -- HCERTSTORE ) [ f ] dip CertOpenSystemStore - [ win32-error-string throw ] when-zero ; + [ win32-error ] when-zero ; : X509-NAME. ( X509_NAME -- ) f 0 X509_NAME_oneline diff --git a/basis/windows/errors/errors.factor b/basis/windows/errors/errors.factor index 5679a62eba..f5e5314e2f 100644 --- a/basis/windows/errors/errors.factor +++ b/basis/windows/errors/errors.factor @@ -717,9 +717,6 @@ CONSTANT: FORMAT_MESSAGE_MAX_WIDTH_MASK 0x000000FF [ drop "Unknown error 0x" id 0xffff,ffff bitand >hex append ] [ alien>native-string [ blank? ] trim ] if ; -: win32-error-string ( -- str ) - GetLastError n>win32-error-string ; - ERROR: windows-error n string ; : (win32-error) ( n -- ) diff --git a/extra/talks/tc-lisp-talk/tc-lisp-talk.factor b/extra/talks/tc-lisp-talk/tc-lisp-talk.factor index 8a6b5d97e5..c0353a3e40 100644 --- a/extra/talks/tc-lisp-talk/tc-lisp-talk.factor +++ b/extra/talks/tc-lisp-talk/tc-lisp-talk.factor @@ -456,7 +456,7 @@ xyz \"TIME_ZONE_INFORMATION\" dup GetTimeZoneInformation { { TIME_ZONE_ID_INVALID [ - win32-error-string throw + win32-error ] } { TIME_ZONE_ID_STANDARD [ TIME_ZONE_INFORMATION-Bias From 049356574a1087eb50c054e018c7104b84407318 Mon Sep 17 00:00:00 2001 From: Alexander Iljin Date: Wed, 29 Jun 2016 01:55:15 +0300 Subject: [PATCH 31/40] windows.errors: streamline error handling and throwing --- basis/windows/errors/authors.txt | 1 + basis/windows/errors/errors.factor | 19 +++++++------------ 2 files changed, 8 insertions(+), 12 deletions(-) diff --git a/basis/windows/errors/authors.txt b/basis/windows/errors/authors.txt index 7c1b2f2279..d652f68ac8 100644 --- a/basis/windows/errors/authors.txt +++ b/basis/windows/errors/authors.txt @@ -1 +1,2 @@ Doug Coleman +Alexander Ilin diff --git a/basis/windows/errors/errors.factor b/basis/windows/errors/errors.factor index f5e5314e2f..ffb735be08 100644 --- a/basis/windows/errors/errors.factor +++ b/basis/windows/errors/errors.factor @@ -719,23 +719,18 @@ CONSTANT: FORMAT_MESSAGE_MAX_WIDTH_MASK 0x000000FF ERROR: windows-error n string ; -: (win32-error) ( n -- ) - [ dup win32-error-string windows-error ] unless-zero ; +: throw-windows-error ( n -- * ) + dup n>win32-error-string windows-error ; -: win32-error ( -- ) - GetLastError (win32-error) ; +: n>win32-error-check ( n -- ) + [ throw-windows-error ] unless-zero ; +! Note that win32-error* words throw GetLastError code. +: win32-error ( -- ) GetLastError n>win32-error-check ; : win32-error=0/f ( n -- ) { 0 f } member? [ win32-error ] when ; : win32-error>0 ( n -- ) 0 > [ win32-error ] when ; : win32-error<0 ( n -- ) 0 < [ win32-error ] when ; -: win32-error<>0 ( n -- ) zero? [ win32-error ] unless ; - -: n>win32-error-check ( n -- ) - dup ERROR_SUCCESS = [ - drop - ] [ - dup n>win32-error-string windows-error - ] if ; +: win32-error<>0 ( n -- ) [ win32-error ] unless-zero ; : check-invalid-handle ( handle -- handle ) dup INVALID_HANDLE_VALUE = [ win32-error ] when ; From c77cc4c2057fe0ab2fdd755a4ed89b107199ef1b Mon Sep 17 00:00:00 2001 From: Alexander Iljin Date: Wed, 29 Jun 2016 01:55:15 +0300 Subject: [PATCH 32/40] windows.errors: fix a compilation error --- basis/windows/errors/errors.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/windows/errors/errors.factor b/basis/windows/errors/errors.factor index ffb735be08..8a057f9458 100644 --- a/basis/windows/errors/errors.factor +++ b/basis/windows/errors/errors.factor @@ -730,7 +730,7 @@ ERROR: windows-error n string ; : win32-error=0/f ( n -- ) { 0 f } member? [ win32-error ] when ; : win32-error>0 ( n -- ) 0 > [ win32-error ] when ; : win32-error<0 ( n -- ) 0 < [ win32-error ] when ; -: win32-error<>0 ( n -- ) [ win32-error ] unless-zero ; +: win32-error<>0 ( n -- ) zero? [ win32-error ] unless ; : check-invalid-handle ( handle -- handle ) dup INVALID_HANDLE_VALUE = [ win32-error ] when ; From b2dc630bd04d46e751f0e37c083a3b775747ccf2 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Mon, 6 Jan 2020 13:20:12 -0800 Subject: [PATCH 33/40] game.loop: last-tick-percent-offset counts down to zero, need to subtract from 1. --- extra/game/loop/loop.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/extra/game/loop/loop.factor b/extra/game/loop/loop.factor index 7047acf09d..121176089b 100644 --- a/extra/game/loop/loop.factor +++ b/extra/game/loop/loop.factor @@ -36,7 +36,8 @@ TUPLE: game-loop-error-state error game-loop ; : last-tick-percent-offset ( loop -- float ) [ draw-timer>> next-nanos>> nano-count - ] - [ tick-interval-nanos>> ] bi /f 0.0 1.0 clamp ; + [ tick-interval-nanos>> ] bi /f 1.0 swap - + 0.0 1.0 clamp ; GENERIC#: record-benchmarking 1 ( loop quot -- ) From 1eb7dbe6d2a86041edc738a7022e002434d2a96b Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Mon, 6 Jan 2020 13:26:19 -0800 Subject: [PATCH 34/40] io.files: quot effects in change-file-lines and change-file-contents. --- core/io/files/files.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 7ba3f9e82c..e96dbc8ab5 100644 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -56,14 +56,14 @@ HOOK: (file-appender) io-backend ( path -- stream ) : set-file-lines ( seq path encoding -- ) [ [ print ] each ] with-file-writer ; -: change-file-lines ( path encoding quot -- ) +: change-file-lines ( ..a path encoding quot: ( ..a seq -- ..b seq' ) -- ..b ) [ [ file-lines ] dip call ] [ drop set-file-lines ] 3bi ; inline : set-file-contents ( seq path encoding -- ) [ write ] with-file-writer ; -: change-file-contents ( path encoding quot -- ) +: change-file-contents ( ..a path encoding quot: ( ..a seq -- ..b seq' ) -- ..b ) [ [ file-contents ] dip call ] [ drop set-file-contents ] 3bi ; inline From ca1612cc57239c37c7646544d40a6a10adb80476 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Mon, 6 Jan 2020 14:20:15 -0800 Subject: [PATCH 35/40] io: fix for win32-error not throwing on zero. --- basis/io/directories/windows/windows.factor | 2 +- basis/io/files/info/windows/windows.factor | 2 +- basis/io/files/windows/windows.factor | 4 ++-- basis/io/sockets/secure/windows/windows.factor | 2 +- 4 files changed, 5 insertions(+), 5 deletions(-) diff --git a/basis/io/directories/windows/windows.factor b/basis/io/directories/windows/windows.factor index 083c5187fb..b06a5bf1e1 100644 --- a/basis/io/directories/windows/windows.factor +++ b/basis/io/directories/windows/windows.factor @@ -31,7 +31,7 @@ ERROR: file-delete-failed path error ; : (delete-file) ( path -- ) dup DeleteFile 0 = [ GetLastError ERROR_ACCESS_DENIED = - [ delete-read-only-file ] [ win32-error ] if + [ delete-read-only-file ] [ drop win32-error ] if ] [ drop ] if ; M: windows delete-file ( path -- ) diff --git a/basis/io/files/info/windows/windows.factor b/basis/io/files/info/windows/windows.factor index 99eccd1c0f..88fa83a745 100644 --- a/basis/io/files/info/windows/windows.factor +++ b/basis/io/files/info/windows/windows.factor @@ -19,7 +19,7 @@ TUPLE: windows-file-info < file-info-tuple attributes ; : get-compressed-file-size ( path -- n ) { DWORD } [ GetCompressedFileSize ] with-out-parameters - over INVALID_FILE_SIZE = [ win32-error ] [ >64bit ] if ; + over INVALID_FILE_SIZE = [ win32-error ] when >64bit ; : set-windows-size-on-disk ( file-info path -- file-info ) over attributes>> +compressed+ swap member? [ diff --git a/basis/io/files/windows/windows.factor b/basis/io/files/windows/windows.factor index 19c08cb3a8..2bdb64cbfb 100644 --- a/basis/io/files/windows/windows.factor +++ b/basis/io/files/windows/windows.factor @@ -117,7 +117,7 @@ M: windows init-io ( -- ) : handle>file-size ( handle -- n/f ) (handle>file-size) [ GetLastError ERROR_INVALID_FUNCTION = - [ f ] [ win32-error ] if + [ win32-error ] unless f ] unless* ; ERROR: seek-before-start n ; @@ -405,7 +405,7 @@ M: windows home 0 [ FindFirstStream ] keepd over INVALID_HANDLE_VALUE = [ - 2drop win32-error + 2drop win32-error f ] [ 1vector swap file-streams-rest ] if ; diff --git a/basis/io/sockets/secure/windows/windows.factor b/basis/io/sockets/secure/windows/windows.factor index c1b8e3936d..815200c11b 100644 --- a/basis/io/sockets/secure/windows/windows.factor +++ b/basis/io/sockets/secure/windows/windows.factor @@ -14,7 +14,7 @@ M: openssl ssl-certificate-verification-supported? f ; : load-windows-cert-store ( string -- HCERTSTORE ) [ f ] dip CertOpenSystemStore - [ win32-error ] when-zero ; + [ win32-error f ] when-zero ; : X509-NAME. ( X509_NAME -- ) f 0 X509_NAME_oneline From 655262af9a134391191020534df9eaf718252b51 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Wed, 8 Jan 2020 08:51:41 -0800 Subject: [PATCH 36/40] llvm.ffi: need to fix stack effect for the false case. --- extra/llvm/ffi/ffi.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/llvm/ffi/ffi.factor b/extra/llvm/ffi/ffi.factor index 84583e7c06..4bc921ec4b 100644 --- a/extra/llvm/ffi/ffi.factor +++ b/extra/llvm/ffi/ffi.factor @@ -8,7 +8,7 @@ IN: llvm.ffi { [ os linux? ] [ "LLVM-3.9" find-so ] } { [ os macosx? ] [ "/usr/local/opt/llvm/lib/libLLVM.dylib" ] } [ drop f ] -} cond [ cdecl add-library ] when* +} cond [ cdecl add-library ] [ drop ] if* >> LIBRARY: llvm From d0fd75b20876e1ae6250817f0507d6e36fd9f658 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Wed, 8 Jan 2020 09:05:06 -0800 Subject: [PATCH 37/40] tensors.tensor-slice: make step-slice not extend slice. This caused a small regression in compiler.tree.cleanup on this test: { t } [ [ { array } declare 2 [ . . ] assoc-each ] \ nth-unsafe inlined? ] unit-test I'm not entirely sure why it wasn't able to infer the slice that was created for iteration stays a slice, and never becomes a step-slice, so perhaps there is some improvement to be made in type inference here. --- extra/tensors/tensor-slice/tensor-slice.factor | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/extra/tensors/tensor-slice/tensor-slice.factor b/extra/tensors/tensor-slice/tensor-slice.factor index 47124bf768..275d62600e 100644 --- a/extra/tensors/tensor-slice/tensor-slice.factor +++ b/extra/tensors/tensor-slice/tensor-slice.factor @@ -1,7 +1,12 @@ USING: accessors kernel locals math math.order sequences ; IN: tensors.tensor-slice -TUPLE: step-slice < slice { step integer read-only } ; +TUPLE: step-slice + { from integer read-only initial: 0 } + { to integer read-only initial: 0 } + { seq read-only } + { step integer read-only } ; + :: ( from to step seq -- step-slice ) step zero? [ "can't be zero" throw ] when seq length :> len @@ -17,10 +22,14 @@ TUPLE: step-slice < slice { step integer read-only } ; seq dup slice? [ collapse-slice ] when step step-slice boa ; +M: step-slice virtual-exemplar seq>> ; inline + M: step-slice virtual@ - [ step>> * ] [ from>> + ] [ seq>> ] tri ; + [ step>> * ] [ from>> + ] [ seq>> ] tri ; inline M: step-slice length [ to>> ] [ from>> - ] [ step>> ] tri dup 0 < [ [ neg 0 max ] dip neg ] when /mod - zero? [ 1 + ] unless ; \ No newline at end of file + zero? [ 1 + ] unless ; inline + +INSTANCE: step-slice virtual-sequence From d7c0dfcb2b72d85f34d8be26e3eaffb0fc0ae09b Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Wed, 8 Jan 2020 11:44:45 -0800 Subject: [PATCH 38/40] llvm.ffi: ... --- extra/llvm/ffi/ffi.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/llvm/ffi/ffi.factor b/extra/llvm/ffi/ffi.factor index 4bc921ec4b..272bc2cb10 100644 --- a/extra/llvm/ffi/ffi.factor +++ b/extra/llvm/ffi/ffi.factor @@ -7,7 +7,7 @@ IN: llvm.ffi << "llvm" { { [ os linux? ] [ "LLVM-3.9" find-so ] } { [ os macosx? ] [ "/usr/local/opt/llvm/lib/libLLVM.dylib" ] } - [ drop f ] + [ f ] } cond [ cdecl add-library ] [ drop ] if* >> From 73b01704a2313b9f281100a97f766d2cda7dec93 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Wed, 8 Jan 2020 11:45:42 -0800 Subject: [PATCH 39/40] bencode: use linked-assocs to preserve ordering, fix byte-strings. the byte-string was being "decoded" with replacement characters, messing up binary data. --- extra/bencode/bencode-tests.factor | 4 ++-- extra/bencode/bencode.factor | 18 +++++++++--------- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/extra/bencode/bencode-tests.factor b/extra/bencode/bencode-tests.factor index 1d18c6c205..2ef6796681 100644 --- a/extra/bencode/bencode-tests.factor +++ b/extra/bencode/bencode-tests.factor @@ -1,4 +1,4 @@ -USING: bencode tools.test ; +USING: bencode linked-assocs tools.test ; { "i42e" } [ 42 >bencode ] unit-test { "i0e" } [ 0 >bencode ] unit-test @@ -8,6 +8,6 @@ USING: bencode tools.test ; { { "spam" 42 } } [ "l4:spami42ee" bencode> ] unit-test -{ H{ { "bar" "spam" } { "foo" 42 } } } [ +{ LH{ { "bar" "spam" } { "foo" 42 } } } [ "d3:bar4:spam3:fooi42ee" bencode> ] unit-test diff --git a/extra/bencode/bencode.factor b/extra/bencode/bencode.factor index 2347595ae4..7173b93c12 100644 --- a/extra/bencode/bencode.factor +++ b/extra/bencode/bencode.factor @@ -1,6 +1,6 @@ -USING: arrays assocs combinators hashtables io -io.encodings.ascii io.encodings.string io.streams.string kernel -math math.parser sequences strings ; +USING: arrays assocs combinators io io.encodings.ascii +io.encodings.string io.streams.string kernel linked-assocs math +math.parser sequences strings ; IN: bencode GENERIC: >bencode ( obj -- bencode ) @@ -18,10 +18,10 @@ M: assoc >bencode [ [ >bencode ] bi@ append ] { } assoc>map concat "d" "e" surround ; -number ; @@ -31,11 +31,13 @@ DEFER: read-bencode : read-dictionary ( -- obj ) [ read-bencode [ read-bencode 2array ] [ f ] if* dup - ] [ ] produce nip >hashtable ; + ] [ ] produce nip >linked-hash ; : read-string ( prefix -- obj ) ":" read-until CHAR: : assert= swap prefix - string>number read ascii decode ; + string>number read "" like ; + +PRIVATE> : read-bencode ( -- obj ) read1 { @@ -46,7 +48,5 @@ DEFER: read-bencode [ read-string ] } case ; -PRIVATE> - : bencode> ( bencode -- obj ) [ read-bencode ] with-string-reader ; From 4acb08d905224c88f55d6bd63acd45dc6c039288 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 8 Jan 2020 19:21:58 -0600 Subject: [PATCH 40/40] tools.deploy: Up the deploy sizes for mac32. Looks like upgrading to unicode 12 caused the sizes to grow. These are mostly graphics demos which should not depend on unicode, but the tools can't detect this easily, so punt for now. Here's a command to show the last clean deploy to where it broke. git log -p 4201c2149b66d5ce45a9e45be95459256486a7ea..8eb7621b549a7956665affc9e53a48e8e8b29ea3 --- basis/tools/deploy/deploy-tests.factor | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/basis/tools/deploy/deploy-tests.factor b/basis/tools/deploy/deploy-tests.factor index 4e6dac91bd..c79f433079 100644 --- a/basis/tools/deploy/deploy-tests.factor +++ b/basis/tools/deploy/deploy-tests.factor @@ -34,7 +34,7 @@ delete-staging-images { } [ "sudoku" shake-and-bake 800000 small-enough? ] long-unit-test ! [ ] [ "hello-ui" shake-and-bake 1605000 small-enough? ] long-unit-test -{ } [ "hello-ui" shake-and-bake 2762000 small-enough? ] long-unit-test +{ } [ "hello-ui" shake-and-bake 2764000 small-enough? ] long-unit-test { "math-threads-compiler-io-ui" } [ "hello-ui" deploy-config config>profile @@ -42,24 +42,24 @@ delete-staging-images ] long-unit-test ! [ ] [ "maze" shake-and-bake 1520000 small-enough? ] long-unit-test -{ } [ "maze" shake-and-bake 2800000 small-enough? ] long-unit-test +{ } [ "maze" shake-and-bake 2801000 small-enough? ] long-unit-test ! [ ] [ "tetris" shake-and-bake 1734000 small-enough? ] long-unit-test { } [ "tetris" shake-and-bake 2850000 small-enough? ] long-unit-test ! [ ] [ "spheres" shake-and-bake 1557000 small-enough? ] long-unit-test -{ } [ "spheres" shake-and-bake 2820000 small-enough? ] long-unit-test +{ } [ "spheres" shake-and-bake 2850000 small-enough? ] long-unit-test ! [ ] [ "terrain" shake-and-bake 2053000 small-enough? ] long-unit-test -{ } [ "terrain" shake-and-bake 2685300 small-enough? ] long-unit-test +{ } [ "terrain" shake-and-bake 3385300 small-enough? ] long-unit-test ! [ ] [ "gpu.demos.raytrace" shake-and-bake 2764000 small-enough? ] long-unit-test -{ } [ "gpu.demos.raytrace" shake-and-bake 3557800 small-enough? ] long-unit-test +{ } [ "gpu.demos.raytrace" shake-and-bake 4157800 small-enough? ] long-unit-test ! { } [ "bunny" shake-and-bake 2559640 small-enough? ] long-unit-test -{ } [ "bunny" shake-and-bake 2700000 small-enough? ] long-unit-test +{ } [ "bunny" shake-and-bake 3400000 small-enough? ] long-unit-test -{ } [ "gpu.demos.bunny" shake-and-bake 3750000 small-enough? ] long-unit-test +{ } [ "gpu.demos.bunny" shake-and-bake 4200000 small-enough? ] long-unit-test os macosx? [ [ ] [ "webkit-demo" shake-and-bake 600000 small-enough? ] long-unit-test