64 lines
		
	
	
		
			2.1 KiB
		
	
	
	
		
			Factor
		
	
	
			
		
		
	
	
			64 lines
		
	
	
		
			2.1 KiB
		
	
	
	
		
			Factor
		
	
	
! Copyright (C) 2008 Doug Coleman.
 | 
						|
! See http://factorcode.org/license.txt for BSD license.
 | 
						|
USING: accessors alien.c-types alien.syntax combinators io.ports
 | 
						|
io.streams.duplex io.unix.backend system kernel math math.bitwise
 | 
						|
vocabs.loader unix serial serial.unix.termios ;
 | 
						|
IN: serial.unix
 | 
						|
 | 
						|
<< {
 | 
						|
    { [ os linux? ] [ "serial.unix.linux" ] }
 | 
						|
    { [ os bsd? ] [ "serial.unix.bsd" ] }
 | 
						|
} cond require >>
 | 
						|
 | 
						|
FUNCTION: speed_t cfgetispeed ( termios* t ) ;
 | 
						|
FUNCTION: speed_t cfgetospeed ( termios* t ) ;
 | 
						|
FUNCTION: int cfsetispeed ( termios* t, speed_t s ) ;
 | 
						|
FUNCTION: int cfsetospeed ( termios* t, speed_t s ) ;
 | 
						|
FUNCTION: int tcgetattr ( int i1, termios* t ) ;
 | 
						|
FUNCTION: int tcsetattr ( int i1, int i2, termios* t ) ;
 | 
						|
FUNCTION: int tcdrain ( int i1 ) ;
 | 
						|
FUNCTION: int tcflow ( int i1, int i2 ) ;
 | 
						|
FUNCTION: int tcflush ( int i1, int i2 ) ;
 | 
						|
FUNCTION: int tcsendbreak ( int i1, int i2 ) ;
 | 
						|
FUNCTION: void cfmakeraw ( termios* t ) ;
 | 
						|
FUNCTION: int cfsetspeed ( termios* t, speed_t s ) ;
 | 
						|
 | 
						|
: fd>duplex-stream ( fd -- duplex-stream )
 | 
						|
    <fd> init-fd
 | 
						|
    [ <input-port> ] [ <output-port> ] bi <duplex-stream> ;
 | 
						|
 | 
						|
: open-rw ( path -- fd ) O_RDWR file-mode open-file  ;
 | 
						|
: <file-rw> ( path -- stream ) open-rw fd>duplex-stream ;
 | 
						|
 | 
						|
M: unix open-serial ( serial -- serial' )
 | 
						|
    dup
 | 
						|
    path>> { O_RDWR O_NOCTTY O_NDELAY } flags file-mode open-file
 | 
						|
    fd>duplex-stream >>stream ;
 | 
						|
 | 
						|
: serial-fd ( serial -- fd )
 | 
						|
    stream>> in>> handle>> fd>> ;
 | 
						|
 | 
						|
: get-termios ( serial -- termios )
 | 
						|
    serial-fd
 | 
						|
    "termios" <c-object> [ tcgetattr io-error ] keep ;
 | 
						|
 | 
						|
: configure-termios ( serial -- )
 | 
						|
    dup termios>>
 | 
						|
    {
 | 
						|
        [ [ iflag>> ] dip over [ set-termios-iflag ] [ 2drop ] if ]
 | 
						|
        [ [ oflag>> ] dip over [ set-termios-oflag ] [ 2drop ] if ]
 | 
						|
        [
 | 
						|
            [
 | 
						|
                [ cflag>> 0 or ] [ baud>> lookup-baud ] bi bitor
 | 
						|
            ] dip set-termios-cflag
 | 
						|
        ]
 | 
						|
        [ [ lflag>> ] dip over [ set-termios-lflag ] [ 2drop ] if ]
 | 
						|
    } 2cleave ;
 | 
						|
 | 
						|
: tciflush ( serial -- )
 | 
						|
    serial-fd TCIFLUSH tcflush io-error ;
 | 
						|
 | 
						|
: apply-termios ( serial -- )
 | 
						|
    [ serial-fd TCSANOW ]
 | 
						|
    [ termios>> ] bi tcsetattr io-error ;
 |