core/io/streams/c/c.factor

   1 ! Copyright (C) 2004, 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien alien.strings byte-arrays byte-vectors
   4 destructors io io.backend io.encodings.utf8 io.files kernel
   5 kernel.private math sequences threads.private ;
   6 IN: io.streams.c
   7
   8 TUPLE: c-stream < disposable handle ;
   9
  10 : new-c-stream ( handle class -- c-stream )
  11     new-disposable swap >>handle ; inline
  12
  13 M: c-stream dispose* handle>> fclose ;
  14
  15 TUPLE: c-writer < c-stream ;
  16 INSTANCE: c-writer output-stream
  17 INSTANCE: c-writer file-writer
  18
  19 : <c-writer> ( handle -- stream ) c-writer new-c-stream ;
  20
  21 M: c-writer stream-write1
  22     check-disposed handle>> fputc ;
  23
  24 M: c-writer stream-write
  25     check-disposed
  26     [ binary-object ] [ handle>> ] bi* fwrite ;
  27
  28 M: c-writer stream-flush
  29     check-disposed handle>> fflush ;
  30
  31 TUPLE: c-reader < c-stream ;
  32 INSTANCE: c-reader input-stream
  33 INSTANCE: c-reader file-reader
  34
  35 : <c-reader> ( handle -- stream ) c-reader new-c-stream ;
  36
  37 M: c-reader stream-read-unsafe
  38     check-disposed handle>> fread-unsafe ;
  39
  40 M: c-reader stream-read1
  41     check-disposed handle>> fgetc ;
  42
  43 : read-until-loop ( handle seps accum -- accum ch )
  44     pick fgetc dup [
  45         pick dupd member-eq?
  46         [ [ 2drop ] 2dip ] [ suffix! read-until-loop ] if
  47     ] [
  48         [ 2drop ] 2dip
  49     ] if ; inline recursive
  50
  51 M: c-reader stream-read-until
  52     check-disposed handle>> swap
  53     32 <byte-vector> read-until-loop [ B{ } like ] dip
  54     over empty? over not and [ 2drop f f ] when ;
  55
  56 M: c-io-backend init-io ;
  57
  58 : stdin-handle ( -- alien ) OBJ-STDIN special-object ;
  59 : stdout-handle ( -- alien ) OBJ-STDOUT special-object ;
  60 : stderr-handle ( -- alien ) OBJ-STDERR special-object ;
  61
  62 : init-c-stdio ( -- )
  63     stdin-handle <c-reader>
  64     stdout-handle <c-writer>
  65     stderr-handle <c-writer>
  66     set-stdio ;
  67
  68 M: c-io-backend init-stdio init-c-stdio ;
  69
  70 M: c-io-backend io-multiplex
  71     dup 0 = [ drop ] [ 60 60 * 1000 * 1000 * or (sleep) ] if ;
  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 dup length
  91     stdout-handle fwrite
  92     stdout-handle fflush ;