1 ! Copyright (C) 2004, 2010 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: alien alien.strings kernel kernel.private namespaces make
4 io io.encodings sequences math generic threads.private classes
5 io.backend io.files io.encodings.utf8 continuations destructors
6 byte-arrays accessors combinators ;
9 TUPLE: c-stream < disposable handle ;
11 : new-c-stream ( handle class -- c-stream )
12 new-disposable swap >>handle ; inline
14 M: c-stream dispose* handle>> fclose ;
16 TUPLE: c-writer < c-stream ;
17 INSTANCE: c-writer output-stream
18 INSTANCE: c-writer file-writer
20 : <c-writer> ( handle -- stream ) c-writer new-c-stream ;
22 M: c-writer stream-write1 dup check-disposed handle>> fputc ;
24 M: c-writer stream-write
26 [ [ >c-ptr ] [ byte-length ] bi ] [ handle>> ] bi* fwrite ;
28 M: c-writer stream-flush dup check-disposed handle>> fflush ;
30 TUPLE: c-reader < c-stream ;
31 INSTANCE: c-reader input-stream
32 INSTANCE: c-reader file-reader
34 : <c-reader> ( handle -- stream ) c-reader new-c-stream ;
36 M: c-reader stream-read-unsafe dup check-disposed handle>> fread-unsafe ;
38 M: c-reader stream-read1 dup check-disposed handle>> fgetc ;
40 : read-until-loop ( stream delim -- ch )
41 over stream-read1 dup [
42 dup pick member-eq? [ 2nip ] [ , read-until-loop ] if
45 ] if ; inline recursive
47 M: c-reader stream-read-until
49 [ swap read-until-loop ] B{ } make swap
50 over empty? over not and [ 2drop f f ] when ;
52 M: c-io-backend init-io ;
54 : stdin-handle ( -- alien ) OBJ-STDIN special-object ;
55 : stdout-handle ( -- alien ) OBJ-STDOUT special-object ;
56 : stderr-handle ( -- alien ) OBJ-STDERR special-object ;
59 stdin-handle <c-reader>
60 stdout-handle <c-writer>
61 stderr-handle <c-writer>
64 M: c-io-backend init-stdio init-c-stdio ;
66 M: c-io-backend io-multiplex
67 dup 0 = [ drop ] [ 60 60 * 1000 * 1000 * or (sleep) ] if ;
69 : fopen ( path mode -- alien )
70 [ utf8 string>alien ] bi@ (fopen) ;
72 M: c-io-backend (file-reader)
73 "rb" fopen <c-reader> ;
75 M: c-io-backend (file-writer)
76 "wb" fopen <c-writer> ;
78 M: c-io-backend (file-appender)
79 "ab" fopen <c-writer> ;
82 #! A word which directly calls primitives. It is used to
83 #! print stuff from contexts where the I/O system would
84 #! otherwise not work (tools.deploy.shaker, the I/O
85 #! multiplexer thread).
86 "\n" append >byte-array dup length
88 stdout-handle fflush ;