core/io/streams/c/c.factor

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