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