diff --git a/library/io/c-streams.factor b/library/io/c-streams.factor new file mode 100644 index 0000000000..7d4faab85a --- /dev/null +++ b/library/io/c-streams.factor @@ -0,0 +1,68 @@ +! Copyright (C) 2004, 2005 Slava Pestov. +! See http://factor.sf.net/license.txt for BSD license. +IN: io-internals +USING: errors kernel kernel-internals namespaces stdio streams +strings threads ; + +! Simple wrappers for ANSI C I/O functions, used for +! bootstrapping only. + +! Note that c-streams are pretty limited and broken. Namely, +! there is a limit of 1024 characters per line, and lines +! containing \0 are not read properly. + +! More elaborate platform-specific I/O code is used on Unix and +! Windows; see library/unix and library/win32. + +TUPLE: c-stream in out flush? ; + +M: c-stream stream-write-attr ( str style stream -- ) + nip >r dup string? [ ch>string ] unless r> + c-stream-out fwrite ; + +M: c-stream stream-readln ( stream -- str ) + dup stream-flush c-stream-in dup [ fgets ] when ; + +M: c-stream stream-flush ( stream -- ) + c-stream-out [ fflush ] when* ; + +M: c-stream stream-auto-flush ( stream -- ) + dup c-stream-flush? [ stream-flush ] [ drop ] ifte ; + +M: c-stream stream-close ( stream -- ) + dup c-stream-in [ fclose ] when* + c-stream-out [ fclose ] when* ; + +: init-io ( -- ) + 13 getenv 14 getenv t stdio set ; + +IN: streams + +: ( path -- stream ) + "rb" fopen f f ; + +: ( path -- stream ) + "wb" fopen f swap f ; + +TUPLE: client-stream host port ; + +: c-stream-error + "C-streams I/O does not support this feature" throw ; + +: c-stream-error ; +: 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 ;