diff --git a/basis/io/directories/unix/linux/linux.factor b/basis/io/directories/unix/linux/linux.factor new file mode 100644 index 0000000000..ba5b27dacd --- /dev/null +++ b/basis/io/directories/unix/linux/linux.factor @@ -0,0 +1,10 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.c-types io.directories.unix kernel system unix ; +IN: io.directories.unix.linux + +M: unix find-next-file ( DIR* -- byte-array ) + "dirent" + f + [ readdir64_r 0 = [ (io-error) ] unless ] 2keep + *void* [ drop f ] unless ; diff --git a/basis/io/directories/unix/linux/tags.txt b/basis/io/directories/unix/linux/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/directories/unix/linux/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/directories/unix/unix.factor b/basis/io/directories/unix/unix.factor index 395ce73d7c..b8b781ec12 100644 --- a/basis/io/directories/unix/unix.factor +++ b/basis/io/directories/unix/unix.factor @@ -4,7 +4,7 @@ USING: accessors alien.c-types alien.strings combinators continuations destructors fry io io.backend io.backend.unix io.directories io.encodings.binary io.encodings.utf8 io.files io.pathnames io.files.types kernel math.bitwise sequences system -unix unix.stat ; +unix unix.stat vocabs.loader ; IN: io.directories.unix : touch-mode ( -- n ) @@ -34,7 +34,9 @@ M: unix copy-file ( from to -- ) [ opendir dup [ (io-error) ] unless ] dip dupd curry swap '[ _ closedir io-error ] [ ] cleanup ; inline -: find-next-file ( DIR* -- byte-array ) +HOOK: find-next-file os ( DIR* -- byte-array ) + +M: unix find-next-file ( DIR* -- byte-array ) "dirent" f [ readdir_r 0 = [ (io-error) ] unless ] 2keep @@ -54,8 +56,10 @@ M: unix copy-file ( from to -- ) } case ; M: unix >directory-entry ( byte-array -- directory-entry ) - [ dirent-d_name utf8 alien>string ] - [ dirent-d_type dirent-type>file-type ] bi directory-entry boa ; + { + [ dirent-d_name utf8 alien>string ] + [ dirent-d_type dirent-type>file-type ] + } cleave directory-entry boa ; M: unix (directory-entries) ( path -- seq ) [ @@ -63,3 +67,5 @@ M: unix (directory-entries) ( path -- seq ) [ >directory-entry ] produce nip ] with-unix-directory ; + +os linux? [ "io.directories.unix.linux" require ] when diff --git a/basis/io/files/info/info.factor b/basis/io/files/info/info.factor index 5c5d2c93d2..f16db428a8 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.loader io.files.types ; +vocabs.loader io.files.types math ; IN: io.files.info ! File info @@ -14,6 +14,9 @@ HOOK: link-info os ( path -- info ) : directory? ( file-info -- ? ) type>> +directory+ = ; +: sparse-file? ( file-info -- ? ) + [ size-on-disk>> ] [ size>> ] bi < ; + ! File systems HOOK: file-systems os ( -- array ) diff --git a/basis/struct-arrays/struct-arrays.factor b/basis/struct-arrays/struct-arrays.factor index ba0524009f..5aaf2c2ea6 100755 --- a/basis/struct-arrays/struct-arrays.factor +++ b/basis/struct-arrays/struct-arrays.factor @@ -35,6 +35,6 @@ ERROR: bad-byte-array-length byte-array ; heap-size struct-array boa ; inline : malloc-struct-array ( length c-type -- struct-array ) - [ heap-size calloc ] 2keep ; + [ heap-size calloc ] 2keep ; inline INSTANCE: struct-array sequence diff --git a/basis/tools/deploy/deploy-tests.factor b/basis/tools/deploy/deploy-tests.factor index 842faba640..9cf21d1716 100644 --- a/basis/tools/deploy/deploy-tests.factor +++ b/basis/tools/deploy/deploy-tests.factor @@ -97,4 +97,8 @@ M: quit-responder call-responder* shake-and-bake run-temp-image ] curry unit-test -] each \ No newline at end of file +] each + +os windows? os macosx? or [ + [ ] [ "tools.deploy.test.8" shake-and-bake run-temp-image ] unit-test +] when \ No newline at end of file diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index d79326ddc4..cdd66cc6e8 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -41,7 +41,7 @@ IN: tools.deploy.shaker ] when strip-dictionary? [ { - "compiler.units" + ! "compiler.units" "vocabs" "vocabs.cache" "source-files.errors" @@ -271,7 +271,7 @@ IN: tools.deploy.shaker compiled-generic-crossref compiler-impl compiler.errors:compiler-errors - definition-observers + ! definition-observers interactive-vocabs lexer-factory print-use-hook @@ -301,16 +301,16 @@ IN: tools.deploy.shaker compiler.errors:compiler-errors continuations:thread-error-hook } % + + deploy-ui? get [ + "ui-error-hook" "ui.gadgets.worlds" lookup , + ] when ] when deploy-c-types? get [ "c-types" "alien.c-types" lookup , ] unless - deploy-ui? get [ - "ui-error-hook" "ui.gadgets.worlds" lookup , - ] when - "windows-messages" "windows.messages" lookup [ , ] when* ] { } make ; @@ -443,6 +443,9 @@ SYMBOL: deploy-vocab strip-debugger? [ "debugger" require "inspector" require + deploy-ui? get [ + "ui.debugger" require + ] when ] unless deploy-vocab set deploy-vocab get require diff --git a/basis/tools/deploy/test/8/8.factor b/basis/tools/deploy/test/8/8.factor new file mode 100644 index 0000000000..ddf08d3654 --- /dev/null +++ b/basis/tools/deploy/test/8/8.factor @@ -0,0 +1,21 @@ +USING: calendar game-input threads ui ui.gadgets.worlds kernel +method-chains system ; +IN: tools.deploy.test.8 + +TUPLE: my-world < world ; + +BEFORE: my-world begin-world drop open-game-input ; + +AFTER: my-world end-world drop close-game-input ; + +: test-game-input ( -- ) + [ + f T{ world-attributes + { world-class my-world } + { title "Test" } + } open-window + 1 seconds sleep + 0 exit + ] with-ui ; + +MAIN: test-game-input \ No newline at end of file diff --git a/basis/tools/deploy/test/8/deploy.factor b/basis/tools/deploy/test/8/deploy.factor new file mode 100644 index 0000000000..1f7fb4d7ee --- /dev/null +++ b/basis/tools/deploy/test/8/deploy.factor @@ -0,0 +1,14 @@ +USING: tools.deploy.config ; +H{ + { deploy-c-types? f } + { deploy-unicode? f } + { deploy-word-defs? f } + { deploy-name "tools.deploy.test.8" } + { "stop-after-last-window?" t } + { deploy-reflection 1 } + { deploy-ui? t } + { deploy-math? t } + { deploy-io 2 } + { deploy-word-props? f } + { deploy-threads? t } +} diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor index 2cf4091937..afed121fb6 100755 --- a/basis/ui/backend/windows/windows.factor +++ b/basis/ui/backend/windows/windows.factor @@ -616,10 +616,8 @@ M: windows-ui-backend do-events GetDoubleClickTime milliseconds double-click-timeout set-global ; : cleanup-win32-ui ( -- ) - class-name-ptr [ - [ [ f UnregisterClass drop ] [ free ] bi ] when* f - ] change-global - msg-obj change-global [ [ free ] when* f ] ; + class-name-ptr [ [ [ f UnregisterClass drop ] [ free ] bi ] when* f ] change-global + msg-obj [ [ free ] when* f ] change-global ; : get-dc ( world -- ) handle>> dup hWnd>> GetDC dup win32-error=0/f >>hDC drop ; diff --git a/basis/ui/debugger/debugger.factor b/basis/ui/debugger/debugger.factor new file mode 100755 index 0000000000..e2c8b06bdd --- /dev/null +++ b/basis/ui/debugger/debugger.factor @@ -0,0 +1,19 @@ +! Copyright (C) 2006, 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors debugger io kernel namespaces prettyprint +ui.gadgets.panes ui.gadgets.worlds ui ; +IN: ui.debugger + +: ( error -- pane ) + [ [ print-error ] with-pane ] keep ; inline + +: error-window ( error -- ) + "Error" open-window ; + +[ error-window ] ui-error-hook set-global + +M: world-error error. + "An error occurred while drawing the world " write + dup world>> pprint-short "." print + "This world has been deactivated to prevent cascading errors." print + error>> error. ; diff --git a/basis/ui/gadgets/presentations/presentations.factor b/basis/ui/gadgets/presentations/presentations.factor old mode 100644 new mode 100755 index a0799c7b86..93a585e330 --- a/basis/ui/gadgets/presentations/presentations.factor +++ b/basis/ui/gadgets/presentations/presentations.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays accessors definitions hashtables io kernel sequences -strings words help math models namespaces quotations ui.gadgets +strings words math models namespaces quotations ui.gadgets ui.gadgets.borders ui.gadgets.buttons ui.gadgets.buttons.private ui.gadgets.labels ui.gadgets.menus ui.gadgets.worlds ui.gadgets.status-bar ui.commands ui.operations ui.gestures ; diff --git a/basis/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor index d85bba9992..af998c08b9 100755 --- a/basis/ui/gadgets/worlds/worlds.factor +++ b/basis/ui/gadgets/worlds/worlds.factor @@ -101,7 +101,7 @@ M: world layout* [ call-next-method ] [ dup layers>> [ as-big-as-possible ] with each ] bi ; -M: world focusable-child* gadget-child ; +M: world focusable-child* children>> [ t ] [ first ] if-empty ; M: world children-on nip children>> ; diff --git a/basis/ui/operations/operations.factor b/basis/ui/operations/operations.factor old mode 100644 new mode 100755 index db6048061e..a502707ee6 --- a/basis/ui/operations/operations.factor +++ b/basis/ui/operations/operations.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays definitions kernel ui.commands ui.gestures sequences strings math words generic namespaces -hashtables help.markup quotations assocs fry linked-assocs ; +hashtables quotations assocs fry linked-assocs ; IN: ui.operations SYMBOL: +keyboard+ diff --git a/basis/ui/tools/debugger/debugger.factor b/basis/ui/tools/debugger/debugger.factor old mode 100644 new mode 100755 index 42666ab064..f3f533e681 --- a/basis/ui/tools/debugger/debugger.factor +++ b/basis/ui/tools/debugger/debugger.factor @@ -8,7 +8,7 @@ ui.gadgets.buttons ui.gadgets.labels ui.gadgets.panes ui.gadgets.presentations ui.gadgets.viewports ui.gadgets.tables ui.gadgets.tracks ui.gadgets.scrollers ui.gadgets.panes ui.gadgets.borders ui.gadgets.status-bar ui.tools.traceback -ui.tools.inspector ui.tools.browser ; +ui.tools.inspector ui.tools.browser ui.debugger ; IN: ui.tools.debugger TUPLE: debugger < track error restarts restart-hook restart-list continuation ; @@ -27,9 +27,6 @@ M: restart-renderer row-columns t >>selection-required? t >>single-click? ; inline -: ( error -- pane ) - [ [ print-error ] with-pane ] keep ; inline - : ( debugger -- gadget ) [ ] dip [ error>> add-gadget ] @@ -72,12 +69,6 @@ M: object error-in-debugger? drop f ; [ rethrow ] [ error-continuation get debugger-window ] if ] ui-error-hook set-global -M: world-error error. - "An error occurred while drawing the world " write - dup world>> pprint-short "." print - "This world has been deactivated to prevent cascading errors." print - error>> error. ; - debugger "gestures" f { { T{ button-down } request-focus } } define-command-map diff --git a/basis/unix/linux/linux.factor b/basis/unix/linux/linux.factor index 0cf33be1bf..43a66f2dbe 100644 --- a/basis/unix/linux/linux.factor +++ b/basis/unix/linux/linux.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2005, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax ; +USING: alien.syntax alien system ; IN: unix ! Linux. @@ -93,13 +93,20 @@ C-STRUCT: passwd { "char*" "pw_dir" } { "char*" "pw_shell" } ; +! dirent64 C-STRUCT: dirent - { "__ino_t" "d_ino" } - { "__off_t" "d_off" } + { "ulonglong" "d_ino" } + { "longlong" "d_off" } { "ushort" "d_reclen" } { "uchar" "d_type" } { { "char" 256 } "d_name" } ; +FUNCTION: int open64 ( char* path, int flags, int prot ) ; +FUNCTION: dirent64* readdir64 ( DIR* dirp ) ; +FUNCTION: int readdir64_r ( void* dirp, dirent* entry, dirent** result ) ; + +M: linux open-file [ open64 ] unix-system-call ; + CONSTANT: EPERM 1 CONSTANT: ENOENT 2 CONSTANT: ESRCH 3 diff --git a/basis/unix/stat/linux/32/32.factor b/basis/unix/stat/linux/32/32.factor index 35963cf4ed..98c4b90f32 100644 --- a/basis/unix/stat/linux/32/32.factor +++ b/basis/unix/stat/linux/32/32.factor @@ -1,29 +1,28 @@ -USING: kernel alien.syntax math ; +USING: kernel alien.syntax math sequences unix +alien.c-types arrays accessors combinators ; IN: unix.stat -! Ubuntu 8.04 32-bit - +! stat64 C-STRUCT: stat - { "dev_t" "st_dev" } - { "ushort" "__pad1" } - { "ino_t" "st_ino" } - { "mode_t" "st_mode" } - { "nlink_t" "st_nlink" } - { "uid_t" "st_uid" } - { "gid_t" "st_gid" } - { "dev_t" "st_rdev" } - { "ushort" "__pad2" } - { "off_t" "st_size" } - { "blksize_t" "st_blksize" } - { "blkcnt_t" "st_blocks" } - { "timespec" "st_atimespec" } - { "timespec" "st_mtimespec" } - { "timespec" "st_ctimespec" } - { "ulong" "unused4" } - { "ulong" "unused5" } ; + { "dev_t" "st_dev" } + { "ushort" "__pad1" } + { "__ino_t" "__st_ino" } + { "mode_t" "st_mode" } + { "nlink_t" "st_nlink" } + { "uid_t" "st_uid" } + { "gid_t" "st_gid" } + { "dev_t" "st_rdev" } + { { "ushort" 2 } "__pad2" } + { "off64_t" "st_size" } + { "blksize_t" "st_blksize" } + { "blkcnt64_t" "st_blocks" } + { "timespec" "st_atimespec" } + { "timespec" "st_mtimespec" } + { "timespec" "st_ctimespec" } + { "ulonglong" "st_ino" } ; -FUNCTION: int __xstat ( int ver, char* pathname, stat* buf ) ; -FUNCTION: int __lxstat ( int ver, char* pathname, stat* buf ) ; +FUNCTION: int __xstat64 ( int ver, char* pathname, stat* buf ) ; +FUNCTION: int __lxstat64 ( int ver, char* pathname, stat* buf ) ; -: stat ( pathname buf -- int ) [ 3 ] 2dip __xstat ; -: lstat ( pathname buf -- int ) [ 3 ] 2dip __lxstat ; +: stat ( pathname buf -- int ) [ 1 ] 2dip __xstat64 ; +: lstat ( pathname buf -- int ) [ 1 ] 2dip __lxstat64 ; diff --git a/basis/unix/stat/linux/64/64.factor b/basis/unix/stat/linux/64/64.factor index 81b33f3227..98c4b90f32 100644 --- a/basis/unix/stat/linux/64/64.factor +++ b/basis/unix/stat/linux/64/64.factor @@ -2,29 +2,27 @@ USING: kernel alien.syntax math sequences unix alien.c-types arrays accessors combinators ; IN: unix.stat -! Ubuntu 7.10 64-bit - +! stat64 C-STRUCT: stat - { "dev_t" "st_dev" } - { "ino_t" "st_ino" } - { "nlink_t" "st_nlink" } - { "mode_t" "st_mode" } - { "uid_t" "st_uid" } - { "gid_t" "st_gid" } - { "int" "pad0" } - { "dev_t" "st_rdev" } - { "off_t" "st_size" } - { "blksize_t" "st_blksize" } - { "blkcnt_t" "st_blocks" } - { "timespec" "st_atimespec" } - { "timespec" "st_mtimespec" } - { "timespec" "st_ctimespec" } - { "long" "__unused0" } - { "long" "__unused1" } - { "long" "__unused2" } ; + { "dev_t" "st_dev" } + { "ushort" "__pad1" } + { "__ino_t" "__st_ino" } + { "mode_t" "st_mode" } + { "nlink_t" "st_nlink" } + { "uid_t" "st_uid" } + { "gid_t" "st_gid" } + { "dev_t" "st_rdev" } + { { "ushort" 2 } "__pad2" } + { "off64_t" "st_size" } + { "blksize_t" "st_blksize" } + { "blkcnt64_t" "st_blocks" } + { "timespec" "st_atimespec" } + { "timespec" "st_mtimespec" } + { "timespec" "st_ctimespec" } + { "ulonglong" "st_ino" } ; -FUNCTION: int __xstat ( int ver, char* pathname, stat* buf ) ; -FUNCTION: int __lxstat ( int ver, char* pathname, stat* buf ) ; +FUNCTION: int __xstat64 ( int ver, char* pathname, stat* buf ) ; +FUNCTION: int __lxstat64 ( int ver, char* pathname, stat* buf ) ; -: stat ( pathname buf -- int ) [ 1 ] 2dip __xstat ; -: lstat ( pathname buf -- int ) [ 1 ] 2dip __lxstat ; +: stat ( pathname buf -- int ) [ 1 ] 2dip __xstat64 ; +: lstat ( pathname buf -- int ) [ 1 ] 2dip __lxstat64 ; diff --git a/basis/unix/types/linux/linux.factor b/basis/unix/types/linux/linux.factor index bf5d4b7f1d..b0340c1778 100644 --- a/basis/unix/types/linux/linux.factor +++ b/basis/unix/types/linux/linux.factor @@ -23,7 +23,11 @@ TYPEDEF: __slongword_type blkcnt_t TYPEDEF: __sword_type ssize_t TYPEDEF: __s32_type pid_t TYPEDEF: __slongword_type time_t +TYPEDEF: __slongword_type __time_t TYPEDEF: ssize_t __SWORD_TYPE +TYPEDEF: ulonglong blkcnt64_t TYPEDEF: ulonglong __fsblkcnt64_t TYPEDEF: ulonglong __fsfilcnt64_t +TYPEDEF: ulonglong ino64_t +TYPEDEF: ulonglong off64_t diff --git a/basis/unix/unix.factor b/basis/unix/unix.factor index 10fb2ad64f..95dca2cb34 100644 --- a/basis/unix/unix.factor +++ b/basis/unix/unix.factor @@ -140,9 +140,11 @@ FUNCTION: int shutdown ( int fd, int how ) ; FUNCTION: int open ( char* path, int flags, int prot ) ; -FUNCTION: DIR* opendir ( char* path ) ; +HOOK: open-file os ( path flags mode -- fd ) -: open-file ( path flags mode -- fd ) [ open ] unix-system-call ; +M: unix open-file [ open ] unix-system-call ; + +FUNCTION: DIR* opendir ( char* path ) ; C-STRUCT: utimbuf { "time_t" "actime" } @@ -165,7 +167,6 @@ FUNCTION: ssize_t read ( int fd, void* buf, size_t nbytes ) ; FUNCTION: dirent* readdir ( DIR* dirp ) ; FUNCTION: int readdir_r ( void* dirp, dirent* entry, dirent** result ) ; - FUNCTION: ssize_t readlink ( char* path, char* buf, size_t bufsize ) ; CONSTANT: PATH_MAX 1024 diff --git a/basis/windows/dinput/constants/constants.factor b/basis/windows/dinput/constants/constants.factor index 74238abed2..ccc28c00e9 100755 --- a/basis/windows/dinput/constants/constants.factor +++ b/basis/windows/dinput/constants/constants.factor @@ -2,7 +2,7 @@ USING: windows.dinput windows.kernel32 windows.ole32 windows.com windows.com.syntax alien alien.c-types alien.syntax kernel system namespaces combinators sequences fry math accessors macros words quotations libc continuations generalizations splitting locals assocs init -struct-arrays ; +struct-arrays memoize ; IN: windows.dinput.constants ! Some global variables aren't provided by the DirectInput DLL (they're in the @@ -18,12 +18,15 @@ SYMBOLS: > [ name>> = ] with find nip ; + c-type* fields>> [ name>> = ] with find nip ; : (offsetof) ( field struct -- offset ) [ (field-spec-of) offset>> ] [ drop 0 ] if* ; : (sizeof) ( field struct -- size ) - [ (field-spec-of) type>> "[" split1 drop heap-size ] [ drop 1 ] if* ; + [ (field-spec-of) type>> "[" split1 drop heap-size* ] [ drop 1 ] if* ; : (flag) ( thing -- integer ) { @@ -79,6 +82,9 @@ SYMBOLS: [ nip length ] [ malloc-DIOBJECTDATAFORMAT-array ] 2bi "DIDATAFORMAT" (DIDATAFORMAT) ; +: initialize ( symbol quot -- ) + call swap set-global ; inline + : (malloc-guid-symbol) ( symbol guid -- ) '[ _ execute( -- value ) diff --git a/extra/game-input/game-input-tests.factor b/extra/game-input/game-input-tests.factor index 2bf923c12b..3cce0da575 100644 --- a/extra/game-input/game-input-tests.factor +++ b/extra/game-input/game-input-tests.factor @@ -1,11 +1,7 @@ IN: game-input.tests -USING: ui game-input tools.test kernel system threads -combinators.short-circuit calendar ; +USING: ui game-input tools.test kernel system threads calendar ; -{ - [ os windows? ui-running? and ] - [ os macosx? ] -} 0|| [ +os windows? os macosx? or [ [ ] [ open-game-input ] unit-test [ ] [ 1 seconds sleep ] unit-test [ ] [ close-game-input ] unit-test diff --git a/extra/game-worlds/game-worlds.factor b/extra/game-worlds/game-worlds.factor index fa6b326fa9..c9ea03e333 100644 --- a/extra/game-worlds/game-worlds.factor +++ b/extra/game-worlds/game-worlds.factor @@ -21,5 +21,3 @@ M: game-world end-world [ [ stop-loop ] when* f ] change-game-loop drop ; -M: game-world focusable-child* drop t ; - diff --git a/extra/opengl/demo-support/demo-support.factor b/extra/opengl/demo-support/demo-support.factor index 8afbd52647..e627a745cd 100755 --- a/extra/opengl/demo-support/demo-support.factor +++ b/extra/opengl/demo-support/demo-support.factor @@ -36,9 +36,6 @@ M: demo-world distance-step ( gadget -- dz ) : zoom-demo-world ( distance gadget -- ) [ + ] with change-distance relayout-1 ; -M: demo-world focusable-child* ( world -- gadget ) - drop t ; - M: demo-world pref-dim* ( gadget -- dim ) drop { 640 480 } ;