Additions for posix

src/ffi-types-unix.lisp

@@ -60,6 +60,7 @@
 ;;c_cflag
 (constant (CSIZE "CSIZE"))
 (constant (CSTOPB "CSTOPB"))
+(constant (CRTSCTS "CRTSCTS"))
 (constant (CREAD "CREAD"))
 (constant (PARENB "PARENB"))
 (constant (PARODD "PARODD"))

src/gray.lisp

@@ -28,4 +28,13 @@
   sequence)
 
 (defmethod stream-listen ((stream serial-stream))
-  (serial-input-available-p (stream-serial stream)))
+  (serial-input-available-p (stream-serial stream)))
+
+(defmethod stream-finish-output ((stream serial-stream))
+  (serial-finish-output (stream-serial stream)))
+
+(defmethod stream-clear-input ((stream serial-stream))
+  (serial-clear-input (stream-serial stream)))
+
+(defmethod output-available ((stream serial-stream))
+  (output-available (stream-serial stream)))

src/interfaces.lisp

@@ -2,26 +2,29 @@
 
 (defclass serial ()
   ((name :initarg :name
-	 :reader serial-name
-	 :documentation "Device name")
+	     :reader serial-name
+	     :documentation "Device name")
    (fd :initarg :fd
        :reader serial-fd
        :documentation "opend handle")
    (encoding :initarg :encoding
-	     :reader serial-encoding
-	     :documentation "encoding")
+	         :reader serial-encoding
+	         :documentation "encoding")
    (baud-rate :initarg :baud-rate
-	      :reader serial-baud-rate
-	      :documentation "baud-rate")
+	          :reader serial-baud-rate
+	          :documentation "baud-rate")
    (data-bits :initarg :data-bits
               :reader serial-data-bits
               :documentation "Number of data-bits.")
    (stop-bits :initarg :stop-bits
               :accessor serial-stop-bits
-	     :documentation "Number of stop-bits")
+	          :documentation "Number of stop-bits")
    (parity :initarg :parity
-	   :accessor serial-parity
-	   :documentation "Parity checking."))
+	       :accessor serial-parity
+	       :documentation "Parity checking.")
+   (cts-flow-p :initarg :cts-flow-p
+               :accessor serial-cts-flow-p
+               :documentation "Enable Hardware Control Flow"))
   (:documentation ""))
 
 (defvar *serial-class* 'serial)
@@ -51,6 +54,7 @@
 (defgeneric% %valid-fd-p (class))
 (defgeneric% %set-invalid-fd (class))
 (defgeneric% %input-available-p (class))
+(defgeneric% %finish-output (class))
 (defgeneric% %default-name (class &optional number))
 
 (defgeneric% %close (class))

src/main.lisp

@@ -21,8 +21,8 @@
      (data-bits *default-data-bits*)
      (stop-bits *default-stop-bits*)
      (parity *default-parity*)
+     (cts-flow-p nil)
      ;; below are not yet supported
-     cts-flow-p
      dsr-flow-p
      dtr
      rts
@@ -32,16 +32,22 @@
      write-total-base-timeout
      write-total-byte-timeout)
   "Attempts to open the named serial port and return a serial object."
-  (setq name (let ((name (or name *default-name*)))
-               (if (numberp name) (%default-name *serial-class* name) name)))
-  (%open (apply #'make-instance *serial-class*
-                :baud-rate baud-rate
-                :data-bits data-bits
-                :stop-bits stop-bits
-                :parity parity
-                :encoding encoding
-                args)
-         :name name))
+  (if (typep name 'serial)
+      (%open name :name (serial-name name))
+    (progn
+      (setq name (let ((name (or name *default-name*)))
+                   (if (numberp name) (%default-name *serial-class* name) name)))
+      (%open (apply #'make-instance *serial-class*
+                    :baud-rate baud-rate
+                    :data-bits data-bits
+                    :stop-bits stop-bits
+                    :parity parity
+                    :encoding encoding
+                    :cts-flow-p cts-flow-p
+                    :name name
+                    args)
+             :name name))))
+
 
 (defun close-serial (serial)
   "Closes a serial port"
@@ -80,8 +86,9 @@ The result state is a list giving the state of each line in the same order as th
   (unless (%valid-fd-p serial)
     (error "invalid serial port ~S" serial))
   (cffi:with-foreign-object (b :unsigned-char 1)
-    (when (= (%read serial b 1 timeout-ms) 1)
-      (cffi:mem-aref b :unsigned-char))))
+    (if (= (%read serial b 1 timeout-ms) 1)
+        (cffi:mem-aref b :unsigned-char)
+        :eof)))
 
 (defun read-serial-byte-vector (buf serial &key (timeout-ms *default-timeout-ms*) (start 0) (end (length buf)))
   "Reads a byte from a serial port. will return count-read-bytes or nil when timeout."
@@ -102,6 +109,14 @@ The result state is a list giving the state of each line in the same order as th
   "Checks whether a character is available on a serial port."
   (%input-available-p serial))
 
+(defun serial-finish-output (serial)
+  "Wait for the transmission of the content of the output buffer before returning"
+  (%finish-output serial))
+
+(defun serial-clear-input (serial)
+  "Clear the input buffer of the serial connection"
+  (%clear-input serial))
+
 (defun set-serial-state (serial &rest args &key dtr rts break)
   "Changes various aspects of the state of a serial port."
   (declare (ignore dtr rts break))

src/package.lisp

@@ -33,4 +33,8 @@
            :make-serial-stream
            :with-serial
            :with-timeout
-           :timeout-error))
+           :timeout-error
+           :serial-name
+           :serial
+           :output-available
+           :serial-fd))

src/posix.lisp

@@ -31,6 +31,10 @@
   (fd :int)
   (request :unsigned-long)
   (arg-p :pointer))
+(defcfun ("ioctl" ioctl-i) :int
+  (fd :int)
+  (request :unsigned-long)
+  (arg-i :int))
 
 ;; I'm not sure 'lognot' are available for this use or not. and in this case speed is not a matter at all.
 (defun off (flag &rest patterns)
@@ -116,13 +120,13 @@ deci-seconds.")))
 
 (defmethod %default-name ((s (eql 'posix-serial)) &optional (number 0))
   (format nil
-	  (or #+linux  "/dev/ttyS~A"
-	      #+freebsd "/dev/cuaa~A"
-	      #+windows (if (> number 9)
-			    "\\\\.\\COM~A"
-			    "COM~A")
-	      "/dont/know/where~A")
-	  number))
+          (or #+linux  "/dev/ttyS~A"
+              #+freebsd "/dev/cuaa~A"
+              #+windows (if (> number 9)
+                            "\\\\.\\COM~A"
+                            "COM~A")
+              "/dont/know/where~A")
+          number))
 
 (defmethod %close ((s posix-serial))
   (let ((fd (serial-fd s)))
@@ -132,35 +136,36 @@ deci-seconds.")))
   t)
 
 (defmethod %open ((s posix-serial)
-		  &key
-		    name)
+                  &key
+                    name)
   (let* ((ratedef (%baud-rate s))
-	 (fd (open name (logior o-rdwr o-noctty))))
+         (fd (open name (logior o-rdwr o-noctty))))
     (when (= -1 fd)
       (error "~A open error!!" name))
     (setf (slot-value s 'fd) fd)
     (with-foreign-object (tty '(:struct termios))
       (unless (and
-	       (zerop (tcgetattr fd tty))
-	       (zerop (cfsetispeed tty ratedef))
-	       (zerop (cfsetospeed tty ratedef)))
-	(%close fd)
-	(error "~A setspeed error!!" name))
+               (zerop (tcgetattr fd tty))
+               (zerop (cfsetispeed tty ratedef))
+               (zerop (cfsetospeed tty ratedef)))
+        (%close fd)
+        (error "~A setspeed error!!" name))
 
       (with-foreign-slots ((lflag iflag cflag oflag cc) tty (:struct termios))
-	(setf lflag (off lflag ICANON ECHO ECHONL IEXTEN ISIG))
-	(setf iflag (off iflag BRKINT ICRNL INPCK ISTRIP IXON))
-	(setf cflag (logior (off cflag PARENB CSTOPB CSIZE)
-			    (%data-bits s)
-			    (%parity s)
+        (setf lflag (off lflag ICANON ECHO ECHONL IEXTEN ISIG))
+        (setf iflag (off iflag BRKINT ICRNL INPCK ISTRIP IXON))
+        (setf cflag (logior (off cflag PARENB CSTOPB CSIZE)
+                            (if (serial-cts-flow-p s) CRTSCTS 0)
+                            (%data-bits s)
+                            (%parity s)
                             (%stop-bits s)
-			    HUPCL CLOCAL))
-	(setf oflag (off oflag OPOST))
-	(setf (mem-aref cc 'cc-t VTIME) 0)
-	(setf (mem-aref cc 'cc-t VMIN) 1))
+                            HUPCL CLOCAL))
+        (setf oflag (off oflag OPOST))
+        (setf (mem-aref cc 'cc-t VTIME) 0)
+        (setf (mem-aref cc 'cc-t VMIN) 1))
       (unless (zerop (tcsetattr fd TCSANOW tty))
-	(%close fd)
-	(error "unable to setup serial port"))
+        (%close fd)
+        (error "unable to setup serial port"))
       s)))
 
 (defmethod %write ((s posix-serial) buffer write-size timeout-ms)
@@ -241,5 +246,24 @@ deci-seconds.")))
   (with-slots (fd) s
     (with-foreign-object (nbytes :int)
       (unless (zerop (ioctl fd FIONREAD nbytes))
-	(error "Unable to get number of bytes available"))
+        (error "Unable to get number of bytes available"))
       (> (mem-ref nbytes :int) 0))))
+
+(defmethod %clear-input ((s posix-serial))
+  (with-slots (fd) s
+    (unless (zerop (tcflush fd 0))
+      (error "Unable to flush input buffer"))))
+
+(defmethod %finish-output ((s posix-serial))
+  (with-slots (fd) s
+    ;; tcdrain
+    (unless (zerop (ioctl-i fd OSICAT-POSIX:TCSBRK 1))
+      (error "Unable to drain serial port"))
+    nil))
+
+(defmethod output-available ((s posix-serial))
+  "Get the number of bytes in the output buffer"
+  (with-slots (fd) s
+    (with-foreign-object (bytes :int)
+      (ioctl fd OSICAT-POSIX:TIOCOUTQ bytes)
+      (mem-ref bytes :int))))