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 destructors io
   4 io.backend io.encodings.utf8 io.files kernel kernel.private
   5 make 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 dup check-disposed handle>> fputc ;
  22
  23 M: c-writer stream-write
  24     dup check-disposed
  25     [ [ >c-ptr ] [ byte-length ] bi ] [ handle>> ] bi* fwrite ;
  26
  27 M: c-writer stream-flush dup check-disposed handle>> fflush ;
  28
  29 TUPLE: c-reader < c-stream ;
  30 INSTANCE: c-reader input-stream
  31 INSTANCE: c-reader file-reader
  32
  33 : <c-reader> ( handle -- stream ) c-reader new-c-stream ;
  34
  35 M: c-reader stream-read-unsafe dup check-disposed handle>> fread-unsafe ;
  36
  37 M: 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
  46 M: 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
  51 M: 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
  63 M: c-io-backend init-stdio init-c-stdio ;
  64
  65 M: 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
  71 M: c-io-backend (file-reader)
  72     "rb" fopen <c-reader> ;
  73
  74 M: c-io-backend (file-writer)
  75     "wb" fopen <c-writer> ;
  76
  77 M: 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 ;