diff --git a/GNUmakefile b/GNUmakefile index 4447dfbede..c4796de63b 100755 --- a/GNUmakefile +++ b/GNUmakefile @@ -213,6 +213,8 @@ endif clean: rm -f vm/*.o rm -f factor.dll + rm -f factor.lib + rm -f factor.dll.lib rm -f libfactor.* rm -f libfactor-ffi-test.* rm -f Factor.app/Contents/Frameworks/libfactor.dylib diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index 347d157a79..24221160ce 100644 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -348,52 +348,6 @@ SYMBOLS: "alien_offset" >>unboxer \ void* define-primitive-type - - integer >>class - integer >>boxed-class - [ alien-signed-8 ] >>getter - [ set-alien-signed-8 ] >>setter - 8 >>size - 8-byte-alignment - "from_signed_8" >>boxer - "to_signed_8" >>unboxer - \ longlong define-primitive-type - - - integer >>class - integer >>boxed-class - [ alien-unsigned-8 ] >>getter - [ set-alien-unsigned-8 ] >>setter - 8 >>size - 8-byte-alignment - "from_unsigned_8" >>boxer - "to_unsigned_8" >>unboxer - \ ulonglong define-primitive-type - - - integer >>class - integer >>boxed-class - [ alien-signed-cell ] >>getter - [ set-alien-signed-cell ] >>setter - bootstrap-cell >>size - bootstrap-cell >>align - bootstrap-cell >>align-first - "from_signed_cell" >>boxer - "to_fixnum" >>unboxer - \ long define-primitive-type - - - integer >>class - integer >>boxed-class - [ alien-unsigned-cell ] >>getter - [ set-alien-unsigned-cell ] >>setter - bootstrap-cell >>size - bootstrap-cell >>align - bootstrap-cell >>align-first - "from_unsigned_cell" >>boxer - "to_cell" >>unboxer - \ ulong define-primitive-type - integer >>class integer >>boxed-class @@ -514,16 +468,75 @@ SYMBOLS: [ >float ] >>unboxer-quot \ double define-primitive-type - cpu x86.64? os windows? and [ + cell 8 = [ + + integer >>class + integer >>boxed-class + [ alien-signed-cell ] >>getter + [ set-alien-signed-cell ] >>setter + bootstrap-cell >>size + bootstrap-cell >>align + bootstrap-cell >>align-first + "from_signed_cell" >>boxer + "to_fixnum" >>unboxer + \ longlong define-primitive-type + + + integer >>class + integer >>boxed-class + [ alien-unsigned-cell ] >>getter + [ set-alien-unsigned-cell ] >>setter + bootstrap-cell >>size + bootstrap-cell >>align + bootstrap-cell >>align-first + "from_unsigned_cell" >>boxer + "to_cell" >>unboxer + \ ulonglong define-primitive-type + + os windows? [ + \ int c-type \ long define-primitive-type + \ uint c-type \ ulong define-primitive-type + ] [ + \ longlong c-type \ long define-primitive-type + \ ulonglong c-type \ ulong define-primitive-type + ] if + \ longlong c-type \ ptrdiff_t typedef \ longlong c-type \ intptr_t typedef + \ ulonglong c-type \ uintptr_t typedef \ ulonglong c-type \ size_t typedef ] [ - \ long c-type \ ptrdiff_t typedef - \ long c-type \ intptr_t typedef - \ ulong c-type \ uintptr_t typedef - \ ulong c-type \ size_t typedef + + integer >>class + integer >>boxed-class + [ alien-signed-8 ] >>getter + [ set-alien-signed-8 ] >>setter + 8 >>size + 8-byte-alignment + "from_signed_8" >>boxer + "to_signed_8" >>unboxer + \ longlong define-primitive-type + + + integer >>class + integer >>boxed-class + [ alien-unsigned-8 ] >>getter + [ set-alien-unsigned-8 ] >>setter + 8 >>size + 8-byte-alignment + "from_unsigned_8" >>boxer + "to_unsigned_8" >>unboxer + \ ulonglong define-primitive-type + + \ int c-type \ long define-primitive-type + \ uint c-type \ ulong define-primitive-type + + \ int c-type \ ptrdiff_t typedef + \ int c-type \ intptr_t typedef + + \ uint c-type \ uintptr_t typedef + \ uint c-type \ size_t typedef ] if ] with-compilation-unit diff --git a/basis/cocoa/cocoa-tests.factor b/basis/cocoa/cocoa-tests.factor index 892d5ea38d..f35d151ad4 100644 --- a/basis/cocoa/cocoa-tests.factor +++ b/basis/cocoa/cocoa-tests.factor @@ -1,5 +1,5 @@ USING: cocoa cocoa.messages cocoa.subclassing cocoa.types -compiler kernel namespaces cocoa.classes cocoa.runtime +compiler.test kernel namespaces cocoa.classes cocoa.runtime tools.test memory compiler.units math core-graphics.types ; FROM: alien.c-types => int void ; IN: cocoa.tests diff --git a/basis/compiler/cfg/ssa/construction/tdmsc/tdmsc.factor b/basis/compiler/cfg/ssa/construction/tdmsc/tdmsc.factor index 647c97d6c3..4b459e90fb 100644 --- a/basis/compiler/cfg/ssa/construction/tdmsc/tdmsc.factor +++ b/basis/compiler/cfg/ssa/construction/tdmsc/tdmsc.factor @@ -86,7 +86,7 @@ SYMBOLS: visited merge-sets levels again? ; cfg get reverse-post-order ; inline : filter-by ( flags seq -- seq' ) - [ drop ] pusher [ 2each ] dip ; + [ drop ] selector [ 2each ] dip ; HINTS: filter-by { bit-array object } ; @@ -107,4 +107,4 @@ PRIVATE> ] 2each ; inline : merge-set ( bbs -- bbs' ) - (merge-set) filter-by ; \ No newline at end of file + (merge-set) filter-by ; diff --git a/basis/compiler/cfg/stacks/uninitialized/uninitialized.factor b/basis/compiler/cfg/stacks/uninitialized/uninitialized.factor index e5fbfa6c40..5b2bbf3765 100644 --- a/basis/compiler/cfg/stacks/uninitialized/uninitialized.factor +++ b/basis/compiler/cfg/stacks/uninitialized/uninitialized.factor @@ -55,7 +55,7 @@ M: insn visit-insn drop ; 2dup [ length ] bi@ max '[ _ 1 pad-tail ] bi@ [ bitand ] 2map ; : (uninitialized-locs) ( seq quot -- seq' ) - [ [ drop 0 = ] pusher [ each-index ] dip ] dip map ; inline + [ [ drop 0 = ] selector [ each-index ] dip ] dip map ; inline PRIVATE> diff --git a/basis/compiler/compiler-docs.factor b/basis/compiler/compiler-docs.factor index f59d4fb027..5ee0e265e4 100644 --- a/basis/compiler/compiler-docs.factor +++ b/basis/compiler/compiler-docs.factor @@ -16,11 +16,7 @@ ARTICLE: "compiler-usage" "Calling the optimizing compiler" disable-optimizer enable-optimizer } -"Removing a word's optimized definition:" -{ $subsections decompile } -"Compiling a single quotation:" -{ $subsections compile-call } -"Higher-level words can be found in " { $link "compilation-units" } "." ; +"More words can be found in " { $link "compilation-units" } "." ; ARTICLE: "compiler-impl" "Compiler implementation" "The " { $vocab-link "compiler" } "vocabulary, in addition to providing the user-visible words of the compiler, implements the main compilation loop." @@ -60,10 +56,6 @@ $nl ABOUT: "compiler" -HELP: decompile -{ $values { "word" word } } -{ $description "Removes a word's optimized definition. The word will be compiled with the non-optimizing compiler until recompiled with the optimizing compiler again." } ; - HELP: compile-word { $values { "word" word } } { $description "Compile a single word." } @@ -72,8 +64,3 @@ HELP: compile-word HELP: optimizing-compiler { $description "Singleton class implementing " { $link recompile } " to call the optimizing compiler." } { $notes "This is an internal word, and user code should call " { $link compile } " instead." } ; - -HELP: compile-call -{ $values { "quot" quotation } } -{ $description "Compiles and runs a quotation." } -{ $notes "This word is used by compiler unit tests to test compilation of small pieces of code." } ; diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor index 2375d8575d..bf9b049127 100644 --- a/basis/compiler/compiler.factor +++ b/basis/compiler/compiler.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2004, 2009 Slava Pestov. +! Copyright (C) 2004, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel namespaces arrays sequences io words fry continuations vocabs assocs dlists definitions math graphs generic @@ -181,14 +181,6 @@ t compile-dependencies? set-global : compile-loop ( deque -- ) [ compile-word yield-hook get call( -- ) ] slurp-deque ; -: decompile ( word -- ) - dup def>> 2array 1array modify-code-heap ; - -: compile-call ( quot -- ) - [ dup infer define-temp ] with-compilation-unit execute ; - -\ compile-call t "no-compile" set-word-prop - SINGLETON: optimizing-compiler M: optimizing-compiler recompile ( words -- alist ) @@ -220,6 +212,3 @@ M: optimizing-compiler process-forgotten-words : disable-optimizer ( -- ) f compiler-impl set-global ; - -: recompile-all ( -- ) - all-words compile ; diff --git a/basis/compiler/test/authors.txt b/basis/compiler/test/authors.txt new file mode 100644 index 0000000000..d4f5d6b3ae --- /dev/null +++ b/basis/compiler/test/authors.txt @@ -0,0 +1 @@ +Slava Pestov \ No newline at end of file diff --git a/basis/compiler/test/test.factor b/basis/compiler/test/test.factor new file mode 100644 index 0000000000..cc7b382253 --- /dev/null +++ b/basis/compiler/test/test.factor @@ -0,0 +1,19 @@ +! Copyright (C) 2010 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays compiler.units kernel stack-checker +sequences vocabs words tools.test tools.test.private ; +IN: compiler.test + +: decompile ( word -- ) + dup def>> 2array 1array modify-code-heap ; + +: recompile-all ( -- ) + all-words compile ; + +: compile-call ( quot -- ) + [ dup infer define-temp ] with-compilation-unit execute ; + +<< \ compile-call t "no-compile" set-word-prop >> + +: compiler-test ( name -- ) + "resource:basis/compiler/tests/" ".factor" surround run-test-file ; diff --git a/basis/compiler/tests/codegen.factor b/basis/compiler/tests/codegen.factor index cff685eaf6..288940e660 100644 --- a/basis/compiler/tests/codegen.factor +++ b/basis/compiler/tests/codegen.factor @@ -1,4 +1,4 @@ -USING: generalizations accessors arrays compiler kernel +USING: generalizations accessors arrays compiler.test kernel kernel.private math hashtables.private math.private namespaces sequences tools.test namespaces.private slots.private sequences.private byte-arrays alien alien.accessors layouts diff --git a/basis/compiler/tests/curry.factor b/basis/compiler/tests/curry.factor index b541e19f34..ddbd9ba646 100644 --- a/basis/compiler/tests/curry.factor +++ b/basis/compiler/tests/curry.factor @@ -1,5 +1,5 @@ USING: tools.test quotations math kernel sequences -assocs namespaces make compiler.units compiler ; +assocs namespaces make compiler.units compiler.test ; IN: compiler.tests.curry [ 3 ] [ 5 [ [ 2 - ] curry call ] compile-call ] unit-test diff --git a/basis/compiler/tests/float.factor b/basis/compiler/tests/float.factor index 632a560c0d..0d4e30279e 100644 --- a/basis/compiler/tests/float.factor +++ b/basis/compiler/tests/float.factor @@ -1,5 +1,6 @@ -USING: compiler.units compiler kernel kernel.private memory math -math.private tools.test math.floats.private math.order fry ; +USING: compiler.units compiler.test kernel kernel.private memory +math math.private tools.test math.floats.private math.order fry +; IN: compiler.tests.float [ 5.0 ] [ [ 5.0 ] compile-call gc gc gc ] unit-test diff --git a/basis/compiler/tests/intrinsics.factor b/basis/compiler/tests/intrinsics.factor index 1c066f26a3..53017ff452 100644 --- a/basis/compiler/tests/intrinsics.factor +++ b/basis/compiler/tests/intrinsics.factor @@ -4,7 +4,7 @@ strings tools.test words continuations sequences.private hashtables.private byte-arrays system random layouts vectors sbufs strings.private slots.private alien math.order alien.accessors alien.c-types alien.data alien.syntax alien.strings -namespaces libc io.encodings.ascii classes compiler ; +namespaces libc io.encodings.ascii classes compiler.test ; FROM: math => float ; IN: compiler.tests.intrinsics diff --git a/basis/compiler/tests/optimizer.factor b/basis/compiler/tests/optimizer.factor index 865cd639a3..fe67cbbc37 100644 --- a/basis/compiler/tests/optimizer.factor +++ b/basis/compiler/tests/optimizer.factor @@ -4,7 +4,7 @@ sbufs strings tools.test vectors words sequences.private quotations classes classes.algebra classes.tuple.private continuations growable namespaces hints alien.accessors compiler.tree.builder compiler.tree.optimizer sequences.deep -compiler definitions generic.single shuffle math.order ; +compiler.test definitions generic.single shuffle math.order ; IN: compiler.tests.optimizer GENERIC: xyz ( obj -- obj ) diff --git a/basis/compiler/tests/simple.factor b/basis/compiler/tests/simple.factor index a86d5b8c52..df67cadd78 100644 --- a/basis/compiler/tests/simple.factor +++ b/basis/compiler/tests/simple.factor @@ -1,4 +1,4 @@ -USING: compiler compiler.units tools.test kernel kernel.private +USING: compiler.test compiler.units tools.test kernel kernel.private sequences.private math.private math combinators strings alien arrays memory vocabs parser eval quotations compiler.errors definitions ; diff --git a/basis/compiler/tests/tuples.factor b/basis/compiler/tests/tuples.factor index 3d6301249f..978c27768f 100644 --- a/basis/compiler/tests/tuples.factor +++ b/basis/compiler/tests/tuples.factor @@ -1,4 +1,4 @@ -USING: kernel tools.test compiler.units compiler ; +USING: kernel tools.test compiler.units compiler.test ; IN: compiler.tests.tuples TUPLE: color red green blue ; diff --git a/basis/concurrency/combinators/combinators.factor b/basis/concurrency/combinators/combinators.factor index 918b3c5ba0..44cad8de61 100644 --- a/basis/concurrency/combinators/combinators.factor +++ b/basis/concurrency/combinators/combinators.factor @@ -22,7 +22,7 @@ PRIVATE> ] (parallel-each) ; inline : parallel-filter ( seq quot -- newseq ) - over [ pusher [ parallel-each ] dip ] dip like ; inline + over [ selector [ parallel-each ] dip ] dip like ; inline > @ ] dlist-each-node ; inline : dlist>seq ( dlist -- seq ) - [ ] accumulator [ dlist-each ] dip ; + [ ] collector [ dlist-each ] dip ; : 1dlist ( obj -- dlist ) [ push-front ] keep ; diff --git a/basis/documents/documents.factor b/basis/documents/documents.factor index aef4f4de78..dcd1bf5820 100644 --- a/basis/documents/documents.factor +++ b/basis/documents/documents.factor @@ -61,7 +61,7 @@ TUPLE: document < model locs undos redos inside-undo? ; ] if ; inline : map-lines ( from to quot -- results ) - accumulator [ each-line ] dip ; inline + collector [ each-line ] dip ; inline : start/end-on-line ( from to line# document -- n1 n2 ) [ start-on-line ] [ end-on-line ] bi-curry bi-curry bi* ; diff --git a/basis/environment/unix/unix.factor b/basis/environment/unix/unix.factor index 3fc8c2f79b..ec41e919d8 100644 --- a/basis/environment/unix/unix.factor +++ b/basis/environment/unix/unix.factor @@ -3,7 +3,7 @@ USING: alien alien.c-types alien.data alien.strings alien.syntax kernel layouts sequences system unix environment io.encodings.utf8 unix.utilities vocabs.loader -combinators alien.accessors ; +combinators alien.accessors unix.ffi ; IN: environment.unix HOOK: environ os ( -- void* ) diff --git a/basis/game/input/dinput/dinput.factor b/basis/game/input/dinput/dinput.factor index d3540a99a9..e2c1fda759 100755 --- a/basis/game/input/dinput/dinput.factor +++ b/basis/game/input/dinput/dinput.factor @@ -314,7 +314,7 @@ CONSTANT: pov-values } case ; : fill-mouse-state ( buffer count -- state ) - [ +mouse-state+ get ] 2dip swap [ nth (fill-mouse-state) ] curry each ; + iota [ +mouse-state+ get ] 2dip swap [ nth (fill-mouse-state) ] curry each ; : get-device-state ( device DIJOYSTATE2 -- ) [ dup IDirectInputDevice8W::Poll ole32-error ] dip diff --git a/basis/images/jpeg/jpeg.factor b/basis/images/jpeg/jpeg.factor index 9a67d43e7d..a7f08504bb 100644 --- a/basis/images/jpeg/jpeg.factor +++ b/basis/images/jpeg/jpeg.factor @@ -351,7 +351,7 @@ SINGLETONS: YUV420 YUV444 Y MAGIC! ; [ bitstream>> ] [ [ [ ] with map ] change-huff-tables drop ] bi jpeg> components>> [ fetch-tables ] each - [ decode-macroblock 2array ] accumulator + [ decode-macroblock 2array ] collector [ all-macroblocks ] dip jpeg> setup-bitmap draw-macroblocks jpeg> bitmap>> 3 [ color-transform ] map! drop diff --git a/basis/io/backend/unix/unix.factor b/basis/io/backend/unix/unix.factor index a8070525c7..1797edccf6 100644 --- a/basis/io/backend/unix/unix.factor +++ b/basis/io/backend/unix/unix.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types alien.syntax generic assocs kernel kernel.private math io.ports sequences strings sbufs threads -unix vectors io.buffers io.backend io.encodings math.parser +unix unix.ffi vectors io.buffers io.backend io.encodings math.parser continuations system libc namespaces make io.timeouts io.encodings.utf8 destructors destructors.private accessors summary combinators locals unix.time unix.types fry @@ -17,8 +17,8 @@ TUPLE: fd < disposable fd ; : init-fd ( fd -- fd ) [ |dispose - dup fd>> F_SETFL O_NONBLOCK fcntl io-error - dup fd>> F_SETFD FD_CLOEXEC fcntl io-error + dup fd>> F_SETFL O_NONBLOCK [ fcntl ] unix-system-call drop + dup fd>> F_SETFD FD_CLOEXEC [ fcntl ] unix-system-call drop ] with-destructors ; : ( n -- fd ) @@ -50,7 +50,7 @@ M: fd cancel-operation ( fd -- ) ] if ; M: unix tell-handle ( handle -- n ) - fd>> 0 SEEK_CUR lseek [ io-error ] [ ] bi ; + fd>> 0 SEEK_CUR [ lseek ] unix-system-call [ io-error ] [ ] bi ; M: unix seek-handle ( n seek-type handle -- ) swap { @@ -59,7 +59,7 @@ M: unix seek-handle ( n seek-type handle -- ) { io:seek-end [ SEEK_END ] } [ io:bad-seek-type ] } case - [ fd>> swap ] dip lseek io-error ; + [ fd>> swap ] dip [ lseek ] unix-system-call drop ; SYMBOL: +retry+ ! just try the operation again without blocking SYMBOL: +input+ diff --git a/basis/io/directories/search/search.factor b/basis/io/directories/search/search.factor index 4356a0b988..28d7f63d87 100644 --- a/basis/io/directories/search/search.factor +++ b/basis/io/directories/search/search.factor @@ -64,17 +64,17 @@ PRIVATE> setup-traversal iterate-directory-entries drop ; inline : recursive-directory-files ( path bfs? -- paths ) - [ ] accumulator [ each-file ] dip ; inline + [ ] collector [ each-file ] dip ; inline : recursive-directory-entries ( path bfs? -- directory-entries ) - [ ] accumulator [ each-directory-entry ] dip ; inline + [ ] collector [ each-directory-entry ] dip ; inline : find-file ( path bfs? quot -- path/f ) [ ] dip [ keep and ] curry iterate-directory ; inline : find-all-files ( path quot -- paths/f ) - [ f ] dip pusher + [ f ] dip selector [ [ f ] compose iterate-directory drop ] dip ; inline ERROR: file-not-found path bfs? quot ; diff --git a/basis/io/directories/unix/linux/linux.factor b/basis/io/directories/unix/linux/linux.factor index 3af4c09f28..932cbe230b 100644 --- a/basis/io/directories/unix/linux/linux.factor +++ b/basis/io/directories/unix/linux/linux.factor @@ -1,11 +1,11 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types io.directories.unix kernel system unix -classes.struct ; +classes.struct unix.ffi ; IN: io.directories.unix.linux M: unix find-next-file ( DIR* -- dirent ) dirent f - [ readdir64_r 0 = [ (io-error) ] unless ] 2keep + [ [ readdir64_r ] unix-system-call 0 = [ (io-error) ] unless ] 2keep *void* [ drop f ] unless ; diff --git a/basis/io/directories/unix/unix.factor b/basis/io/directories/unix/unix.factor index 06ba73bb46..77d7f2d1b2 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 vocabs.loader classes.struct ; +unix unix.stat vocabs.loader classes.struct unix.ffi ; IN: io.directories.unix : touch-mode ( -- n ) @@ -17,15 +17,15 @@ M: unix touch-file ( path -- ) ] if ; M: unix move-file ( from to -- ) - [ normalize-path ] bi@ rename io-error ; + [ normalize-path ] bi@ [ rename ] unix-system-call drop ; M: unix delete-file ( path -- ) normalize-path unlink-file ; M: unix make-directory ( path -- ) - normalize-path OCT: 777 mkdir io-error ; + normalize-path OCT: 777 [ mkdir ] unix-system-call drop ; M: unix delete-directory ( path -- ) - normalize-path rmdir io-error ; + normalize-path [ rmdir ] unix-system-call drop ; M: unix copy-file ( from to -- ) [ normalize-path ] bi@ call-next-method ; diff --git a/basis/io/files/info/info.factor b/basis/io/files/info/info.factor index 60a9308f38..500fd62cd3 100644 --- a/basis/io/files/info/info.factor +++ b/basis/io/files/info/info.factor @@ -26,7 +26,7 @@ available-space free-space used-space total-space ; HOOK: file-system-info os ( path -- file-system-info ) { - { [ os unix? ] [ "io.files.info.unix." os name>> append ] } + { [ os unix? ] [ "io.files.info" ] } { [ os windows? ] [ "io.files.info.windows" ] } } cond require diff --git a/basis/io/files/info/unix/unix.factor b/basis/io/files/info/unix/unix.factor index eedf8de47a..3b85467964 100644 --- a/basis/io/files/info/unix/unix.factor +++ b/basis/io/files/info/unix/unix.factor @@ -1,13 +1,13 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel system math math.bitwise strings arrays -sequences combinators combinators.short-circuit alien.c-types -vocabs.loader calendar calendar.unix io.files.info -io.files.types io.backend io.directories unix unix.stat -unix.time unix.users unix.groups classes.struct -specialized-arrays literals ; -SPECIALIZED-ARRAY: timeval +USING: accessors alien.c-types arrays calendar calendar.unix +classes.struct combinators combinators.short-circuit io.backend +io.directories io.files.info io.files.types kernel literals +math math.bitwise sequences specialized-arrays strings system +unix unix.ffi unix.groups unix.stat unix.time unix.users +vocabs.loader ; IN: io.files.info.unix +SPECIALIZED-ARRAY: timeval TUPLE: unix-file-system-info < file-system-info block-size preferred-block-size @@ -109,7 +109,7 @@ M: unix stat>type ( stat -- type ) : chmod-set-bit ( path mask ? -- ) [ dup stat-mode ] 2dip - [ bitor ] [ unmask ] if chmod io-error ; + [ bitor ] [ unmask ] if [ chmod ] unix-system-call drop ; GENERIC# file-mode? 1 ( obj mask -- ? ) @@ -174,7 +174,7 @@ CONSTANT: ALL-EXECUTE OCT: 0000111 : set-other-execute ( path ? -- ) OTHER-EXECUTE swap chmod-set-bit ; : set-file-permissions ( path n -- ) - [ normalize-path ] dip chmod io-error ; + [ normalize-path ] dip [ chmod ] unix-system-call drop ; : file-permissions ( path -- n ) normalize-path file-info permissions>> ; @@ -202,7 +202,7 @@ PRIVATE> : set-file-times ( path timestamps -- ) #! set access, write [ normalize-path ] dip - timestamps>byte-array utimes io-error ; + timestamps>byte-array [ utimes ] unix-system-call drop ; : set-file-access-time ( path timestamp -- ) f 2array set-file-times ; @@ -211,7 +211,8 @@ PRIVATE> f swap 2array set-file-times ; : set-file-ids ( path uid gid -- ) - [ normalize-path ] 2dip [ -1 or ] bi@ chown io-error ; + [ normalize-path ] 2dip [ -1 or ] bi@ + [ chown ] unix-system-call drop ; GENERIC: set-file-user ( path string/id -- ) @@ -285,3 +286,5 @@ PRIVATE> { +regular-file+ [ file-type>executable ] } [ drop file-type>executable ] } case ; + +"io.files.info.unix." os name>> append require diff --git a/basis/io/files/links/unix/unix.factor b/basis/io/files/links/unix/unix.factor index f41adfa731..3f67bb453f 100644 --- a/basis/io/files/links/unix/unix.factor +++ b/basis/io/files/links/unix/unix.factor @@ -1,14 +1,14 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: io.backend io.files.links system unix io.pathnames kernel -io.files sequences ; +USING: io.backend io.files io.files.links io.pathnames kernel +sequences system unix unix.ffi ; IN: io.files.links.unix M: unix make-link ( path1 path2 -- ) - normalize-path symlink io-error ; + normalize-path [ symlink ] unix-system-call drop ; M: unix make-hard-link ( path1 path2 -- ) - normalize-path link io-error ; + normalize-path [ link ] unix-system-call drop ; M: unix read-link ( path -- path' ) normalize-path read-symbolic-link ; diff --git a/basis/io/files/unique/unix/unix.factor b/basis/io/files/unique/unix/unix.factor index 9f35f440c7..ec72d9128b 100644 --- a/basis/io/files/unique/unix/unix.factor +++ b/basis/io/files/unique/unix/unix.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: kernel io.ports io.backend.unix math.bitwise -unix system io.files.unique ; +unix system io.files.unique unix.ffi ; IN: io.files.unique.unix : open-unique-flags ( -- flags ) diff --git a/basis/io/files/unix/unix.factor b/basis/io/files/unix/unix.factor index 9518d1c754..bf0a21f997 100644 --- a/basis/io/files/unix/unix.factor +++ b/basis/io/files/unix/unix.factor @@ -2,11 +2,12 @@ ! See http://factorcode.org/license.txt for BSD license. USING: unix byte-arrays kernel io.backend.unix math.bitwise io.ports io.files io.files.private io.pathnames environment -destructors system ; +destructors system unix.ffi ; IN: io.files.unix M: unix cwd ( -- path ) - MAXPATHLEN [ ] keep getcwd + MAXPATHLEN [ ] keep + [ getcwd ] unix-system-call [ (io-error) ] unless* ; M: unix cd ( path -- ) [ chdir ] unix-system-call drop ; @@ -33,7 +34,7 @@ M: unix (file-writer) ( path -- stream ) : open-append ( path -- fd ) [ append-flags file-mode open-file |dispose - dup 0 SEEK_END lseek io-error + dup 0 SEEK_END [ lseek ] unix-system-call drop ] with-destructors ; M: unix (file-appender) ( path -- stream ) diff --git a/basis/io/launcher/launcher.factor b/basis/io/launcher/launcher.factor old mode 100644 new mode 100755 index cb20f78a33..3999a026c0 --- a/basis/io/launcher/launcher.factor +++ b/basis/io/launcher/launcher.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: system kernel namespaces strings hashtables sequences assocs combinators vocabs.loader init threads continuations math accessors @@ -127,16 +127,17 @@ M: process-was-killed error. "Launch descriptor:" print nl process>> . ; -: wait-for-process ( process -- status ) +: (wait-for-process) ( process -- status ) + dup handle>> [ - dup handle>> - [ - dup [ processes get at push ] curry - "process" suspend drop - ] when - dup killed>> - [ process-was-killed ] [ status>> ] if - ] with-timeout ; + dup [ processes get at push ] curry + "process" suspend drop + ] when + dup killed>> + [ process-was-killed ] [ status>> ] if ; + +: wait-for-process ( process -- status ) + [ (wait-for-process) ] with-timeout ; : run-detached ( desc -- process ) >process @@ -264,7 +265,7 @@ M: output-process-error error. +stdout+ >>stderr [ +closed+ or ] change-stdin utf8 - [ stream-contents ] [ dup wait-for-process ] bi* + [ [ stream-contents ] [ dup (wait-for-process) ] bi* ] with-timeout 0 = [ 2drop ] [ output-process-error ] if ; : notify-exit ( process status -- ) diff --git a/basis/io/launcher/unix/unix.factor b/basis/io/launcher/unix/unix.factor index a9e3324986..28c805a528 100644 --- a/basis/io/launcher/unix/unix.factor +++ b/basis/io/launcher/unix/unix.factor @@ -5,7 +5,7 @@ continuations environment io io.backend io.backend.unix io.files io.files.private io.files.unix io.launcher io.launcher.unix.parser io.pathnames io.ports kernel math namespaces sequences strings system threads unix -unix.process ; +unix.process unix.ffi ; IN: io.launcher.unix : get-arguments ( process -- seq ) diff --git a/basis/io/launcher/windows/nt/nt-tests.factor b/basis/io/launcher/windows/nt/nt-tests.factor old mode 100644 new mode 100755 index 85999a89f7..c97c411d2c --- a/basis/io/launcher/windows/nt/nt-tests.factor +++ b/basis/io/launcher/windows/nt/nt-tests.factor @@ -23,6 +23,20 @@ IN: io.launcher.windows.nt.tests [ f ] [ "notepad" get process-running? ] unit-test +[ + + "notepad" >>command + 1/2 seconds >>timeout + try-process +] must-fail + +[ + + "notepad" >>command + 1/2 seconds >>timeout + try-output-process +] must-fail + : console-vm ( -- path ) vm ".exe" ?tail [ ".com" append ] when ; diff --git a/basis/io/mmap/unix/unix.factor b/basis/io/mmap/unix/unix.factor index 559417d2b9..f426201b06 100644 --- a/basis/io/mmap/unix/unix.factor +++ b/basis/io/mmap/unix/unix.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors destructors io.backend.unix io.mmap -io.mmap.private kernel locals math.bitwise system unix ; +io.mmap.private kernel locals math.bitwise system unix unix.ffi ; IN: io.mmap.unix :: mmap-open ( path length prot flags open-mode -- alien fd ) diff --git a/basis/io/pipes/unix/unix.factor b/basis/io/pipes/unix/unix.factor index 8493f14d26..7dbeb0a589 100644 --- a/basis/io/pipes/unix/unix.factor +++ b/basis/io/pipes/unix/unix.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types system kernel unix math sequences -io.backend.unix io.ports specialized-arrays accessors ; +io.backend.unix io.ports specialized-arrays accessors unix.ffi ; QUALIFIED: io.pipes SPECIALIZED-ARRAY: int IN: io.pipes.unix diff --git a/basis/io/sockets/secure/unix/unix.factor b/basis/io/sockets/secure/unix/unix.factor index b04d282530..8fe9facc0c 100644 --- a/basis/io/sockets/secure/unix/unix.factor +++ b/basis/io/sockets/secure/unix/unix.factor @@ -6,7 +6,8 @@ alien.strings libc continuations destructors openssl openssl.libcrypto openssl.libssl io io.files io.ports io.backend.unix io.sockets.unix io.encodings.ascii io.buffers io.sockets io.sockets.private io.sockets.secure -io.sockets.secure.openssl io.timeouts system summary fry ; +io.sockets.secure.openssl io.timeouts system summary fry +unix.ffi ; FROM: io.ports => shutdown ; IN: io.sockets.secure.unix diff --git a/basis/io/sockets/sockets.factor b/basis/io/sockets/sockets.factor index e45224fcc2..af21dac9b7 100644 --- a/basis/io/sockets/sockets.factor +++ b/basis/io/sockets/sockets.factor @@ -11,7 +11,7 @@ IN: io.sockets << { { [ os windows? ] [ "windows.winsock" ] } - { [ os unix? ] [ "unix" ] } + { [ os unix? ] [ "unix.ffi" ] } } cond use-vocab >> ! Addressing diff --git a/basis/io/sockets/unix/unix.factor b/basis/io/sockets/unix/unix.factor index cdf7e54408..cc0740500a 100644 --- a/basis/io/sockets/unix/unix.factor +++ b/basis/io/sockets/unix/unix.factor @@ -5,7 +5,7 @@ threads sequences byte-arrays io.binary io.backend.unix io.streams.duplex io.backend io.pathnames io.sockets.private io.files.private io.encodings.utf8 math.parser continuations libc combinators system accessors destructors unix locals init -classes.struct alien.data ; +classes.struct alien.data unix.ffi ; EXCLUDE: namespaces => bind ; EXCLUDE: io => read write ; @@ -59,10 +59,15 @@ M: object (get-remote-address) ( handle local -- sockaddr ) [ (io-error) ] } cond ; -M: object establish-connection ( client-out remote -- ) - [ drop ] [ [ handle>> handle-fd ] [ make-sockaddr/size ] bi* connect ] 2bi +M:: object establish-connection ( client-out remote -- ) + client-out remote + [ drop ] + [ + [ handle>> handle-fd ] [ make-sockaddr/size ] bi* connect + ] 2bi { { [ 0 = ] [ drop ] } + { [ errno EINTR = ] [ drop client-out remote establish-connection ] } { [ errno EINPROGRESS = ] [ [ +output+ wait-for-port ] [ wait-to-connect ] bi ] } @@ -70,7 +75,12 @@ M: object establish-connection ( client-out remote -- ) } cond ; : ?bind-client ( socket -- ) - bind-local-address get [ [ fd>> ] dip make-sockaddr/size bind io-error ] [ drop ] if* ; inline + bind-local-address get [ + [ fd>> ] dip make-sockaddr/size + [ bind ] unix-system-call drop + ] [ + drop + ] if* ; inline M: object ((client)) ( addrspec -- fd ) protocol-family SOCK_STREAM socket-fd @@ -83,12 +93,12 @@ M: object ((client)) ( addrspec -- fd ) : server-socket-fd ( addrspec type -- fd ) [ dup protocol-family ] dip socket-fd [ init-server-socket ] keep - [ handle-fd swap make-sockaddr/size bind io-error ] keep ; + [ handle-fd swap make-sockaddr/size [ bind ] unix-system-call drop ] keep ; M: object (server) ( addrspec -- handle ) [ SOCK_STREAM server-socket-fd - dup handle-fd 128 listen io-error + dup handle-fd 128 [ listen ] unix-system-call drop ] with-destructors ; : do-accept ( server addrspec -- fd sockaddr ) diff --git a/basis/lists/lists.factor b/basis/lists/lists.factor index f3475f960b..29adcd47d6 100644 --- a/basis/lists/lists.factor +++ b/basis/lists/lists.factor @@ -88,7 +88,7 @@ PRIVATE> nil [ swons ] reduce ; : lmap>array ( list quot -- array ) - accumulator [ leach ] dip { } like ; inline + collector [ leach ] dip { } like ; inline : list>array ( list -- array ) [ ] lmap>array ; diff --git a/basis/math/blas/config/config.factor b/basis/math/blas/config/config.factor index 09f736c036..bce6e663af 100644 --- a/basis/math/blas/config/config.factor +++ b/basis/math/blas/config/config.factor @@ -15,7 +15,6 @@ blas-fortran-abi [ { { [ os macosx? ] [ intel-unix-abi ] } { [ os windows? cpu x86.32? and ] [ f2c-abi ] } - { [ os netbsd? cpu x86.64? and ] [ g95-abi ] } { [ os windows? cpu x86.64? and ] [ gfortran-abi ] } { [ os freebsd? ] [ gfortran-abi ] } { [ os linux? ] [ gfortran-abi ] } diff --git a/basis/math/floats/env/env-tests.factor b/basis/math/floats/env/env-tests.factor index 3c21b0cf3e..89aa1bd394 100644 --- a/basis/math/floats/env/env-tests.factor +++ b/basis/math/floats/env/env-tests.factor @@ -1,7 +1,7 @@ USING: kernel math math.floats.env math.floats.env.private math.functions math.libm sequences tools.test locals -compiler.units kernel.private fry compiler math.private words -system ; +compiler.units kernel.private fry compiler.test math.private +words system ; IN: math.floats.env.tests : set-default-fp-env ( -- ) diff --git a/basis/math/vectors/conversion/conversion-tests.factor b/basis/math/vectors/conversion/conversion-tests.factor index c91bdb369e..d46f062d9c 100644 --- a/basis/math/vectors/conversion/conversion-tests.factor +++ b/basis/math/vectors/conversion/conversion-tests.factor @@ -1,5 +1,5 @@ ! (c)Joe Groff bsd license -USING: accessors arrays compiler continuations generalizations +USING: accessors arrays compiler.test continuations generalizations kernel kernel.private locals math.vectors.conversion math.vectors.simd sequences stack-checker tools.test ; FROM: alien.c-types => char uchar short ushort int uint longlong ulonglong float double ; diff --git a/basis/math/vectors/simd/simd-tests.factor b/basis/math/vectors/simd/simd-tests.factor index 342c565dce..1d19c76dc1 100644 --- a/basis/math/vectors/simd/simd-tests.factor +++ b/basis/math/vectors/simd/simd-tests.factor @@ -1,4 +1,4 @@ -USING: accessors arrays classes compiler compiler.tree.debugger +USING: accessors arrays classes compiler.test compiler.tree.debugger effects fry io kernel kernel.private math math.functions math.private math.vectors math.vectors.simd math.vectors.simd.private prettyprint random sequences system diff --git a/basis/regexp/regexp.factor b/basis/regexp/regexp.factor index e9a86516ca..0b387acd2a 100644 --- a/basis/regexp/regexp.factor +++ b/basis/regexp/regexp.factor @@ -84,7 +84,7 @@ PRIVATE> [ prepare-match-iterator ] dip (each-match) ; inline : map-matches ( string regexp quot: ( start end string -- obj ) -- seq ) - accumulator [ each-match ] dip >array ; inline + collector [ each-match ] dip >array ; inline : all-matching-slices ( string regexp -- seq ) [ slice boa ] map-matches ; diff --git a/basis/sequences/deep/deep.factor b/basis/sequences/deep/deep.factor index 8e01025b94..c79d0b2002 100644 --- a/basis/sequences/deep/deep.factor +++ b/basis/sequences/deep/deep.factor @@ -21,7 +21,7 @@ M: object branch? drop f ; [ '[ _ deep-map ] map ] [ drop ] if ; inline recursive : deep-filter ( obj quot: ( elt -- ? ) -- seq ) - over [ pusher [ deep-each ] dip ] dip + over [ selector [ deep-each ] dip ] dip dup branch? [ like ] [ drop ] if ; inline recursive : (deep-find) ( obj quot: ( elt -- ? ) -- elt ? ) diff --git a/basis/sequences/generalizations/generalizations.factor b/basis/sequences/generalizations/generalizations.factor index 210b27f3f3..f49dc8a4e7 100644 --- a/basis/sequences/generalizations/generalizations.factor +++ b/basis/sequences/generalizations/generalizations.factor @@ -58,19 +58,19 @@ MACRO: (ncollect) ( n -- ) : mnmap ( m*seq quot m n -- result*n ) 2dup '[ [ _ npick ] dip swap _ dupn ] 2dip mnmap-as ; inline -: naccumulator-for ( quot ...exemplar n -- quot' vec... ) +: ncollector-for ( quot ...exemplar n -- quot' vec... ) 5 dupn '[ [ [ length ] keep new-resizable ] _ napply [ [ [ push ] _ apply-curry _ spread* ] _ ncurry compose ] _ nkeep ] call ; inline -: naccumulator ( quot n -- quot' vec... ) - [ V{ } swap dupn ] keep naccumulator-for ; inline +: ncollector ( quot n -- quot' vec... ) + [ V{ } swap dupn ] keep ncollector-for ; inline : nproduce-as ( pred quot ...exemplar n -- seq... ) 7 dupn '[ _ ndup - [ _ naccumulator-for [ while ] _ ndip ] + [ _ ncollector-for [ while ] _ ndip ] _ ncurry _ ndip [ like ] _ apply-curry _ spread* ] call ; inline diff --git a/basis/specialized-arrays/specialized-arrays-tests.factor b/basis/specialized-arrays/specialized-arrays-tests.factor index c7e1285689..c25f8ae3b1 100644 --- a/basis/specialized-arrays/specialized-arrays-tests.factor +++ b/basis/specialized-arrays/specialized-arrays-tests.factor @@ -4,7 +4,8 @@ specialized-arrays.private sequences alien.c-types accessors kernel arrays combinators compiler compiler.units classes.struct combinators.smart compiler.tree.debugger math libc destructors sequences.private multiline eval words vocabs namespaces -assocs prettyprint alien.data math.vectors definitions ; +assocs prettyprint alien.data math.vectors definitions +compiler.test ; FROM: alien.c-types => float ; SPECIALIZED-ARRAY: int diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index 9bc61c6353..6ac668b031 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -516,9 +516,9 @@ M: bad-executable summary \ compact-gc { } { } define-primitive -\ (save-image) { byte-array } { } define-primitive +\ (save-image) { byte-array byte-array } { } define-primitive -\ (save-image-and-exit) { byte-array } { } define-primitive +\ (save-image-and-exit) { byte-array byte-array } { } define-primitive \ data-room { } { byte-array } define-primitive \ data-room make-flushable diff --git a/basis/tools/profiler/profiler-tests.factor b/basis/tools/profiler/profiler-tests.factor index 8f3260d649..1a8ff824d6 100644 --- a/basis/tools/profiler/profiler-tests.factor +++ b/basis/tools/profiler/profiler-tests.factor @@ -1,6 +1,6 @@ USING: accessors tools.profiler tools.test kernel memory math threads alien alien.c-types tools.profiler.private sequences -compiler compiler.units words ; +compiler.test compiler.units words ; IN: tools.profiler.tests [ t ] [ diff --git a/basis/tools/time/time-tests.factor b/basis/tools/time/time-tests.factor index 00c774663c..3df61cbd36 100644 --- a/basis/tools/time/time-tests.factor +++ b/basis/tools/time/time-tests.factor @@ -1,4 +1,4 @@ IN: tools.time.tests -USING: tools.time tools.test compiler ; +USING: tools.time tools.test compiler.test ; [ ] [ [ [ ] time ] compile-call ] unit-test diff --git a/basis/unix/bsd/netbsd/structs/structs.factor b/basis/unix/bsd/netbsd/structs/structs.factor deleted file mode 100644 index 1882fa830b..0000000000 --- a/basis/unix/bsd/netbsd/structs/structs.factor +++ /dev/null @@ -1,30 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types alien.syntax unix.time unix.types -unix.types.netbsd classes.struct ; -IN: unix - -STRUCT: sockaddr_storage - { ss_len __uint8_t } - { ss_family sa_family_t } - { __ss_pad1 { char _SS_PAD1SIZE } } - { __ss_align __int64_t } - { __ss_pad2 { char _SS_PAD2SIZE } } ; - -STRUCT: exit_struct - { e_termination uint16_t } - { e_exit uint16_t } ; - -STRUCT: utmpx - { ut_user { char _UTX_USERSIZE } } - { ut_id { char _UTX_IDSIZE } } - { ut_line { char _UTX_LINESIZE } } - { ut_host { char _UTX_HOSTSIZE } } - { ut_session uint16_t } - { ut_type uint16_t } - { ut_pid pid_t } - { ut_exit exit_struct } - { ut_ss sockaddr_storage } - { ut_tv timeval } - { ut_pad { uint32_t 10 } } ; - diff --git a/basis/unix/debugger/debugger.factor b/basis/unix/debugger/debugger.factor index 4e276373e1..7a085731d1 100644 --- a/basis/unix/debugger/debugger.factor +++ b/basis/unix/debugger/debugger.factor @@ -1,7 +1,6 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: debugger prettyprint accessors unix kernel ; -FROM: io => write print nl ; +USING: accessors debugger io kernel prettyprint unix ; IN: unix.debugger M: unix-error error. diff --git a/basis/unix/ffi/authors.txt b/basis/unix/ffi/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/basis/unix/ffi/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/basis/unix/bsd/authors.txt b/basis/unix/ffi/bsd/authors.txt similarity index 100% rename from basis/unix/bsd/authors.txt rename to basis/unix/ffi/bsd/authors.txt diff --git a/basis/unix/bsd/bsd.factor b/basis/unix/ffi/bsd/bsd.factor similarity index 89% rename from basis/unix/bsd/bsd.factor rename to basis/unix/ffi/bsd/bsd.factor index 0825e42930..bda99422fc 100644 --- a/basis/unix/bsd/bsd.factor +++ b/basis/unix/ffi/bsd/bsd.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types alien.syntax classes.struct combinators system unix.types vocabs.loader ; -IN: unix +IN: unix.ffi CONSTANT: MAXPATHLEN 1024 @@ -85,8 +85,8 @@ CONSTANT: SEEK_CUR 1 CONSTANT: SEEK_END 2 os { - { macosx [ "unix.bsd.macosx" require ] } - { freebsd [ "unix.bsd.freebsd" require ] } - { openbsd [ "unix.bsd.openbsd" require ] } - { netbsd [ "unix.bsd.netbsd" require ] } + { macosx [ "unix.ffi.bsd.macosx" require ] } + { freebsd [ "unix.ffi.bsd.freebsd" require ] } + { openbsd [ "unix.ffi.bsd.openbsd" require ] } + { netbsd [ "unix.ffi.bsd.netbsd" require ] } } case diff --git a/basis/unix/bsd/freebsd/freebsd.factor b/basis/unix/ffi/bsd/freebsd/freebsd.factor similarity index 99% rename from basis/unix/bsd/freebsd/freebsd.factor rename to basis/unix/ffi/bsd/freebsd/freebsd.factor index e6a2070520..992d1c3ad0 100644 --- a/basis/unix/bsd/freebsd/freebsd.factor +++ b/basis/unix/ffi/bsd/freebsd/freebsd.factor @@ -1,5 +1,5 @@ USING: alien.c-types alien.syntax classes.struct unix.types ; -IN: unix +IN: unix.ffi CONSTANT: FD_SETSIZE 1024 diff --git a/basis/unix/bsd/freebsd/tags.txt b/basis/unix/ffi/bsd/freebsd/tags.txt similarity index 100% rename from basis/unix/bsd/freebsd/tags.txt rename to basis/unix/ffi/bsd/freebsd/tags.txt diff --git a/basis/unix/bsd/macosx/macosx.factor b/basis/unix/ffi/bsd/macosx/macosx.factor similarity index 95% rename from basis/unix/bsd/macosx/macosx.factor rename to basis/unix/ffi/bsd/macosx/macosx.factor index c263be7056..a2e75b6ca6 100644 --- a/basis/unix/bsd/macosx/macosx.factor +++ b/basis/unix/ffi/bsd/macosx/macosx.factor @@ -1,6 +1,7 @@ -USING: alien.c-types alien.syntax unix.time unix.types -unix.types.macosx classes.struct ; -IN: unix +USING: alien alien.c-types alien.libraries alien.syntax +classes.struct combinators kernel system unix unix.time +unix.types vocabs vocabs.loader ; +IN: unix.ffi CONSTANT: FD_SETSIZE 1024 diff --git a/basis/unix/bsd/macosx/tags.txt b/basis/unix/ffi/bsd/macosx/tags.txt similarity index 100% rename from basis/unix/bsd/macosx/tags.txt rename to basis/unix/ffi/bsd/macosx/tags.txt diff --git a/basis/unix/bsd/netbsd/netbsd.factor b/basis/unix/ffi/bsd/netbsd/netbsd.factor similarity index 80% rename from basis/unix/bsd/netbsd/netbsd.factor rename to basis/unix/ffi/bsd/netbsd/netbsd.factor index 6bef08abe3..d755caf874 100644 --- a/basis/unix/bsd/netbsd/netbsd.factor +++ b/basis/unix/ffi/bsd/netbsd/netbsd.factor @@ -1,6 +1,6 @@ USING: alien.syntax alien.c-types math vocabs.loader -classes.struct unix.types ; -IN: unix +classes.struct unix.types unix.time ; +IN: unix.ffi CONSTANT: FD_SETSIZE 256 @@ -127,6 +127,8 @@ CONSTANT: _UTX_LINESIZE 32 CONSTANT: _UTX_IDSIZE 4 CONSTANT: _UTX_HOSTSIZE 256 +<< + CONSTANT: _SS_MAXSIZE 128 : _SS_ALIGNSIZE ( -- n ) @@ -138,4 +140,28 @@ CONSTANT: _SS_MAXSIZE 128 : _SS_PAD2SIZE ( -- n ) _SS_MAXSIZE 2 - _SS_PAD1SIZE - _SS_ALIGNSIZE - ; inline -"unix.bsd.netbsd.structs" require +>> + +STRUCT: sockaddr_storage + { ss_len __uint8_t } + { ss_family sa_family_t } + { __ss_pad1 { char _SS_PAD1SIZE } } + { __ss_align __int64_t } + { __ss_pad2 { char _SS_PAD2SIZE } } ; + +STRUCT: exit_struct + { e_termination uint16_t } + { e_exit uint16_t } ; + +STRUCT: utmpx + { ut_user { char _UTX_USERSIZE } } + { ut_id { char _UTX_IDSIZE } } + { ut_line { char _UTX_LINESIZE } } + { ut_host { char _UTX_HOSTSIZE } } + { ut_session uint16_t } + { ut_type uint16_t } + { ut_pid pid_t } + { ut_exit exit_struct } + { ut_ss sockaddr_storage } + { ut_tv timeval } + { ut_pad { uint32_t 10 } } ; diff --git a/basis/unix/bsd/netbsd/structs/tags.txt b/basis/unix/ffi/bsd/netbsd/tags.txt similarity index 100% rename from basis/unix/bsd/netbsd/structs/tags.txt rename to basis/unix/ffi/bsd/netbsd/tags.txt diff --git a/basis/unix/bsd/openbsd/openbsd.factor b/basis/unix/ffi/bsd/openbsd/openbsd.factor similarity index 99% rename from basis/unix/bsd/openbsd/openbsd.factor rename to basis/unix/ffi/bsd/openbsd/openbsd.factor index f48b7c1ac4..076dbdfd24 100644 --- a/basis/unix/bsd/openbsd/openbsd.factor +++ b/basis/unix/ffi/bsd/openbsd/openbsd.factor @@ -1,5 +1,5 @@ USING: alien.c-types alien.syntax classes.struct unix.types ; -IN: unix +IN: unix.ffi CONSTANT: FD_SETSIZE 1024 diff --git a/basis/unix/bsd/netbsd/tags.txt b/basis/unix/ffi/bsd/openbsd/tags.txt similarity index 100% rename from basis/unix/bsd/netbsd/tags.txt rename to basis/unix/ffi/bsd/openbsd/tags.txt diff --git a/basis/unix/bsd/summary.txt b/basis/unix/ffi/bsd/summary.txt similarity index 100% rename from basis/unix/bsd/summary.txt rename to basis/unix/ffi/bsd/summary.txt diff --git a/basis/unix/bsd/openbsd/tags.txt b/basis/unix/ffi/bsd/tags.txt similarity index 100% rename from basis/unix/bsd/openbsd/tags.txt rename to basis/unix/ffi/bsd/tags.txt diff --git a/basis/unix/ffi/ffi.factor b/basis/unix/ffi/ffi.factor new file mode 100644 index 0000000000..3882f6fc80 --- /dev/null +++ b/basis/unix/ffi/ffi.factor @@ -0,0 +1,158 @@ +! Copyright (C) 2010 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien alien.c-types alien.libraries alien.syntax +classes.struct combinators kernel system unix.time unix.types +vocabs vocabs.loader ; +IN: unix.ffi + +<< + +{ + { [ os linux? ] [ "unix.ffi.linux" require ] } + { [ os bsd? ] [ "unix.ffi.bsd" require ] } + { [ os solaris? ] [ "unix.ffi.solaris" require ] } +} cond + +>> + +CONSTANT: PROT_NONE 0 +CONSTANT: PROT_READ 1 +CONSTANT: PROT_WRITE 2 +CONSTANT: PROT_EXEC 4 + +CONSTANT: MAP_FILE 0 +CONSTANT: MAP_SHARED 1 +CONSTANT: MAP_PRIVATE 2 + +CONSTANT: SEEK_SET 0 +CONSTANT: SEEK_CUR 1 +CONSTANT: SEEK_END 2 + +: MAP_FAILED ( -- alien ) -1 ; inline + +CONSTANT: NGROUPS_MAX 16 + +CONSTANT: DT_UNKNOWN 0 +CONSTANT: DT_FIFO 1 +CONSTANT: DT_CHR 2 +CONSTANT: DT_DIR 4 +CONSTANT: DT_BLK 6 +CONSTANT: DT_REG 8 +CONSTANT: DT_LNK 10 +CONSTANT: DT_SOCK 12 +CONSTANT: DT_WHT 14 + +LIBRARY: libc + +FUNCTION: char* strerror ( int errno ) ; + +STRUCT: group + { gr_name char* } + { gr_passwd char* } + { gr_gid int } + { gr_mem char** } ; + +FUNCTION: int accept ( int s, void* sockaddr, socklen_t* socklen ) ; +FUNCTION: int bind ( int s, void* name, socklen_t namelen ) ; +FUNCTION: int chdir ( char* path ) ; +FUNCTION: int chmod ( char* path, mode_t mode ) ; +FUNCTION: int fchmod ( int fd, mode_t mode ) ; +FUNCTION: int chown ( char* path, uid_t owner, gid_t group ) ; +FUNCTION: int chroot ( char* path ) ; +FUNCTION: int close ( int fd ) ; +FUNCTION: int closedir ( DIR* dirp ) ; +FUNCTION: int connect ( int s, void* name, socklen_t namelen ) ; +FUNCTION: int dup2 ( int oldd, int newd ) ; +FUNCTION: void endpwent ( ) ; +FUNCTION: int fchdir ( int fd ) ; +FUNCTION: int fchown ( int fd, uid_t owner, gid_t group ) ; +FUNCTION: int fcntl ( int fd, int cmd, int arg ) ; +FUNCTION: int flock ( int fd, int operation ) ; +FUNCTION: void freeaddrinfo ( addrinfo* ai ) ; +FUNCTION: int futimes ( int id, timeval[2] times ) ; +FUNCTION: char* gai_strerror ( int ecode ) ; +FUNCTION: int getaddrinfo ( char* hostname, char* servname, addrinfo* hints, addrinfo** res ) ; +FUNCTION: char* getcwd ( char* buf, size_t size ) ; +FUNCTION: pid_t getpid ; +FUNCTION: int getdtablesize ; +FUNCTION: gid_t getegid ; +FUNCTION: uid_t geteuid ; +FUNCTION: gid_t getgid ; +FUNCTION: char* getenv ( char* name ) ; + +FUNCTION: int getgrgid_r ( gid_t gid, group* grp, char* buffer, size_t bufsize, group** result ) ; +FUNCTION: int getgrnam_r ( char* name, group* grp, char* buffer, size_t bufsize, group** result ) ; +FUNCTION: passwd* getpwent ( ) ; +FUNCTION: passwd* getpwuid ( uid_t uid ) ; +FUNCTION: passwd* getpwnam ( char* login ) ; +FUNCTION: int getpwnam_r ( char* login, passwd* pwd, char* buffer, size_t bufsize, passwd** result ) ; +FUNCTION: int getgroups ( int gidsetlen, gid_t* gidset ) ; +FUNCTION: int getgrouplist ( char* name, int basegid, int* groups, int* ngroups ) ; +FUNCTION: int getrlimit ( int resource, rlimit* rlp ) ; +FUNCTION: int setrlimit ( int resource, rlimit* rlp ) ; +FUNCTION: int getpriority ( int which, id_t who ) ; +FUNCTION: int setpriority ( int which, id_t who, int prio ) ; +FUNCTION: int getrusage ( int who, rusage* r_usage ) ; +FUNCTION: group* getgrent ; +FUNCTION: int gethostname ( char* name, int len ) ; +FUNCTION: int getsockname ( int socket, sockaddr* address, socklen_t* address_len ) ; +FUNCTION: int getpeername ( int socket, sockaddr* address, socklen_t* address_len ) ; +FUNCTION: uid_t getuid ; +FUNCTION: uint htonl ( uint n ) ; +FUNCTION: ushort htons ( ushort n ) ; +! FUNCTION: int issetugid ; +FUNCTION: int ioctl ( int fd, ulong request, char* argp ) ; +FUNCTION: int lchown ( char* path, uid_t owner, gid_t group ) ; +FUNCTION: int listen ( int s, int backlog ) ; +FUNCTION: off_t lseek ( int fildes, off_t offset, int whence ) ; +FUNCTION: int mkdir ( char* path, mode_t mode ) ; +FUNCTION: void* mmap ( void* addr, size_t len, int prot, int flags, int fd, off_t offset ) ; +FUNCTION: int munmap ( void* addr, size_t len ) ; +FUNCTION: uint ntohl ( uint n ) ; +FUNCTION: ushort ntohs ( ushort n ) ; +FUNCTION: int shutdown ( int fd, int how ) ; +FUNCTION: int open ( char* path, int flags, int prot ) ; +FUNCTION: DIR* opendir ( char* path ) ; + +STRUCT: utimbuf + { actime time_t } + { modtime time_t } ; + +FUNCTION: int utime ( char* path, utimbuf* buf ) ; + +FUNCTION: int pclose ( void* file ) ; +FUNCTION: int pipe ( int* filedes ) ; +FUNCTION: void* popen ( char* command, char* type ) ; +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 + +FUNCTION: ssize_t recv ( int s, void* buf, size_t nbytes, int flags ) ; +FUNCTION: ssize_t recvfrom ( int s, void* buf, size_t nbytes, int flags, sockaddr-in* from, socklen_t* fromlen ) ; +FUNCTION: int rename ( char* from, char* to ) ; +FUNCTION: int rmdir ( char* path ) ; +FUNCTION: int select ( int nfds, void* readfds, void* writefds, void* exceptfds, timeval* timeout ) ; +FUNCTION: ssize_t sendto ( int s, void* buf, size_t len, int flags, sockaddr-in* to, socklen_t tolen ) ; +FUNCTION: int setenv ( char* name, char* value, int overwrite ) ; +FUNCTION: int unsetenv ( char* name ) ; +FUNCTION: int setegid ( gid_t egid ) ; +FUNCTION: int seteuid ( uid_t euid ) ; +FUNCTION: int setgid ( gid_t gid ) ; +FUNCTION: int setgroups ( int ngroups, gid_t* gidset ) ; +FUNCTION: int setregid ( gid_t rgid, gid_t egid ) ; +FUNCTION: int setreuid ( uid_t ruid, uid_t euid ) ; +FUNCTION: int setsockopt ( int s, int level, int optname, void* optval, socklen_t optlen ) ; +FUNCTION: int setuid ( uid_t uid ) ; +FUNCTION: int socket ( int domain, int type, int protocol ) ; +FUNCTION: int symlink ( char* path1, char* path2 ) ; +FUNCTION: int link ( char* path1, char* path2 ) ; +FUNCTION: int system ( char* command ) ; +FUNCTION: int unlink ( char* path ) ; +FUNCTION: int utimes ( char* path, timeval[2] times ) ; +FUNCTION: ssize_t write ( int fd, void* buf, size_t nbytes ) ; + +"librt" "librt.so" "cdecl" add-library diff --git a/basis/unix/ffi/linux/authors.txt b/basis/unix/ffi/linux/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/basis/unix/ffi/linux/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/basis/unix/ffi/linux/linux.factor b/basis/unix/ffi/linux/linux.factor new file mode 100644 index 0000000000..260796b5e4 --- /dev/null +++ b/basis/unix/ffi/linux/linux.factor @@ -0,0 +1,236 @@ +! Copyright (C) 2010 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.c-types alien.syntax classes.struct unix.types ; +IN: unix.ffi + +CONSTANT: MAXPATHLEN 1024 + +CONSTANT: O_RDONLY HEX: 0000 +CONSTANT: O_WRONLY HEX: 0001 +CONSTANT: O_RDWR HEX: 0002 +CONSTANT: O_CREAT HEX: 0040 +CONSTANT: O_EXCL HEX: 0080 +CONSTANT: O_NOCTTY HEX: 0100 +CONSTANT: O_TRUNC HEX: 0200 +CONSTANT: O_APPEND HEX: 0400 +CONSTANT: O_NONBLOCK HEX: 0800 + +ALIAS: O_NDELAY O_NONBLOCK + +CONSTANT: SOL_SOCKET 1 + +CONSTANT: FD_SETSIZE 1024 + +CONSTANT: SO_REUSEADDR 2 +CONSTANT: SO_OOBINLINE 10 +CONSTANT: SO_SNDTIMEO HEX: 15 +CONSTANT: SO_RCVTIMEO HEX: 14 + +CONSTANT: F_SETFD 2 +CONSTANT: FD_CLOEXEC 1 + +CONSTANT: F_SETFL 4 + +STRUCT: addrinfo + { flags int } + { family int } + { socktype int } + { protocol int } + { addrlen socklen_t } + { addr void* } + { canonname char* } + { next addrinfo* } ; + +STRUCT: sockaddr-in + { family ushort } + { port ushort } + { addr in_addr_t } + { unused longlong } ; + +STRUCT: sockaddr-in6 + { family ushort } + { port ushort } + { flowinfo uint } + { addr uchar[16] } + { scopeid uint } ; + +CONSTANT: max-un-path 108 + +STRUCT: sockaddr-un + { family ushort } + { path { char max-un-path } } ; + +CONSTANT: SOCK_STREAM 1 +CONSTANT: SOCK_DGRAM 2 + +CONSTANT: AF_UNSPEC 0 +CONSTANT: AF_UNIX 1 +CONSTANT: AF_INET 2 +CONSTANT: AF_INET6 10 + +ALIAS: PF_UNSPEC AF_UNSPEC +ALIAS: PF_UNIX AF_UNIX +ALIAS: PF_INET AF_INET +ALIAS: PF_INET6 AF_INET6 + +CONSTANT: IPPROTO_TCP 6 +CONSTANT: IPPROTO_UDP 17 + +CONSTANT: AI_PASSIVE 1 + +CONSTANT: SEEK_SET 0 +CONSTANT: SEEK_CUR 1 +CONSTANT: SEEK_END 2 + +STRUCT: passwd + { pw_name char* } + { pw_passwd char* } + { pw_uid uid_t } + { pw_gid gid_t } + { pw_gecos char* } + { pw_dir char* } + { pw_shell char* } ; + +! dirent64 +STRUCT: dirent + { d_ino ulonglong } + { d_off longlong } + { d_reclen ushort } + { d_type uchar } + { d_name char[256] } ; + +FUNCTION: int open64 ( char* path, int flags, int prot ) ; +FUNCTION: dirent* readdir64 ( DIR* dirp ) ; +FUNCTION: int readdir64_r ( void* dirp, dirent* entry, dirent** result ) ; + +CONSTANT: EPERM 1 +CONSTANT: ENOENT 2 +CONSTANT: ESRCH 3 +CONSTANT: EINTR 4 +CONSTANT: EIO 5 +CONSTANT: ENXIO 6 +CONSTANT: E2BIG 7 +CONSTANT: ENOEXEC 8 +CONSTANT: EBADF 9 +CONSTANT: ECHILD 10 +CONSTANT: EAGAIN 11 +CONSTANT: ENOMEM 12 +CONSTANT: EACCES 13 +CONSTANT: EFAULT 14 +CONSTANT: ENOTBLK 15 +CONSTANT: EBUSY 16 +CONSTANT: EEXIST 17 +CONSTANT: EXDEV 18 +CONSTANT: ENODEV 19 +CONSTANT: ENOTDIR 20 +CONSTANT: EISDIR 21 +CONSTANT: EINVAL 22 +CONSTANT: ENFILE 23 +CONSTANT: EMFILE 24 +CONSTANT: ENOTTY 25 +CONSTANT: ETXTBSY 26 +CONSTANT: EFBIG 27 +CONSTANT: ENOSPC 28 +CONSTANT: ESPIPE 29 +CONSTANT: EROFS 30 +CONSTANT: EMLINK 31 +CONSTANT: EPIPE 32 +CONSTANT: EDOM 33 +CONSTANT: ERANGE 34 +CONSTANT: EDEADLK 35 +CONSTANT: ENAMETOOLONG 36 +CONSTANT: ENOLCK 37 +CONSTANT: ENOSYS 38 +CONSTANT: ENOTEMPTY 39 +CONSTANT: ELOOP 40 +ALIAS: EWOULDBLOCK EAGAIN +CONSTANT: ENOMSG 42 +CONSTANT: EIDRM 43 +CONSTANT: ECHRNG 44 +CONSTANT: EL2NSYNC 45 +CONSTANT: EL3HLT 46 +CONSTANT: EL3RST 47 +CONSTANT: ELNRNG 48 +CONSTANT: EUNATCH 49 +CONSTANT: ENOCSI 50 +CONSTANT: EL2HLT 51 +CONSTANT: EBADE 52 +CONSTANT: EBADR 53 +CONSTANT: EXFULL 54 +CONSTANT: ENOANO 55 +CONSTANT: EBADRQC 56 +CONSTANT: EBADSLT 57 +ALIAS: EDEADLOCK EDEADLK +CONSTANT: EBFONT 59 +CONSTANT: ENOSTR 60 +CONSTANT: ENODATA 61 +CONSTANT: ETIME 62 +CONSTANT: ENOSR 63 +CONSTANT: ENONET 64 +CONSTANT: ENOPKG 65 +CONSTANT: EREMOTE 66 +CONSTANT: ENOLINK 67 +CONSTANT: EADV 68 +CONSTANT: ESRMNT 69 +CONSTANT: ECOMM 70 +CONSTANT: EPROTO 71 +CONSTANT: EMULTIHOP 72 +CONSTANT: EDOTDOT 73 +CONSTANT: EBADMSG 74 +CONSTANT: EOVERFLOW 75 +CONSTANT: ENOTUNIQ 76 +CONSTANT: EBADFD 77 +CONSTANT: EREMCHG 78 +CONSTANT: ELIBACC 79 +CONSTANT: ELIBBAD 80 +CONSTANT: ELIBSCN 81 +CONSTANT: ELIBMAX 82 +CONSTANT: ELIBEXEC 83 +CONSTANT: EILSEQ 84 +CONSTANT: ERESTART 85 +CONSTANT: ESTRPIPE 86 +CONSTANT: EUSERS 87 +CONSTANT: ENOTSOCK 88 +CONSTANT: EDESTADDRREQ 89 +CONSTANT: EMSGSIZE 90 +CONSTANT: EPROTOTYPE 91 +CONSTANT: ENOPROTOOPT 92 +CONSTANT: EPROTONOSUPPORT 93 +CONSTANT: ESOCKTNOSUPPORT 94 +CONSTANT: EOPNOTSUPP 95 +CONSTANT: EPFNOSUPPORT 96 +CONSTANT: EAFNOSUPPORT 97 +CONSTANT: EADDRINUSE 98 +CONSTANT: EADDRNOTAVAIL 99 +CONSTANT: ENETDOWN 100 +CONSTANT: ENETUNREACH 101 +CONSTANT: ENETRESET 102 +CONSTANT: ECONNABORTED 103 +CONSTANT: ECONNRESET 104 +CONSTANT: ENOBUFS 105 +CONSTANT: EISCONN 106 +CONSTANT: ENOTCONN 107 +CONSTANT: ESHUTDOWN 108 +CONSTANT: ETOOMANYREFS 109 +CONSTANT: ETIMEDOUT 110 +CONSTANT: ECONNREFUSED 111 +CONSTANT: EHOSTDOWN 112 +CONSTANT: EHOSTUNREACH 113 +CONSTANT: EALREADY 114 +CONSTANT: EINPROGRESS 115 +CONSTANT: ESTALE 116 +CONSTANT: EUCLEAN 117 +CONSTANT: ENOTNAM 118 +CONSTANT: ENAVAIL 119 +CONSTANT: EISNAM 120 +CONSTANT: EREMOTEIO 121 +CONSTANT: EDQUOT 122 +CONSTANT: ENOMEDIUM 123 +CONSTANT: EMEDIUMTYPE 124 +CONSTANT: ECANCELED 125 +CONSTANT: ENOKEY 126 +CONSTANT: EKEYEXPIRED 127 +CONSTANT: EKEYREVOKED 128 +CONSTANT: EKEYREJECTED 129 +CONSTANT: EOWNERDEAD 130 +CONSTANT: ENOTRECOVERABLE 131 diff --git a/basis/unix/bsd/tags.txt b/basis/unix/ffi/linux/tags.txt similarity index 100% rename from basis/unix/bsd/tags.txt rename to basis/unix/ffi/linux/tags.txt diff --git a/basis/unix/solaris/authors.txt b/basis/unix/ffi/solaris/authors.txt similarity index 100% rename from basis/unix/solaris/authors.txt rename to basis/unix/ffi/solaris/authors.txt diff --git a/basis/unix/solaris/solaris.factor b/basis/unix/ffi/solaris/solaris.factor similarity index 97% rename from basis/unix/solaris/solaris.factor rename to basis/unix/ffi/solaris/solaris.factor index 1a1a7603f0..d641961a25 100644 --- a/basis/unix/solaris/solaris.factor +++ b/basis/unix/ffi/solaris/solaris.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2006 Patrick Mauritz. ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types alien.syntax system kernel layouts ; -IN: unix +IN: unix.ffi ! Solaris. @@ -52,7 +52,7 @@ STRUCT: sockaddr-in6 { addr uchar[16] } { scopeid uint } ; -: max-un-path 108 ; +CONSTANT: max-un-path 108 STRUCT: sockaddr-un { family ushort } diff --git a/basis/unix/solaris/tags.txt b/basis/unix/ffi/solaris/tags.txt similarity index 100% rename from basis/unix/solaris/tags.txt rename to basis/unix/ffi/solaris/tags.txt diff --git a/basis/unix/ffi/tags.txt b/basis/unix/ffi/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/unix/ffi/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/unix/groups/groups.factor b/basis/unix/groups/groups.factor index 02d9f37023..c34affb9c3 100644 --- a/basis/unix/groups/groups.factor +++ b/basis/unix/groups/groups.factor @@ -4,10 +4,10 @@ USING: alien alien.c-types alien.strings io.encodings.utf8 io.backend.unix kernel math sequences splitting strings combinators.short-circuit byte-arrays combinators accessors math.parser fry assocs namespaces continuations -unix.users unix.utilities classes.struct ; +unix.users unix.utilities classes.struct unix ; IN: unix.groups -QUALIFIED: unix +QUALIFIED: unix.ffi QUALIFIED: grouping @@ -23,17 +23,21 @@ GENERIC: group-struct ( obj -- group/f ) gr_mem>> utf8 alien>strings ; : (group-struct) ( id -- group-struct id group-struct byte-array length void* ) - [ \ unix:group ] dip over 4096 + [ \ unix.ffi:group ] dip over 4096 [ ] keep f ; : check-group-struct ( group-struct ptr -- group-struct/f ) *void* [ drop f ] unless ; M: integer group-struct ( id -- group/f ) - (group-struct) [ unix:getgrgid_r unix:io-error ] keep check-group-struct ; + (group-struct) + [ [ unix.ffi:getgrgid_r ] unix-system-call drop ] keep + check-group-struct ; M: string group-struct ( string -- group/f ) - (group-struct) [ unix:getgrnam_r unix:io-error ] keep check-group-struct ; + (group-struct) + [ [ unix.ffi:getgrnam_r ] unix-system-call drop ] keep + check-group-struct ; : group-struct>group ( group-struct -- group ) [ \ group new ] dip @@ -64,8 +68,8 @@ PRIVATE> : (user-groups) ( string -- seq ) #! first group is -1337, legacy unix code - -1337 unix:NGROUPS_MAX [ 4 * ] keep - [ unix:getgrouplist unix:io-error ] 2keep + -1337 unix.ffi:NGROUPS_MAX [ 4 * ] keep + [ [ unix.ffi:getgrouplist ] unix-system-call drop ] 2keep [ 4 tail-slice ] [ *int 1 - ] bi* >groups ; PRIVATE> @@ -79,7 +83,7 @@ M: integer user-groups ( id -- seq ) user-name (user-groups) ; : all-groups ( -- seq ) - [ unix:getgrent dup ] [ \ unix:group memory>struct group-struct>group ] produce nip ; + [ unix.ffi:getgrent dup ] [ \ unix.ffi:group memory>struct group-struct>group ] produce nip ; : ( -- assoc ) all-groups [ [ id>> ] keep ] H{ } map>assoc ; @@ -87,11 +91,11 @@ M: integer user-groups ( id -- seq ) : with-group-cache ( quot -- ) [ group-cache ] dip with-variable ; inline -: real-group-id ( -- id ) unix:getgid ; inline +: real-group-id ( -- id ) unix.ffi:getgid ; inline : real-group-name ( -- string ) real-group-id group-name ; inline -: effective-group-id ( -- string ) unix:getegid ; inline +: effective-group-id ( -- string ) unix.ffi:getegid ; inline : effective-group-name ( -- string ) effective-group-id group-name ; inline @@ -111,10 +115,10 @@ GENERIC: set-effective-group ( obj -- ) diff --git a/basis/unix/linux/linux.factor b/basis/unix/linux/linux.factor index 93bf621acd..10bf070e1a 100644 --- a/basis/unix/linux/linux.factor +++ b/basis/unix/linux/linux.factor @@ -1,241 +1,6 @@ ! Copyright (C) 2005, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types alien.syntax alien system classes.struct -unix.types ; -IN: unix - -! Linux. - -CONSTANT: MAXPATHLEN 1024 - -CONSTANT: O_RDONLY HEX: 0000 -CONSTANT: O_WRONLY HEX: 0001 -CONSTANT: O_RDWR HEX: 0002 -CONSTANT: O_CREAT HEX: 0040 -CONSTANT: O_EXCL HEX: 0080 -CONSTANT: O_NOCTTY HEX: 0100 -CONSTANT: O_TRUNC HEX: 0200 -CONSTANT: O_APPEND HEX: 0400 -CONSTANT: O_NONBLOCK HEX: 0800 - -ALIAS: O_NDELAY O_NONBLOCK - -CONSTANT: SOL_SOCKET 1 - -CONSTANT: FD_SETSIZE 1024 - -CONSTANT: SO_REUSEADDR 2 -CONSTANT: SO_OOBINLINE 10 -CONSTANT: SO_SNDTIMEO HEX: 15 -CONSTANT: SO_RCVTIMEO HEX: 14 - -CONSTANT: F_SETFD 2 -CONSTANT: FD_CLOEXEC 1 - -CONSTANT: F_SETFL 4 - -STRUCT: addrinfo - { flags int } - { family int } - { socktype int } - { protocol int } - { addrlen socklen_t } - { addr void* } - { canonname char* } - { next addrinfo* } ; - -STRUCT: sockaddr-in - { family ushort } - { port ushort } - { addr in_addr_t } - { unused longlong } ; - -STRUCT: sockaddr-in6 - { family ushort } - { port ushort } - { flowinfo uint } - { addr uchar[16] } - { scopeid uint } ; - -CONSTANT: max-un-path 108 - -STRUCT: sockaddr-un - { family ushort } - { path { char max-un-path } } ; - -CONSTANT: SOCK_STREAM 1 -CONSTANT: SOCK_DGRAM 2 - -CONSTANT: AF_UNSPEC 0 -CONSTANT: AF_UNIX 1 -CONSTANT: AF_INET 2 -CONSTANT: AF_INET6 10 - -ALIAS: PF_UNSPEC AF_UNSPEC -ALIAS: PF_UNIX AF_UNIX -ALIAS: PF_INET AF_INET -ALIAS: PF_INET6 AF_INET6 - -CONSTANT: IPPROTO_TCP 6 -CONSTANT: IPPROTO_UDP 17 - -CONSTANT: AI_PASSIVE 1 - -CONSTANT: SEEK_SET 0 -CONSTANT: SEEK_CUR 1 -CONSTANT: SEEK_END 2 - -STRUCT: passwd - { pw_name char* } - { pw_passwd char* } - { pw_uid uid_t } - { pw_gid gid_t } - { pw_gecos char* } - { pw_dir char* } - { pw_shell char* } ; - -! dirent64 -STRUCT: dirent - { d_ino ulonglong } - { d_off longlong } - { d_reclen ushort } - { d_type uchar } - { d_name char[256] } ; - -FUNCTION: int open64 ( char* path, int flags, int prot ) ; -FUNCTION: dirent* readdir64 ( DIR* dirp ) ; -FUNCTION: int readdir64_r ( void* dirp, dirent* entry, dirent** result ) ; +USING: system unix unix.ffi unix.ffi.linux ; +IN: unix.linux M: linux open-file [ open64 ] unix-system-call ; - -CONSTANT: EPERM 1 -CONSTANT: ENOENT 2 -CONSTANT: ESRCH 3 -CONSTANT: EINTR 4 -CONSTANT: EIO 5 -CONSTANT: ENXIO 6 -CONSTANT: E2BIG 7 -CONSTANT: ENOEXEC 8 -CONSTANT: EBADF 9 -CONSTANT: ECHILD 10 -CONSTANT: EAGAIN 11 -CONSTANT: ENOMEM 12 -CONSTANT: EACCES 13 -CONSTANT: EFAULT 14 -CONSTANT: ENOTBLK 15 -CONSTANT: EBUSY 16 -CONSTANT: EEXIST 17 -CONSTANT: EXDEV 18 -CONSTANT: ENODEV 19 -CONSTANT: ENOTDIR 20 -CONSTANT: EISDIR 21 -CONSTANT: EINVAL 22 -CONSTANT: ENFILE 23 -CONSTANT: EMFILE 24 -CONSTANT: ENOTTY 25 -CONSTANT: ETXTBSY 26 -CONSTANT: EFBIG 27 -CONSTANT: ENOSPC 28 -CONSTANT: ESPIPE 29 -CONSTANT: EROFS 30 -CONSTANT: EMLINK 31 -CONSTANT: EPIPE 32 -CONSTANT: EDOM 33 -CONSTANT: ERANGE 34 -CONSTANT: EDEADLK 35 -CONSTANT: ENAMETOOLONG 36 -CONSTANT: ENOLCK 37 -CONSTANT: ENOSYS 38 -CONSTANT: ENOTEMPTY 39 -CONSTANT: ELOOP 40 -ALIAS: EWOULDBLOCK EAGAIN -CONSTANT: ENOMSG 42 -CONSTANT: EIDRM 43 -CONSTANT: ECHRNG 44 -CONSTANT: EL2NSYNC 45 -CONSTANT: EL3HLT 46 -CONSTANT: EL3RST 47 -CONSTANT: ELNRNG 48 -CONSTANT: EUNATCH 49 -CONSTANT: ENOCSI 50 -CONSTANT: EL2HLT 51 -CONSTANT: EBADE 52 -CONSTANT: EBADR 53 -CONSTANT: EXFULL 54 -CONSTANT: ENOANO 55 -CONSTANT: EBADRQC 56 -CONSTANT: EBADSLT 57 -ALIAS: EDEADLOCK EDEADLK -CONSTANT: EBFONT 59 -CONSTANT: ENOSTR 60 -CONSTANT: ENODATA 61 -CONSTANT: ETIME 62 -CONSTANT: ENOSR 63 -CONSTANT: ENONET 64 -CONSTANT: ENOPKG 65 -CONSTANT: EREMOTE 66 -CONSTANT: ENOLINK 67 -CONSTANT: EADV 68 -CONSTANT: ESRMNT 69 -CONSTANT: ECOMM 70 -CONSTANT: EPROTO 71 -CONSTANT: EMULTIHOP 72 -CONSTANT: EDOTDOT 73 -CONSTANT: EBADMSG 74 -CONSTANT: EOVERFLOW 75 -CONSTANT: ENOTUNIQ 76 -CONSTANT: EBADFD 77 -CONSTANT: EREMCHG 78 -CONSTANT: ELIBACC 79 -CONSTANT: ELIBBAD 80 -CONSTANT: ELIBSCN 81 -CONSTANT: ELIBMAX 82 -CONSTANT: ELIBEXEC 83 -CONSTANT: EILSEQ 84 -CONSTANT: ERESTART 85 -CONSTANT: ESTRPIPE 86 -CONSTANT: EUSERS 87 -CONSTANT: ENOTSOCK 88 -CONSTANT: EDESTADDRREQ 89 -CONSTANT: EMSGSIZE 90 -CONSTANT: EPROTOTYPE 91 -CONSTANT: ENOPROTOOPT 92 -CONSTANT: EPROTONOSUPPORT 93 -CONSTANT: ESOCKTNOSUPPORT 94 -CONSTANT: EOPNOTSUPP 95 -CONSTANT: EPFNOSUPPORT 96 -CONSTANT: EAFNOSUPPORT 97 -CONSTANT: EADDRINUSE 98 -CONSTANT: EADDRNOTAVAIL 99 -CONSTANT: ENETDOWN 100 -CONSTANT: ENETUNREACH 101 -CONSTANT: ENETRESET 102 -CONSTANT: ECONNABORTED 103 -CONSTANT: ECONNRESET 104 -CONSTANT: ENOBUFS 105 -CONSTANT: EISCONN 106 -CONSTANT: ENOTCONN 107 -CONSTANT: ESHUTDOWN 108 -CONSTANT: ETOOMANYREFS 109 -CONSTANT: ETIMEDOUT 110 -CONSTANT: ECONNREFUSED 111 -CONSTANT: EHOSTDOWN 112 -CONSTANT: EHOSTUNREACH 113 -CONSTANT: EALREADY 114 -CONSTANT: EINPROGRESS 115 -CONSTANT: ESTALE 116 -CONSTANT: EUCLEAN 117 -CONSTANT: ENOTNAM 118 -CONSTANT: ENAVAIL 119 -CONSTANT: EISNAM 120 -CONSTANT: EREMOTEIO 121 -CONSTANT: EDQUOT 122 -CONSTANT: ENOMEDIUM 123 -CONSTANT: EMEDIUMTYPE 124 -CONSTANT: ECANCELED 125 -CONSTANT: ENOKEY 126 -CONSTANT: EKEYEXPIRED 127 -CONSTANT: EKEYREVOKED 128 -CONSTANT: EKEYREJECTED 129 -CONSTANT: EOWNERDEAD 130 -CONSTANT: ENOTRECOVERABLE 131 diff --git a/basis/unix/stat/macosx/macosx.factor b/basis/unix/stat/macosx/macosx.factor index a2104dcb33..4e6b2dfb21 100644 --- a/basis/unix/stat/macosx/macosx.factor +++ b/basis/unix/stat/macosx/macosx.factor @@ -1,5 +1,5 @@ USING: alien.c-types arrays accessors combinators classes.struct -alien.syntax unix.time unix.types ; +alien.syntax unix.time unix.types unix.ffi ; IN: unix.stat ! Mac OS X diff --git a/basis/unix/statfs/macosx/macosx.factor b/basis/unix/statfs/macosx/macosx.factor index e83d2d40a0..56c8989895 100644 --- a/basis/unix/statfs/macosx/macosx.factor +++ b/basis/unix/statfs/macosx/macosx.factor @@ -3,7 +3,7 @@ USING: alien.c-types io.encodings.utf8 io.encodings.string kernel sequences unix.stat accessors unix combinators math grouping system alien.strings math.bitwise alien.syntax -unix.types classes.struct ; +unix.types classes.struct unix.ffi ; IN: unix.statfs.macosx CONSTANT: MNT_RDONLY HEX: 00000001 diff --git a/basis/unix/unix.factor b/basis/unix/unix.factor index e9cb9d5918..4e77a41713 100644 --- a/basis/unix/unix.factor +++ b/basis/unix/unix.factor @@ -1,44 +1,14 @@ ! Copyright (C) 2005, 2010 Slava Pestov. ! Copyright (C) 2008 Eduardo Cavazos. ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types alien.syntax kernel libc sequences -continuations byte-arrays strings math namespaces system -combinators combinators.smart vocabs.loader accessors -stack-checker macros locals generalizations unix.types io vocabs -classes.struct unix.time alien.libraries ; +USING: accessors alien alien.c-types alien.libraries +alien.syntax byte-arrays classes.struct combinators +combinators.short-circuit combinators.smart continuations +generalizations io kernel libc locals macros math namespaces +sequences stack-checker strings system unix.time unix.types +vocabs vocabs.loader unix.ffi ; IN: unix -CONSTANT: PROT_NONE 0 -CONSTANT: PROT_READ 1 -CONSTANT: PROT_WRITE 2 -CONSTANT: PROT_EXEC 4 - -CONSTANT: MAP_FILE 0 -CONSTANT: MAP_SHARED 1 -CONSTANT: MAP_PRIVATE 2 - -CONSTANT: SEEK_SET 0 -CONSTANT: SEEK_CUR 1 -CONSTANT: SEEK_END 2 - -: MAP_FAILED ( -- alien ) -1 ; inline - -CONSTANT: NGROUPS_MAX 16 - -CONSTANT: DT_UNKNOWN 0 -CONSTANT: DT_FIFO 1 -CONSTANT: DT_CHR 2 -CONSTANT: DT_DIR 4 -CONSTANT: DT_BLK 6 -CONSTANT: DT_REG 8 -CONSTANT: DT_LNK 10 -CONSTANT: DT_SOCK 12 -CONSTANT: DT_WHT 14 - -LIBRARY: libc - -FUNCTION: char* strerror ( int errno ) ; - ERROR: unix-error errno message ; : (io-error) ( -- * ) errno dup strerror unix-error ; @@ -47,125 +17,45 @@ ERROR: unix-error errno message ; ERROR: unix-system-call-error args errno message word ; +: unix-call-failed? ( ret -- ? ) + { + [ { [ integer? ] [ 0 < ] } 1&& ] + [ not ] + } 1|| ; + MACRO:: unix-system-call ( quot -- ) quot inputs :> n quot first :> word + 0 :> ret! + f :> failed! [ - n ndup quot call dup 0 < [ - drop + [ + n ndup quot call ret! + ret { + [ unix-call-failed? dup failed! ] + [ drop errno EINTR = ] + } 1&& + ] loop + failed [ n narray errno dup strerror word unix-system-call-error ] [ - n nnip + n ndrop + ret ] if ] ; HOOK: open-file os ( path flags mode -- fd ) -<< - -{ - { [ os linux? ] [ "unix.linux" require ] } - { [ os bsd? ] [ "unix.bsd" require ] } - { [ os solaris? ] [ "unix.solaris" require ] } -} cond - -"debugger" vocab [ - "unix.debugger" require -] when - ->> - -STRUCT: group - { gr_name char* } - { gr_passwd char* } - { gr_gid int } - { gr_mem char** } ; - -FUNCTION: int accept ( int s, void* sockaddr, socklen_t* socklen ) ; -FUNCTION: int bind ( int s, void* name, socklen_t namelen ) ; -FUNCTION: int chdir ( char* path ) ; -FUNCTION: int chmod ( char* path, mode_t mode ) ; -FUNCTION: int fchmod ( int fd, mode_t mode ) ; -FUNCTION: int chown ( char* path, uid_t owner, gid_t group ) ; -FUNCTION: int chroot ( char* path ) ; - -FUNCTION: int close ( int fd ) ; -FUNCTION: int closedir ( DIR* dirp ) ; - : close-file ( fd -- ) [ close ] unix-system-call drop ; -FUNCTION: int connect ( int s, void* name, socklen_t namelen ) ; -FUNCTION: int dup2 ( int oldd, int newd ) ; -! FUNCTION: int dup ( int oldd ) ; : _exit ( status -- * ) #! We throw to give this a terminating stack effect. int f "_exit" { int } alien-invoke "Exit failed" throw ; -FUNCTION: void endpwent ( ) ; -FUNCTION: int fchdir ( int fd ) ; -FUNCTION: int fchown ( int fd, uid_t owner, gid_t group ) ; -FUNCTION: int fcntl ( int fd, int cmd, int arg ) ; -FUNCTION: int flock ( int fd, int operation ) ; -FUNCTION: void freeaddrinfo ( addrinfo* ai ) ; -FUNCTION: int futimes ( int id, timeval[2] times ) ; -FUNCTION: char* gai_strerror ( int ecode ) ; -FUNCTION: int getaddrinfo ( char* hostname, char* servname, addrinfo* hints, addrinfo** res ) ; -FUNCTION: char* getcwd ( char* buf, size_t size ) ; -FUNCTION: pid_t getpid ; -FUNCTION: int getdtablesize ; -FUNCTION: gid_t getegid ; -FUNCTION: uid_t geteuid ; -FUNCTION: gid_t getgid ; -FUNCTION: char* getenv ( char* name ) ; - -FUNCTION: int getgrgid_r ( gid_t gid, group* grp, char* buffer, size_t bufsize, group** result ) ; -FUNCTION: int getgrnam_r ( char* name, group* grp, char* buffer, size_t bufsize, group** result ) ; -FUNCTION: passwd* getpwent ( ) ; -FUNCTION: passwd* getpwuid ( uid_t uid ) ; -FUNCTION: passwd* getpwnam ( char* login ) ; -FUNCTION: int getpwnam_r ( char* login, passwd* pwd, char* buffer, size_t bufsize, passwd** result ) ; -FUNCTION: int getgroups ( int gidsetlen, gid_t* gidset ) ; -FUNCTION: int getgrouplist ( char* name, int basegid, int* groups, int* ngroups ) ; -FUNCTION: int getrlimit ( int resource, rlimit* rlp ) ; -FUNCTION: int setrlimit ( int resource, rlimit* rlp ) ; - -FUNCTION: int getpriority ( int which, id_t who ) ; -FUNCTION: int setpriority ( int which, id_t who, int prio ) ; - -FUNCTION: int getrusage ( int who, rusage* r_usage ) ; - -FUNCTION: group* getgrent ; -FUNCTION: int gethostname ( char* name, int len ) ; -FUNCTION: int getsockname ( int socket, sockaddr* address, socklen_t* address_len ) ; -FUNCTION: int getpeername ( int socket, sockaddr* address, socklen_t* address_len ) ; -FUNCTION: uid_t getuid ; -FUNCTION: uint htonl ( uint n ) ; -FUNCTION: ushort htons ( ushort n ) ; -! FUNCTION: int issetugid ; -FUNCTION: int ioctl ( int fd, ulong request, char* argp ) ; -FUNCTION: int lchown ( char* path, uid_t owner, gid_t group ) ; -FUNCTION: int listen ( int s, int backlog ) ; -FUNCTION: off_t lseek ( int fildes, off_t offset, int whence ) ; -FUNCTION: int mkdir ( char* path, mode_t mode ) ; -FUNCTION: void* mmap ( void* addr, size_t len, int prot, int flags, int fd, off_t offset ) ; -FUNCTION: int munmap ( void* addr, size_t len ) ; -FUNCTION: uint ntohl ( uint n ) ; -FUNCTION: ushort ntohs ( ushort n ) ; -FUNCTION: int shutdown ( int fd, int how ) ; - -FUNCTION: int open ( char* path, int flags, int prot ) ; M: unix open-file [ open ] unix-system-call ; -FUNCTION: DIR* opendir ( char* path ) ; - -STRUCT: utimbuf - { actime time_t } - { modtime time_t } ; - -FUNCTION: int utime ( char* path, utimbuf* buf ) ; - : touch ( filename -- ) f [ utime ] unix-system-call drop ; : change-file-times ( filename access modification -- ) @@ -174,50 +64,18 @@ FUNCTION: int utime ( char* path, utimbuf* buf ) ; swap >>actime [ utime ] unix-system-call drop ; -FUNCTION: int pclose ( void* file ) ; -FUNCTION: int pipe ( int* filedes ) ; -FUNCTION: void* popen ( char* command, char* type ) ; -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 - : read-symbolic-link ( path -- path ) PATH_MAX dup [ PATH_MAX [ readlink ] unix-system-call ] dip swap head-slice >string ; -FUNCTION: ssize_t recv ( int s, void* buf, size_t nbytes, int flags ) ; -FUNCTION: ssize_t recvfrom ( int s, void* buf, size_t nbytes, int flags, sockaddr-in* from, socklen_t* fromlen ) ; -FUNCTION: int rename ( char* from, char* to ) ; -FUNCTION: int rmdir ( char* path ) ; -FUNCTION: int select ( int nfds, void* readfds, void* writefds, void* exceptfds, timeval* timeout ) ; -FUNCTION: ssize_t sendto ( int s, void* buf, size_t len, int flags, sockaddr-in* to, socklen_t tolen ) ; -FUNCTION: int setenv ( char* name, char* value, int overwrite ) ; -FUNCTION: int unsetenv ( char* name ) ; -FUNCTION: int setegid ( gid_t egid ) ; -FUNCTION: int seteuid ( uid_t euid ) ; -FUNCTION: int setgid ( gid_t gid ) ; -FUNCTION: int setgroups ( int ngroups, gid_t* gidset ) ; -FUNCTION: int setregid ( gid_t rgid, gid_t egid ) ; -FUNCTION: int setreuid ( uid_t ruid, uid_t euid ) ; -FUNCTION: int setsockopt ( int s, int level, int optname, void* optval, socklen_t optlen ) ; -FUNCTION: int setuid ( uid_t uid ) ; -FUNCTION: int socket ( int domain, int type, int protocol ) ; -FUNCTION: int symlink ( char* path1, char* path2 ) ; -FUNCTION: int link ( char* path1, char* path2 ) ; -FUNCTION: int system ( char* command ) ; - -FUNCTION: int unlink ( char* path ) ; - : unlink-file ( path -- ) [ unlink ] unix-system-call drop ; -FUNCTION: int utimes ( char* path, timeval[2] times ) ; +<< -FUNCTION: ssize_t write ( int fd, void* buf, size_t nbytes ) ; +"debugger" vocab [ + "unix.debugger" require +] when -"librt" "librt.so" "cdecl" add-library +>> diff --git a/basis/unix/users/users.factor b/basis/unix/users/users.factor index 09119ff0cc..adf7f5ce4f 100644 --- a/basis/unix/users/users.factor +++ b/basis/unix/users/users.factor @@ -4,9 +4,9 @@ USING: alien alien.c-types alien.strings io.encodings.utf8 io.backend.unix kernel math sequences splitting strings combinators.short-circuit grouping byte-arrays combinators accessors math.parser fry assocs namespaces continuations -vocabs.loader system classes.struct ; +vocabs.loader system classes.struct unix ; IN: unix.users -QUALIFIED: unix +QUALIFIED: unix.ffi TUPLE: passwd user-name password uid gid gecos dir shell ; @@ -31,13 +31,13 @@ M: unix passwd>new-passwd ( passwd -- seq ) } cleave ; : with-pwent ( quot -- ) - [ unix:endpwent ] [ ] cleanup ; inline + [ unix.ffi:endpwent ] [ ] cleanup ; inline PRIVATE> : all-users ( -- seq ) [ - [ unix:getpwent dup ] [ unix:passwd memory>struct passwd>new-passwd ] produce nip + [ unix.ffi:getpwent dup ] [ unix.ffi:passwd memory>struct passwd>new-passwd ] produce nip ] with-pwent ; SYMBOL: user-cache @@ -52,10 +52,10 @@ GENERIC: user-passwd ( obj -- passwd/f ) M: integer user-passwd ( id -- passwd/f ) user-cache get - [ at ] [ unix:getpwuid [ unix:passwd memory>struct passwd>new-passwd ] [ f ] if* ] if* ; + [ at ] [ unix.ffi:getpwuid [ unix.ffi:passwd memory>struct passwd>new-passwd ] [ f ] if* ] if* ; M: string user-passwd ( string -- passwd/f ) - unix:getpwnam dup [ unix:passwd memory>struct passwd>new-passwd ] when ; + unix.ffi:getpwnam dup [ unix.ffi:passwd memory>struct passwd>new-passwd ] when ; : user-name ( id -- string ) dup user-passwd @@ -65,13 +65,13 @@ M: string user-passwd ( string -- passwd/f ) user-passwd uid>> ; : real-user-id ( -- id ) - unix:getuid ; inline + unix.ffi:getuid ; inline : real-user-name ( -- string ) real-user-id user-name ; inline : effective-user-id ( -- id ) - unix:geteuid ; inline + unix.ffi:geteuid ; inline : effective-user-name ( -- string ) effective-user-id user-name ; inline @@ -93,10 +93,10 @@ GENERIC: set-effective-user ( string/id -- ) diff --git a/basis/unix/utilities/tags.txt b/basis/unix/utilities/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/unix/utilities/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/windows/directx/d2d1/d2d1.factor b/basis/windows/directx/d2d1/d2d1.factor index fad88787f3..cf9e5a3a98 100644 --- a/basis/windows/directx/d2d1/d2d1.factor +++ b/basis/windows/directx/d2d1/d2d1.factor @@ -1,5 +1,5 @@ USING: alien.c-types alien.syntax classes.struct windows.com -windows.com.syntax windows.directx.d3dbasetypes windows.directx.dcommon +windows.com.syntax windows.directx.d2dbasetypes windows.directx.dcommon windows.directx.dxgi windows.directx.dxgiformat windows.ole32 windows.types ; IN: windows.directx.d2d1 diff --git a/basis/windows/directx/d2dbasetypes/d2dbasetypes.factor b/basis/windows/directx/d2dbasetypes/d2dbasetypes.factor index 00f84e9750..3cdb0bbe32 100644 --- a/basis/windows/directx/d2dbasetypes/d2dbasetypes.factor +++ b/basis/windows/directx/d2dbasetypes/d2dbasetypes.factor @@ -1,5 +1,5 @@ USING: alien.syntax classes.struct windows.types ; -IN: windows.directx.d3dbasetypes +IN: windows.directx.d2dbasetypes STRUCT: D3DCOLORVALUE { r FLOAT } diff --git a/basis/windows/directx/d3d11shader/d3d11shader.factor b/basis/windows/directx/d3d11shader/d3d11shader.factor index beb5392e37..a0437e3e65 100644 --- a/basis/windows/directx/d3d11shader/d3d11shader.factor +++ b/basis/windows/directx/d3d11shader/d3d11shader.factor @@ -1,6 +1,7 @@ USING: alien.syntax alien.c-types classes.struct windows.types windows.directx.d3d10shader windows.directx.d3d10 -windows.directx.d3d11 windows.com windows.com.syntax ; +windows.directx.d3d11 windows.com windows.com.syntax +windows.directx.d3dcommon ; IN: windows.directx.d3d11shader LIBRARY: d3d11 diff --git a/basis/windows/directx/d3dx10mesh/d3dx10mesh.factor b/basis/windows/directx/d3dx10mesh/d3dx10mesh.factor index 13066dcdec..9eb563e60c 100644 --- a/basis/windows/directx/d3dx10mesh/d3dx10mesh.factor +++ b/basis/windows/directx/d3dx10mesh/d3dx10mesh.factor @@ -1,6 +1,6 @@ USING: alien.c-types alien.syntax classes.struct windows.com windows.com.syntax windows.directx.d3d10 -windows.directx.d3d10misc windows.types ; +windows.directx.d3d10misc windows.types windows.directx.d3dx10math ; IN: windows.directx.d3dx10mesh LIBRARY: d3dx10 diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor index 7b50d7c443..5a727d6b3e 100644 --- a/core/assocs/assocs.factor +++ b/core/assocs/assocs.factor @@ -58,7 +58,7 @@ PRIVATE> (assoc-each) each ; inline : assoc>map ( assoc quot exemplar -- seq ) - [ accumulator [ assoc-each ] dip ] dip like ; inline + [ collector [ assoc-each ] dip ] dip like ; inline : assoc-map-as ( assoc quot exemplar -- newassoc ) [ [ 2array ] compose V{ } assoc>map ] dip assoc-like ; inline diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index dde5463c0f..2288b89cf4 100644 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -511,8 +511,8 @@ tuple { "gc" "memory" "primitive_full_gc" (( -- )) } { "minor-gc" "memory" "primitive_minor_gc" (( -- )) } { "size" "memory" "primitive_size" (( obj -- n )) } - { "(save-image)" "memory.private" "primitive_save_image" (( path -- )) } - { "(save-image-and-exit)" "memory.private" "primitive_save_image_and_exit" (( path -- )) } + { "(save-image)" "memory.private" "primitive_save_image" (( path1 path2 -- )) } + { "(save-image-and-exit)" "memory.private" "primitive_save_image_and_exit" (( path1 path2 -- )) } { "jit-compile" "quotations" "primitive_jit_compile" (( quot -- )) } { "quot-compiled?" "quotations" "primitive_quot_compiled_p" (( quot -- ? )) } { "quotation-code" "quotations" "primitive_quotation_code" (( quot -- start end )) } diff --git a/core/io/io.factor b/core/io/io.factor index c134ba2108..48d7f413b8 100644 --- a/core/io/io.factor +++ b/core/io/io.factor @@ -113,7 +113,7 @@ PRIVATE> input-stream get swap each-stream-line ; inline : stream-lines ( stream -- seq ) - [ [ ] accumulator [ each-stream-line ] dip { } like ] with-disposal ; + [ [ ] collector [ each-stream-line ] dip { } like ] with-disposal ; : lines ( -- seq ) input-stream get stream-lines ; inline diff --git a/core/make/make-docs.factor b/core/make/make-docs.factor index 881c36e3b6..3366357011 100644 --- a/core/make/make-docs.factor +++ b/core/make/make-docs.factor @@ -37,7 +37,7 @@ $nl { $code "'[ 2 _ + ]" } ; ARTICLE: "namespaces-make" "Making sequences with variables" -"The " { $vocab-link "make" } " vocabulary implements a facility for constructing sequences by holding an accumulator sequence in a variable. Storing the accumulator sequence in a variable rather than the stack may allow code to be written with less stack manipulation." +"The " { $vocab-link "make" } " vocabulary implements a facility for constructing sequences by holding an collector sequence in a variable. Storing the collector sequence in a variable rather than the stack may allow code to be written with less stack manipulation." $nl "Sequence construction is wrapped in a combinator:" { $subsections make } @@ -47,7 +47,7 @@ $nl % # } -"The accumulator sequence can be accessed directly from inside a " { $link make } ":" +"The collector sequence can be accessed directly from inside a " { $link make } ":" { $subsections building } { $example "USING: make math.parser ;" diff --git a/core/memory/memory.factor b/core/memory/memory.factor index 4ab68a1ef1..a1e977f553 100644 --- a/core/memory/memory.factor +++ b/core/memory/memory.factor @@ -1,16 +1,20 @@ ! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel continuations sequences system -io.backend alien.strings memory.private ; +USING: alien.strings io.backend io.pathnames kernel +memory.private sequences system ; IN: memory : instances ( quot -- seq ) [ all-instances ] dip filter ; inline +: saving-path ( path -- saving-path path ) + [ ".saving" append ] keep + [ native-string>alien ] bi@ ; + : save-image ( path -- ) - normalize-path native-string>alien (save-image) ; + normalize-path saving-path (save-image) ; : save-image-and-exit ( path -- ) - normalize-path native-string>alien (save-image-and-exit) ; + normalize-path saving-path (save-image-and-exit) ; : save ( -- ) image save-image ; diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index 9f570f97d5..819b5b2115 100644 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -993,16 +993,16 @@ HELP: count "50" } ; -HELP: pusher +HELP: selector { $values { "quot" "a predicate quotation" } { "quot" quotation } { "accum" vector } } -{ $description "Creates a new vector to accumulate the values which return true for a predicate. Returns a new quotation which accepts an object to be tested and stored in the accumulator if the test yields true. The accumulator is left on the stack for convenience." } +{ $description "Creates a new vector to accumulate the values which return true for a predicate. Returns a new quotation which accepts an object to be tested and stored in the collector if the test yields true. The collector is left on the stack for convenience." } { $example "! Find all the even numbers:" "USING: prettyprint sequences math kernel ;" - "10 iota [ even? ] pusher [ each ] dip ." + "10 iota [ even? ] selector [ each ] dip ." "V{ 0 2 4 6 8 }" } -{ $notes "Used to implement the " { $link filter } " word. Compare this word with " { $link accumulator } ", which is an unfiltering version." } ; +{ $notes "Used to implement the " { $link filter } " word. Compare this word with " { $link collector } ", which is an unfiltering version." } ; HELP: trim-head { $values @@ -1199,7 +1199,7 @@ HELP: 2map-reduce "1290" } } ; -HELP: 2pusher +HELP: 2selector { $values { "quot" quotation } { "quot" quotation } { "accum1" vector } { "accum2" vector } } @@ -1224,13 +1224,13 @@ HELP: 2unclip-slice "T{ slice { from 1 } { to 2 } { seq { 1 2 } } }\nT{ slice { from 1 } { to 2 } { seq { 3 4 } } }\n1\n3" } } ; -HELP: accumulator +HELP: collector { $values { "quot" quotation } { "quot'" quotation } { "vec" vector } } { $description "Creates a new quotation that pushes its result to a vector and outputs that vector on the stack." } { $examples { $example "USING: sequences prettyprint kernel math ;" - "{ 1 2 } [ 30 + ] accumulator [ each ] dip ." + "{ 1 2 } [ 30 + ] collector [ each ] dip ." "V{ 31 32 }" } } ; @@ -1680,14 +1680,14 @@ ARTICLE: "sequences-f" "The f object as a sequence" ARTICLE: "sequences-combinator-implementation" "Implementing sequence combinators" "Creating a new sequence unconditionally:" { $subsections - accumulator - accumulator-for + collector + collector-for } "Creating a new sequence conditionally:" { $subsections - pusher - pusher-for - 2pusher + selector + selector-for + 2selector } ; ARTICLE: "sequences" "Sequence operations" diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index b8a8d5f89d..d3a7aba1c3 100644 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -403,6 +403,9 @@ PRIVATE> [ 2drop f f ] if ; inline +: (accumulate) ( seq identity quot -- seq identity quot ) + [ swap ] dip [ curry keep ] curry ; inline + PRIVATE> : each ( seq quot -- ) @@ -429,9 +432,6 @@ PRIVATE> : map! ( seq quot -- seq ) over [ map-into ] keep ; inline -: (accumulate) ( seq identity quot -- seq identity quot ) - [ swap ] dip [ curry keep ] curry ; inline - : accumulate-as ( seq identity quot exemplar -- final newseq ) [ (accumulate) ] dip map-as ; inline @@ -486,14 +486,14 @@ PRIVATE> : push-if ( elt quot accum -- ) [ keep ] dip rot [ push ] [ 2drop ] if ; inline -: pusher-for ( quot exemplar -- quot accum ) +: selector-for ( quot exemplar -- quot accum ) [ length ] keep new-resizable [ [ push-if ] 2curry ] keep ; inline -: pusher ( quot -- quot accum ) - V{ } pusher-for ; inline +: selector ( quot -- quot accum ) + V{ } selector-for ; inline : filter-as ( seq quot exemplar -- subseq ) - dup [ pusher-for [ each ] dip ] curry dip like ; inline + dup [ selector-for [ each ] dip ] curry dip like ; inline : filter ( seq quot -- subseq ) over filter-as ; inline @@ -501,20 +501,20 @@ PRIVATE> : push-either ( elt quot accum1 accum2 -- ) [ keep swap ] 2dip ? push ; inline -: 2pusher ( quot -- quot accum1 accum2 ) +: 2selector ( quot -- quot accum1 accum2 ) V{ } clone V{ } clone [ [ push-either ] 3curry ] 2keep ; inline : partition ( seq quot -- trueseq falseseq ) - over [ 2pusher [ each ] 2dip ] dip [ like ] curry bi@ ; inline + over [ 2selector [ each ] 2dip ] dip [ like ] curry bi@ ; inline -: accumulator-for ( quot exemplar -- quot' vec ) +: collector-for ( quot exemplar -- quot' vec ) [ length ] keep new-resizable [ [ push ] curry compose ] keep ; inline -: accumulator ( quot -- quot' vec ) - V{ } accumulator-for ; inline +: collector ( quot -- quot' vec ) + V{ } collector-for ; inline : produce-as ( pred quot exemplar -- seq ) - dup [ accumulator-for [ while ] dip ] curry dip like ; inline + dup [ collector-for [ while ] dip ] curry dip like ; inline : produce ( pred quot -- seq ) { } produce-as ; inline @@ -603,12 +603,16 @@ ERROR: assert-sequence got expected ; : assert-sequence= ( a b -- ) 2dup sequence= [ 2drop ] [ assert-sequence ] if ; +fixnum swap [ [ -2 fixnum-shift-fast ] [ 5 fixnum-shift-fast ] bi fixnum+fast fixnum+fast ] keep fixnum-bitxor ; inline +PRIVATE> + : sequence-hashcode ( n seq -- x ) [ 0 ] 2dip [ hashcode* sequence-hashcode-step ] with each ; inline diff --git a/extra/mason/common/common.factor b/extra/mason/common/common.factor index cac4180abd..912cd48c79 100644 --- a/extra/mason/common/common.factor +++ b/extra/mason/common/common.factor @@ -8,8 +8,10 @@ calendar.format arrays mason.config locals debugger fry continuations strings io.sockets ; IN: mason.common +ERROR: no-host-name ; + : short-host-name ( -- string ) - host-name "." split1 drop ; + host-name "." split1 drop [ no-host-name ] unless* ; SYMBOL: current-git-id diff --git a/extra/mongodb/operations/operations.factor b/extra/mongodb/operations/operations.factor index 108f610940..8ecd5df54c 100644 --- a/extra/mongodb/operations/operations.factor +++ b/extra/mongodb/operations/operations.factor @@ -70,7 +70,7 @@ M: mdb-reply-op (read-message) ( msg-stub opcode -- message ) read-longlong >>cursor read-int32 >>start# read-int32 [ >>returned# ] keep - [ H{ } stream>assoc ] accumulator [ times ] dip >>objects ; + [ H{ } stream>assoc ] collector [ times ] dip >>objects ; : read-header ( message -- message ) read-int32 >>length diff --git a/misc/vim/syntax/factor.vim b/misc/vim/syntax/factor.vim index ba9efa91fb..05f9f853f1 100644 --- a/misc/vim/syntax/factor.vim +++ b/misc/vim/syntax/factor.vim @@ -52,7 +52,7 @@ syn keyword factorKeyword or 2bi 2tri while wrapper nip 4dip wrapper? bi* callst syn keyword factorKeyword ?at assoc? assoc-clone-like assoc= delete-at* assoc-partition extract-keys new-assoc value? assoc-size map>assoc push-at assoc-like key? assoc-intersect assoc-refine update assoc-union assoc-combine at* assoc-empty? at+ set-at assoc-all? assoc-subset? assoc-hashcode change-at assoc-each assoc-diff zip values value-at rename-at inc-at enum? at cache assoc>map assoc assoc-map enum value-at* assoc-map-as >alist assoc-filter-as clear-assoc assoc-stack maybe-set-at substitute assoc-filter 2cache delete-at assoc-find keys assoc-any? unzip syn keyword factorKeyword case execute-effect no-cond no-case? 3cleave>quot 2cleave cond>quot wrong-values? no-cond? cleave>quot no-case case>quot 3cleave wrong-values to-fixed-point alist>quot case-find cond cleave call-effect 2cleave>quot recursive-hashcode linear-case-quot spread spread>quot syn keyword factorKeyword number= if-zero next-power-of-2 each-integer ?1+ fp-special? imaginary-part unless-zero float>bits number? fp-infinity? bignum? fp-snan? denominator fp-bitwise= * + power-of-2? - u>= / >= bitand log2-expects-positive < log2 > integer? number bits>double 2/ zero? (find-integer) bits>float float? shift ratio? even? ratio fp-sign bitnot >fixnum complex? /i /f byte-array>bignum when-zero sgn >bignum next-float u< u> mod recip rational find-last-integer >float (all-integers?) 2^ times integer fixnum? neg fixnum sq bignum (each-integer) bit? fp-qnan? find-integer complex real double>bits bitor rem fp-nan-payload all-integers? real-part log2-expects-positive? prev-float align unordered? float fp-nan? abs bitxor u<= odd? <= /mod rational? >integer real? numerator -syn keyword factorKeyword member-eq? append assert-sequence= find-last-from trim-head-slice clone-like 3sequence assert-sequence? map-as last-index-from reversed index-from cut* pad-tail remove-eq! concat-as but-last snip trim-tail nths nth 2pusher sequence slice? partition remove-nth tail-slice empty? tail* if-empty find-from virtual-sequence? member? set-length drop-prefix unclip unclip-last-slice iota map-sum bounds-error? sequence-hashcode-step pusher-for accumulate-as map start midpoint@ (accumulate) rest-slice prepend fourth sift accumulate! new-sequence follow map! like first4 1sequence reverse slice unless-empty padding virtual@ repetition? set-last index 4sequence max-length set-second immutable-sequence first2 first3 replicate-as reduce-index unclip-slice supremum suffix! insert-nth trim-tail-slice tail 3append short count suffix concat flip filter sum immutable? reverse! 2sequence map-integers delete-all start* indices snip-slice check-slice sequence? head map-find filter! append-as reduce sequence= halves collapse-slice interleave 2map filter-as binary-reduce slice-error? product bounds-check? bounds-check harvest immutable virtual-exemplar find produce remove pad-head last replicate set-fourth remove-eq shorten reversed? map-find-last 3map-as 2unclip-slice shorter? 3map find-last head-slice pop* 2map-as tail-slice* but-last-slice 2map-reduce iota? accumulator-for accumulate each pusher append! new-resizable cut-slice each-index head-slice* 2reverse-each sequence-hashcode pop set-nth ?nth second join when-empty accumulator immutable-sequence? all? 3append-as virtual-sequence subseq? remove-nth! push-either new-like length last-index push-if 2all? lengthen assert-sequence copy map-reduce move third first 3each tail? set-first prefix bounds-error any? trim-slice exchange surround 2reduce cut change-nth min-length set-third produce-as push-all head? delete-slice rest sum-lengths 2each head* infimum remove! glue slice-error subseq trim replace-slice push repetition map-index trim-head unclip-last mismatch +syn keyword factorKeyword member-eq? append assert-sequence= find-last-from trim-head-slice clone-like 3sequence assert-sequence? map-as last-index-from reversed index-from cut* pad-tail remove-eq! concat-as but-last snip trim-tail nths nth 2selector sequence slice? partition remove-nth tail-slice empty? tail* if-empty find-from virtual-sequence? member? set-length drop-prefix unclip unclip-last-slice iota map-sum bounds-error? sequence-hashcode-step selector-for accumulate-as map start midpoint@ (accumulate) rest-slice prepend fourth sift accumulate! new-sequence follow map! like first4 1sequence reverse slice unless-empty padding virtual@ repetition? set-last index 4sequence max-length set-second immutable-sequence first2 first3 replicate-as reduce-index unclip-slice supremum suffix! insert-nth trim-tail-slice tail 3append short count suffix concat flip filter sum immutable? reverse! 2sequence map-integers delete-all start* indices snip-slice check-slice sequence? head map-find filter! append-as reduce sequence= halves collapse-slice interleave 2map filter-as binary-reduce slice-error? product bounds-check? bounds-check harvest immutable virtual-exemplar find produce remove pad-head last replicate set-fourth remove-eq shorten reversed? map-find-last 3map-as 2unclip-slice shorter? 3map find-last head-slice pop* 2map-as tail-slice* but-last-slice 2map-reduce iota? collector-for accumulate each selector append! new-resizable cut-slice each-index head-slice* 2reverse-each sequence-hashcode pop set-nth ?nth second join when-empty collector immutable-sequence? all? 3append-as virtual-sequence subseq? remove-nth! push-either new-like length last-index push-if 2all? lengthen assert-sequence copy map-reduce move third first 3each tail? set-first prefix bounds-error any? trim-slice exchange surround 2reduce cut change-nth min-length set-third produce-as push-all head? delete-slice rest sum-lengths 2each head* infimum remove! glue slice-error subseq trim replace-slice push repetition map-index trim-head unclip-last mismatch syn keyword factorKeyword global +@ change set-namestack change-global init-namespaces on off set-global namespace set with-scope bind with-variable inc dec counter initialize namestack get get-global make-assoc syn keyword factorKeyword 2array 3array pair >array 1array 4array pair? array resize-array array? syn keyword factorKeyword +character+ bad-seek-type? readln each-morsel stream-seek read print with-output-stream contents write1 stream-write1 stream-copy stream-element-type with-input-stream stream-print stream-read stream-contents stream-tell tell-output bl seek-output bad-seek-type nl stream-nl write flush stream-lines +byte+ stream-flush read1 seek-absolute? stream-read1 lines stream-readln stream-read-until each-line seek-end with-output-stream* seek-absolute with-streams seek-input seek-relative? input-stream stream-write read-partial seek-end? seek-relative error-stream read-until with-input-stream* with-streams* tell-input each-block output-stream stream-read-partial each-stream-block each-stream-line diff --git a/vm/debug.cpp b/vm/debug.cpp index 419eb690ff..e82394951a 100755 --- a/vm/debug.cpp +++ b/vm/debug.cpp @@ -442,7 +442,7 @@ void factor_vm::factorbug() else if(strcmp(cmd,"x") == 0) exit(1); else if(strcmp(cmd,"im") == 0) - save_image(STRING_LITERAL("fep.image")); + save_image(STRING_LITERAL("fep.image.saving"),STRING_LITERAL("fep.image")); else if(strcmp(cmd,"data") == 0) dump_objects(TYPE_COUNT); else if(strcmp(cmd,"refs") == 0) diff --git a/vm/image.cpp b/vm/image.cpp index 68701c4736..ba9fb4e6e6 100755 --- a/vm/image.cpp +++ b/vm/image.cpp @@ -22,7 +22,7 @@ void factor_vm::load_data_heap(FILE *file, image_header *h, vm_parameters *p) p->aging_size, p->tenured_size); - fixnum bytes_read = fread((void*)data->tenured->start,1,h->data_size,file); + fixnum bytes_read = safe_fread((void*)data->tenured->start,1,h->data_size,file); if((cell)bytes_read != h->data_size) { @@ -43,7 +43,7 @@ void factor_vm::load_code_heap(FILE *file, image_header *h, vm_parameters *p) if(h->code_size != 0) { - size_t bytes_read = fread(code->allocator->first_block(),1,h->code_size,file); + size_t bytes_read = safe_fread(code->allocator->first_block(),1,h->code_size,file); if(bytes_read != h->code_size) { std::cout << "truncated image: " << bytes_read << " bytes read, "; @@ -241,7 +241,7 @@ void factor_vm::load_image(vm_parameters *p) } image_header h; - if(fread(&h,sizeof(image_header),1,file) != 1) + if(safe_fread(&h,sizeof(image_header),1,file) != 1) fatal_error("Cannot read image header",0); if(h.magic != image_magic) @@ -253,7 +253,7 @@ void factor_vm::load_image(vm_parameters *p) load_data_heap(file,&h,p); load_code_heap(file,&h,p); - fclose(file); + safe_fclose(file); init_objects(&h); @@ -268,15 +268,15 @@ void factor_vm::load_image(vm_parameters *p) } /* Save the current image to disk */ -bool factor_vm::save_image(const vm_char *filename) +bool factor_vm::save_image(const vm_char *saving_filename, const vm_char *filename) { FILE* file; image_header h; - file = OPEN_WRITE(filename); + file = OPEN_WRITE(saving_filename); if(file == NULL) { - std::cout << "Cannot open image file: " << filename << std::endl; + std::cout << "Cannot open image file: " << saving_filename << std::endl; std::cout << strerror(errno) << std::endl; return false; } @@ -298,13 +298,15 @@ bool factor_vm::save_image(const vm_char *filename) bool ok = true; - if(fwrite(&h,sizeof(image_header),1,file) != 1) ok = false; - if(fwrite((void*)data->tenured->start,h.data_size,1,file) != 1) ok = false; - if(fwrite(code->allocator->first_block(),h.code_size,1,file) != 1) ok = false; - if(fclose(file)) ok = false; + if(safe_fwrite(&h,sizeof(image_header),1,file) != 1) ok = false; + if(safe_fwrite((void*)data->tenured->start,h.data_size,1,file) != 1) ok = false; + if(safe_fwrite(code->allocator->first_block(),h.code_size,1,file) != 1) ok = false; + if(safe_fclose(file)) ok = false; if(!ok) std::cout << "save-image failed: " << strerror(errno) << std::endl; + else + MOVE_FILE(saving_filename,filename); return ok; } @@ -314,9 +316,11 @@ void factor_vm::primitive_save_image() /* do a full GC to push everything into tenured space */ primitive_compact_gc(); - data_root path(ctx->pop(),this); - path.untag_check(this); - save_image((vm_char *)(path.untagged() + 1)); + data_root path2(ctx->pop(),this); + path2.untag_check(this); + data_root path1(ctx->pop(),this); + path1.untag_check(this); + save_image((vm_char *)(path1.untagged() + 1 ),(vm_char *)(path2.untagged() + 1)); } void factor_vm::primitive_save_image_and_exit() @@ -324,8 +328,10 @@ void factor_vm::primitive_save_image_and_exit() /* We unbox this before doing anything else. This is the only point where we might throw an error, so we have to throw an error here since later steps destroy the current image. */ - data_root path(ctx->pop(),this); - path.untag_check(this); + data_root path2(ctx->pop(),this); + path2.untag_check(this); + data_root path1(ctx->pop(),this); + path1.untag_check(this); /* strip out special_objects data which is set on startup anyway */ for(cell i = 0; i < special_object_count; i++) @@ -336,7 +342,7 @@ void factor_vm::primitive_save_image_and_exit() false /* discard objects only reachable from stacks */); /* Save the image */ - if(save_image((vm_char *)(path.untagged() + 1))) + if(save_image((vm_char *)(path1.untagged() + 1), (vm_char *)(path2.untagged() + 1))) exit(0); else exit(1); diff --git a/vm/io.cpp b/vm/io.cpp index a45e1d10ab..a3283b84ac 100755 --- a/vm/io.cpp +++ b/vm/io.cpp @@ -31,6 +31,39 @@ void factor_vm::io_error() general_error(ERROR_IO,tag_fixnum(errno),false_object,NULL); } +size_t safe_fread(void *ptr, size_t size, size_t nitems, FILE *stream) +{ + size_t items_read = 0; + + do { + items_read += fread((void*)((int*)ptr+items_read*size),size,nitems-items_read,stream); + } while(items_read != nitems && errno == EINTR); + + return items_read; +} + +size_t safe_fwrite(void *ptr, size_t size, size_t nitems, FILE *stream) +{ + size_t items_written = 0; + + do { + items_written += fwrite((void*)((int*)ptr+items_written*size),size,nitems-items_written,stream); + } while(items_written != nitems && errno == EINTR); + + return items_written; +} + +int safe_fclose(FILE *stream) +{ + int ret = 0; + + do { + ret = fclose(stream); + } while(ret != 0 && errno == EINTR); + + return ret; +} + void factor_vm::primitive_fopen() { data_root mode(ctx->pop(),this); @@ -38,18 +71,15 @@ void factor_vm::primitive_fopen() mode.untag_check(this); path.untag_check(this); - for(;;) - { - FILE *file = fopen((char *)(path.untagged() + 1), + FILE *file; + do { + file = fopen((char *)(path.untagged() + 1), (char *)(mode.untagged() + 1)); if(file == NULL) io_error(); - else - { - ctx->push(allot_alien(file)); - break; - } - } + } while(errno == EINTR); + + ctx->push(allot_alien(file)); } FILE *factor_vm::pop_file_handle() @@ -61,8 +91,7 @@ void factor_vm::primitive_fgetc() { FILE *file = pop_file_handle(); - for(;;) - { + do { int c = fgetc(file); if(c == EOF) { @@ -79,7 +108,7 @@ void factor_vm::primitive_fgetc() ctx->push(tag_fixnum(c)); break; } - } + } while(errno == EINTR); } void factor_vm::primitive_fread() @@ -97,8 +126,8 @@ void factor_vm::primitive_fread() for(;;) { - int c = fread(buf.untagged() + 1,1,size,file); - if(c <= 0) + int c = safe_fread(buf.untagged() + 1,1,size,file); + if(c == 0) { if(feof(file)) { @@ -110,12 +139,13 @@ void factor_vm::primitive_fread() } else { - if(c != size) + if(feof(file)) { byte_array *new_buf = allot_byte_array(c); memcpy(new_buf + 1, buf.untagged() + 1,c); buf = new_buf; } + ctx->push(buf.value()); break; } @@ -127,17 +157,12 @@ void factor_vm::primitive_fputc() FILE *file = pop_file_handle(); fixnum ch = to_fixnum(ctx->pop()); - for(;;) - { + do { if(fputc(ch,file) == EOF) - { io_error(); - - /* Still here? EINTR */ - } else break; - } + } while(errno == EINTR); } void factor_vm::primitive_fwrite() @@ -150,23 +175,9 @@ void factor_vm::primitive_fwrite() if(length == 0) return; - for(;;) - { - size_t written = fwrite(string,1,length,file); - if(written == length) - break; - else - { - if(feof(file)) - break; - else - io_error(); - - /* Still here? EINTR */ - length -= written; - string += written; - } - } + size_t written = safe_fwrite(string,1,length,file); + if(written != length) + io_error(); } void factor_vm::primitive_ftell() @@ -174,8 +185,12 @@ void factor_vm::primitive_ftell() FILE *file = pop_file_handle(); off_t offset; - if((offset = FTELL(file)) == -1) - io_error(); + do { + if((offset = FTELL(file)) == -1) + io_error(); + else + break; + } while(errno == EINTR); ctx->push(from_signed_8(offset)); } @@ -196,37 +211,30 @@ void factor_vm::primitive_fseek() break; } - if(FSEEK(file,offset,whence) == -1) - { - io_error(); - - /* Still here? EINTR */ - critical_error("Don't know what to do; EINTR from fseek()?",0); - } + do { + if(FSEEK(file,offset,whence) == -1) + io_error(); + else + break; + } while(errno == EINTR); } void factor_vm::primitive_fflush() { FILE *file = pop_file_handle(); - for(;;) - { + do { if(fflush(file) == EOF) io_error(); else break; - } + } while(errno == EINTR); } void factor_vm::primitive_fclose() { FILE *file = pop_file_handle(); - for(;;) - { - if(fclose(file) == EOF) - io_error(); - else - break; - } + if(safe_fclose(file) == EOF) + io_error(); } /* This function is used by FFI I/O. Accessing the errno global directly is diff --git a/vm/io.hpp b/vm/io.hpp index 7fa43e0006..41e9cec82d 100755 --- a/vm/io.hpp +++ b/vm/io.hpp @@ -1,6 +1,10 @@ namespace factor { +size_t safe_fread(void *ptr, size_t size, size_t nitems, FILE *stream); +size_t safe_fwrite(void *ptr, size_t size, size_t nitems, FILE *stream); +int safe_fclose(FILE *stream); + /* Platform specific primitives */ VM_C_API int err_no(); diff --git a/vm/os-unix.hpp b/vm/os-unix.hpp index 7faab4d8b8..5efa62919d 100644 --- a/vm/os-unix.hpp +++ b/vm/os-unix.hpp @@ -31,6 +31,15 @@ typedef char symbol_char; #define OPEN_READ(path) fopen(path,"rb") #define OPEN_WRITE(path) fopen(path,"wb") +#define MOVE_FILE(path1,path2) \ +do {\ + int ret = 0;\ + do {\ + ret = rename((path1),(path2));\ + } while(ret < 0 && errno == EINTR);\ + if(ret < 0)\ + general_error(ERROR_IO,tag_fixnum(errno),false_object,NULL);\ +}while(0) #define print_native_string(string) print_string(string) diff --git a/vm/os-windows.hpp b/vm/os-windows.hpp index 8a2dfe38f5..30e3eea9c9 100755 --- a/vm/os-windows.hpp +++ b/vm/os-windows.hpp @@ -37,8 +37,13 @@ typedef wchar_t vm_char; #define CELL_HEX_FORMAT "%lx" #endif -#define OPEN_READ(path) _wfopen(path,L"rb") -#define OPEN_WRITE(path) _wfopen(path,L"wb") +#define OPEN_READ(path) _wfopen((path),L"rb") +#define OPEN_WRITE(path) _wfopen((path),L"wb") +#define MOVE_FILE(path1,path2)\ +do {\ + if(MoveFileEx((path1),(path2),MOVEFILE_REPLACE_EXISTING) == false)\ + std::cout << "MoveFile() failed: error " << GetLastError() << std::endl;\ +} while(0) /* Difference between Jan 1 00:00:00 1601 and Jan 1 00:00:00 1970 */ #define EPOCH_OFFSET 0x019db1ded53e8000LL diff --git a/vm/vm.hpp b/vm/vm.hpp index 6f826ed9e0..6fb788d531 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -549,7 +549,7 @@ struct factor_vm void init_objects(image_header *h); void load_data_heap(FILE *file, image_header *h, vm_parameters *p); void load_code_heap(FILE *file, image_header *h, vm_parameters *p); - bool save_image(const vm_char *filename); + bool save_image(const vm_char *saving_filename, const vm_char *filename); void primitive_save_image(); void primitive_save_image_and_exit(); void fixup_data(cell data_offset, cell code_offset);