/core/io/streams/c/c.factor

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