[ "flush-icache" "assembler" f ]
[ "fopen" "io-internals" [ [ string string ] [ alien ] ] ]
[ "fgets" "io-internals" [ [ alien ] [ string ] ] ]
+ [ "fgetc" "io-internals" [ [ alien ] [ object ] ] ]
[ "fwrite" "io-internals" [ [ string alien ] [ ] ] ]
[ "fflush" "io-internals" [ [ alien ] [ ] ] ]
[ "fclose" "io-internals" [ [ alien ] [ ] ] ]
c-stream-out fwrite ;
M: c-stream stream-readln ( stream -- str )
- dup stream-flush c-stream-in dup [ fgets ] when ;
+ c-stream-in dup [ fgets ] when ;
+
+M: c-stream stream-read1 ( stream -- str )
+ c-stream-in dup [ fgetc ] when ;
M: c-stream stream-flush ( stream -- )
c-stream-out [ fflush ] when* ;
: <client> c-stream-error ;
: <server> c-stream-error ;
: accept c-stream-error ;
-
-: (stream-copy) ( in out -- )
- 4096 pick stream-read [
- over stream-write (stream-copy)
- ] [
- 2drop
- ] ifte* ;
-
-: stream-copy ( in out -- )
- [
- 2dup (stream-copy)
- ] [
- >r stream-close stream-close r> [ rethrow ] when*
- ] catch ;
GENERIC: stream-auto-flush ( stream -- )
GENERIC: stream-readln ( stream -- string )
GENERIC: stream-read ( count stream -- string )
+GENERIC: stream-read1 ( stream -- char/f )
GENERIC: stream-write-attr ( string style stream -- )
GENERIC: stream-close ( stream -- )
GENERIC: set-timeout ( timeout stream -- )
-: stream-read1 ( stream -- char/f )
- 1 swap stream-read dup empty? [ drop f ] [ first ] ifte ;
-
: stream-write ( string stream -- )
f swap stream-write-attr ;
M: null-stream stream-auto-flush drop ;
M: null-stream stream-readln drop f ;
M: null-stream stream-read 2drop f ;
+M: null-stream stream-read1 drop f ;
M: null-stream stream-write-attr 3drop ;
M: null-stream stream-close drop ;
M: duplex-stream stream-read
duplex-stream-in stream-read ;
+M: duplex-stream stream-read1
+ duplex-stream-in stream-read1 ;
+
M: duplex-stream stream-write-attr
duplex-stream-out stream-write-attr ;
: <resource-stream> ( path -- stream )
#! Open a file path relative to the Factor source code root.
resource-path swap path+ <file-reader> ;
+
+: (stream-copy) ( in out -- )
+ 4096 pick stream-read [
+ over stream-write (stream-copy)
+ ] [
+ 2drop
+ ] ifte* ;
+
+: stream-copy ( in out -- )
+ [
+ 2dup (stream-copy)
+ ] [
+ >r stream-close stream-close r> [ rethrow ] when*
+ ] catch ;
prettyprint sequences stdio strings unparser vectors words ;
TUPLE: assert got expect ;
+
M: assert error.
"Assertion failed" print
"Expected: " write dup assert-expect .
! The cr slot is set to true by read-line-loop if the last
! character read was \r.
-TUPLE: reader line ready? cr ;
+TUPLE: reader line cr ;
C: reader ( handle -- reader )
[ >r buffered-port r> set-delegate ] keep ;
-: pop-line ( reader -- str )
- dup reader-line dup [ >string ] when >r
- f over set-reader-line
- f swap set-reader-ready? r> ;
+: pop-line ( reader -- sbuf/f )
+ dup pending-error [ reader-line f ] keep set-reader-line ;
-: read-fin ( reader -- str )
- dup pending-error dup reader-ready? [
- pop-line
- ] [
- "reader not ready" throw
- ] ifte ;
+: read-fin ( reader -- str ) pop-line dup [ >string ] when ;
: reader-cr> ( reader -- ? )
dup reader-cr >r f swap set-reader-cr r> ;
] ifte
] ifte ;
-: read-line-step ( reader -- ? )
- [ read-line-loop dup ] keep set-reader-ready? ;
-
: init-reader ( count reader -- ) >r <sbuf> r> set-reader-line ;
-: prepare-line ( reader -- ? )
- 80 over init-reader read-line-step ;
-
: can-read-line? ( reader -- ? )
- dup pending-error
- dup reader-ready? [ drop t ] [ prepare-line ] ifte ;
+ dup pending-error 80 over init-reader read-line-loop ;
: reader-eof ( reader -- )
- dup reader-line dup [
- length 0 = [ f over set-reader-line ] when
+ dup reader-line empty? [
+ f swap set-reader-line
] [
drop
- ] ifte t swap set-reader-ready? ;
+ ] ifte ;
: (refill) ( port -- n )
>port< dup buffer-end swap buffer-capacity read ;
dup eof? [
reader-eof t
] [
- read-line-step
+ read-line-loop
] ifte
] [
drop f
] ifte ;
! Reading character counts
-: read-loop ( count reader -- ? )
+: read-step ( count reader -- ? )
dup trailing-cr
dup reader-line -rot >r over length - ( remaining) r>
2dup buffer-length <= [
buffer>> nip nappend f
] ifte ;
-: read-step ( count reader -- ? )
- [ read-loop dup ] keep set-reader-ready? ;
-
: can-read-count? ( count reader -- ? )
- dup pending-error
- 2dup init-reader
- 2dup reader-line length <= [
- t swap set-reader-ready? drop t
- ] [
- read-step
- ] ifte ;
+ dup pending-error 2dup init-reader read-step ;
TUPLE: read-task count ;
M: read-task do-io-task ( task -- ? )
>read-task< dup refill [
dup eof? [
- nip reader-eof t
+ reader-eof drop t
] [
read-step
] ifte
M: reader stream-read ( count stream -- string )
[ wait-to-read ] keep read-fin ;
+M: reader stream-read1 ( stream -- string )
+ 1 over wait-to-read reader-line first ;
+
! Writers
: open-write ( path -- fd )
USING: errors namespaces streams threads unparser alien generic
kernel math unix-internals ;
+: <socket-stream> ( fd -- stream )
+ dup f <fd-stream> ;
+
: init-sockaddr ( port -- sockaddr )
<sockaddr-in>
[ AF_INET swap set-sockaddr-in-family ] keep
: wait-to-accept ( server -- )
[ swap <accept-task> add-io-task stop ] callcc0 drop ;
-: <socket-stream> ( fd -- stream )
- dup f <fd-stream> ;
-
: timeout-opt ( fd level opt value -- )
"timeval" c-size setsockopt io-error ;
dpush(tag_object(from_c_string(line)));
}
+void primitive_fgetc(void)
+{
+ FILE* file = (FILE*)unbox_alien();
+ int c = fgetc(file);
+ if(c == EOF)
+ dpush(F);
+ else
+ dpush(tag_fixnum(c));
+}
+
void primitive_fwrite(void)
{
FILE* file;
void primitive_fflush(void);
void primitive_fclose(void);
void primitive_fgets(void);
+void primitive_fgetc(void);
primitive_flush_icache,
primitive_fopen,
primitive_fgets,
+ primitive_fgetc,
primitive_fwrite,
primitive_fflush,
primitive_fclose