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 alien.data
   4 classes.struct combinators io.ports io.streams.duplex
   5 system kernel math math.bitwise vocabs io.serial
   6 io.serial.unix.termios io.backend.unix unix unix.ffi
   7 literals ;
   8 IN: io.serial.unix
   9
  10 << {
  11     { [ os linux? ] [ "io.serial.unix.linux" ] }
  12     { [ os bsd? ] [ "io.serial.unix.bsd" ] }
  13 } cond require >>
  14
  15 FUNCTION: speed_t cfgetispeed ( termios* t ) ;
  16 FUNCTION: speed_t cfgetospeed ( termios* t ) ;
  17 FUNCTION: int cfsetispeed ( termios* t, speed_t s ) ;
  18 FUNCTION: int cfsetospeed ( termios* t, speed_t s ) ;
  19 FUNCTION: int tcgetattr ( int i1, termios* t ) ;
  20 FUNCTION: int tcsetattr ( int i1, int i2, termios* t ) ;
  21 FUNCTION: int tcdrain ( int i1 ) ;
  22 FUNCTION: int tcflow ( int i1, int i2 ) ;
  23 FUNCTION: int tcflush ( int i1, int i2 ) ;
  24 FUNCTION: int tcsendbreak ( int i1, int i2 ) ;
  25 FUNCTION: void cfmakeraw ( termios* t ) ;
  26 FUNCTION: int cfsetspeed ( termios* t, speed_t s ) ;
  27
  28 : fd>duplex-stream ( fd -- duplex-stream )
  29     <fd> init-fd
  30     [ <input-port> ] [ <output-port> ] bi <duplex-stream> ;
  31
  32 : open-rw ( path -- fd ) O_RDWR file-mode open-file  ;
  33
  34 : <file-rw> ( path -- stream ) open-rw fd>duplex-stream ;
  35
  36 : open-unix-serial-port ( serial-port -- )
  37     [
  38         path>> flags{ O_RDWR O_NOCTTY O_NDELAY } file-mode open-file
  39         fd>duplex-stream
  40     ] keep stream<< ;
  41
  42 : serial-fd ( serial -- fd )
  43     stream>> in>> handle>> fd>> ;
  44
  45 : set-termios ( serial -- )
  46     [
  47         serial-fd
  48         termios <struct> [ tcgetattr io-error ] keep
  49     ] keep termios<< ;
  50
  51 : configure-termios ( serial -- )
  52     dup termios>>
  53     {
  54         [ [ iflag>> ] dip over [ iflag<< ] [ 2drop ] if ]
  55         [ [ oflag>> ] dip over [ oflag<< ] [ 2drop ] if ]
  56         [
  57             [
  58                 [ cflag>> 0 or ] [ baud>> lookup-baud ] bi bitor
  59             ] dip cflag<<
  60         ]
  61         [ [ lflag>> ] dip over [ lflag<< ] [ 2drop ] if ]
  62     } 2cleave ;
  63
  64 : tciflush ( serial -- )
  65     serial-fd TCIFLUSH tcflush io-error ;
  66
  67 : apply-termios ( serial -- )
  68     [ serial-fd TCSANOW ]
  69     [ termios>> ] bi tcsetattr io-error ;
  70
  71 M: unix open-serial ( serial -- serial' )
  72     {
  73         [ open-unix-serial-port ]
  74         [ set-termios ]
  75         [ configure-termios ]
  76         [ tciflush ]
  77         [ apply-termios ]
  78         [ ]
  79     } cleave ;
  80
  81 M: unix default-serial-flags
  82     flags{ IGNPAR ICRNL } >>iflag
  83     flags{ } >>oflag
  84     flags{ CS8 CLOCAL CREAD } >>cflag
  85     flags{ ICANON } >>lflag ;