core/io/streams/c/c.factor

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