extra/io/serial/unix/unix.factor

   1 ! Copyright (C) 2008 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien.c-types alien.syntax combinators io.ports
   4 io.streams.duplex io.unix.backend system kernel math math.bitwise
   5 vocabs.loader unix io.serial io.serial.unix.termios ;
   6 IN: io.serial.unix
   7
   8 << {
   9     { [ os linux? ] [ "io.serial.unix.linux" ] }
  10     { [ os bsd? ] [ "io.serial.unix.bsd" ] }
  11 } cond require >>
  12
  13 FUNCTION: speed_t cfgetispeed ( termios* t ) ;
  14 FUNCTION: speed_t cfgetospeed ( termios* t ) ;
  15 FUNCTION: int cfsetispeed ( termios* t, speed_t s ) ;
  16 FUNCTION: int cfsetospeed ( termios* t, speed_t s ) ;
  17 FUNCTION: int tcgetattr ( int i1, termios* t ) ;
  18 FUNCTION: int tcsetattr ( int i1, int i2, termios* t ) ;
  19 FUNCTION: int tcdrain ( int i1 ) ;
  20 FUNCTION: int tcflow ( int i1, int i2 ) ;
  21 FUNCTION: int tcflush ( int i1, int i2 ) ;
  22 FUNCTION: int tcsendbreak ( int i1, int i2 ) ;
  23 FUNCTION: void cfmakeraw ( termios* t ) ;
  24 FUNCTION: int cfsetspeed ( termios* t, speed_t s ) ;
  25
  26 : fd>duplex-stream ( fd -- duplex-stream )
  27     <fd> init-fd
  28     [ <input-port> ] [ <output-port> ] bi <duplex-stream> ;
  29
  30 : open-rw ( path -- fd ) O_RDWR file-mode open-file  ;
  31 : <file-rw> ( path -- stream ) open-rw fd>duplex-stream ;
  32
  33 M: unix open-serial ( serial -- serial' )
  34     path>> { O_RDWR O_NOCTTY O_NDELAY } flags file-mode open-file
  35     fd>duplex-stream ;
  36
  37 : serial-fd ( serial -- fd )
  38     stream>> in>> handle>> fd>> ;
  39
  40 : get-termios ( serial -- termios )
  41     serial-fd
  42     "termios" <c-object> [ tcgetattr io-error ] keep ;
  43
  44 : configure-termios ( serial -- )
  45     dup termios>>
  46     {
  47         [ [ iflag>> ] dip over [ set-termios-iflag ] [ 2drop ] if ]
  48         [ [ oflag>> ] dip over [ set-termios-oflag ] [ 2drop ] if ]
  49         [
  50             [
  51                 [ cflag>> 0 or ] [ baud>> lookup-baud ] bi bitor
  52             ] dip set-termios-cflag
  53         ]
  54         [ [ lflag>> ] dip over [ set-termios-lflag ] [ 2drop ] if ]
  55     } 2cleave ;
  56
  57 : tciflush ( serial -- )
  58     serial-fd TCIFLUSH tcflush io-error ;
  59
  60 : apply-termios ( serial -- )
  61     [ serial-fd TCSANOW ]
  62     [ termios>> ] bi tcsetattr io-error ;