Serial port communication in common lisp

Is there a library for serial port communication in Common Lisp on Wi开发者_Go百科ndows?

---

Here are a few functions that implement serial communication using SBCL foreign function POSIX calls. Its not as nice as a full library but I solved my problem of talking to the device according to this protocol

https://valelab.ucsf.edu/svn/micromanager2/branches/micromanager1.3/DeviceAdapters/ZeissCAN/ZeissCAN.cpp

package.lisp:

(defpackage :serial
  (:shadowing-import-from :cl close open ftruncate truncate time
              read write)
  (:use :cl :sb-posix)
  (:export #:open-serial
       #:close-serial
       #:fd-type
       #:serial-recv-length
       #:read-response
       #:write-zeiss
       #:talk-zeiss))

(defpackage :focus
  (:use :cl :serial)
  (:export #:get-position
       #:set-position
       #:connect
       #:disconnect))

serial.lisp:

(in-package :serial)

(defconstant FIONREAD #x541B)
(defconstant IXANY #o4000)
(defconstant CRTSCTS #o20000000000)

(deftype fd-type ()
  `(unsigned-byte 31))

(defun open-serial (tty)
  (declare (string tty)
       (values stream fd-type &optional))
  (let* ((fd (sb-posix:open
          tty (logior O-RDWR
              O-NOCTTY #+nil (this terminal can't control this program)
              O-NDELAY #+nil (we don't wait until dcd is space)
              )))
     (term (tcgetattr fd))
     (baud-rate B9600))

    (fcntl fd F-SETFL (logior O-RDWR O-NOCTTY)) #+nil (reset file status flags, clearing e.g. O-NDELAY)

    (cfsetispeed baud-rate term)
    (cfsetospeed baud-rate term)

    (macrolet ((set-flag (flag &key (on ()) (off ()))
         `(setf ,flag (logior ,@on (logand ,flag ,@off)))))

    (setf
     (aref (termios-cc term) VMIN) 1 #+nil (wake up after 32 chars are read)
     (aref (termios-cc term) VTIME) 5 #+nil (wake up when no char arrived for .1 s))

     ;; check and strip parity, handshake off
     (set-flag (termios-iflag term)
           :on ()
           :off (IXON IXOFF IXANY
             IGNBRK BRKINT PARMRK ISTRIP
             INLCR IGNCR ICRNL
              ))

     ;; process output
     (set-flag (termios-oflag term)
           :off (OPOST))

     ;; canonical input but no echo
     (set-flag (termios-lflag term)
           :on ()
           :off (ICANON ECHO ECHONL IEXTEN ISIG))

     ;; enable receiver, local mode, 8N1 (no parity)
     (set-flag (termios-cflag term)
           :on (CLOCAL CREAD 
               CS8 CRTSCTS)
           :off (CSTOPB CSIZE PARENB)))

    (tcflush fd TCIFLUSH) #+nil (throw away any input data)

    (tcsetattr fd TCSANOW term) #+nil (set terminal port attributes)
    (values
     (sb-sys:make-fd-stream fd :input t :output t
                :buffering :full)
     fd)))

(defun close-serial (fd)
  (declare (fd-type fd)
       (values null &optional))
  (fcntl fd F-SETFL 0) #+nil (reset file status flags, clearing e.g. O-NONBLOCK)
  (sb-posix:close fd) #+nil (this will set DTR low)
  nil)

(defun serial-recv-length (fd)
  (declare (fd-type fd)
       (values (signed-byte 32) &optional))
  (sb-alien:with-alien ((bytes sb-alien:int))
    (ioctl fd FIONREAD (sb-alien:addr bytes))
    bytes))

(defun read-response (tty-fd tty-stream)
  (declare (fd-type tty-fd)
       (stream tty-stream)
       (values string &optional))
  (declare (fd-type tty-fd)
       (stream tty-stream)
       (values string &optional))
  (let ((n (serial-recv-length tty-fd)))
    (if (eq 0 n)
    ""
    (let ((ret (make-string n)))
      (dotimes (i n)
        (setf (char ret i) (read-char tty-stream)))
      ret))))

(defun write-zeiss (tty-stream command)
  (declare (stream tty-stream)
       (string command))
  (format tty-stream "~a~a" command #\Return)
  (finish-output tty-stream))

(defun talk-zeiss (tty-fd tty-stream command)
  (declare (fd-type tty-fd)
       (stream tty-stream)
       (string command)
       (values string &optional))
  (write-zeiss tty-stream command)
  ;; I measured that the position is fully transmitted after 30 ms.
  (let ((n (do ((i 0 (1+ i))
        (n 0 (serial-recv-length tty-fd)))
           ((or (< 0 n) (<= 30 i)) n)
         (sleep .03d0))))
    (if (eq 0 n)
    ""
    (read-response tty-fd tty-stream))))

focus.lisp:

(in-package :focus)

(defvar *stream* nil)
(defvar *fd* nil)

(defun run-shell (command)
  (with-output-to-string (stream)
    (sb-ext:run-program "/bin/bash" (list "-c" command)
            :input nil
            :output stream)))

(defun find-zeiss-usb-adapter ()
  (let ((port (run-shell "dmesg|grep pl2303|grep ttyUSB|tail -n1|sed s+.*ttyUSB+/dev/ttyUSB+g|tr -d '\\n'")))
    (if (string-equal "" port)
    (error "dmesg output doesn't contain ttyUSB assignment. This can happen when the system ran a long time. You could reattach the USB adapter that is connected to the microscope.")
    port)))

#+nil
(find-zeiss-usb-adapter)

(defun connect (&optional (devicename (find-zeiss-usb-adapter)))
  (multiple-value-bind (s fd)
      (open-serial devicename)
    (defparameter *stream* s)
        (defparameter *fd* fd)))
#+nil
(connect)

(defun disconnect ()
  (close-serial *fd*)
  (setf *stream* nil))

#+nil
(disconnect)

#+nil
(serial-recv-length *fd*)

#+nil ;; do cat /dev/ttyUSB1 in some terminal, or use read-response below
(progn
  (format *stream* "HPTv0~a" #\Return)
  (finish-output *stream*))

#+nil
(progn
  (format *stream* "FPZp~a" #\Return)
  (finish-output *stream*))

#+nil
(read-response *fd* *stream*)

#+nil
(response->pos-um (read-response *fd* *stream*))

#+nil
(close-serial *fd2*)

#+nil
(time
 (response->pos-um (talk-zeiss *fd2* *s2* "FPZp")))

#+nil ;; measure the time it takes until the full response has arrived
(progn
 (format *s2* "FPZp~a" #\Return)
 (finish-output *s2*)
 (dotimes (i 10)
   (sleep .01d0)
   (format t "~a~%" (list i (serial-recv-length *fd2*))))
 (read-response *fd2* *s2*))

(defconstant +step-size+ .025s0 "Distance of one z step in micrometer.")

(defun response->pos-um (answer)
  (declare (string answer)
       (values single-float &optional))
  (if (equal "PF" (subseq answer 0 2))
    (let* ((uval (the fixnum (read-from-string
                  (format nil "#x~a" (subseq answer 2)))))
       (val (if (eq 0 (logand uval #x800000))
            uval ;; positive
            (- uval #xffffff 1))))
      (* +step-size+ val))
    (error "unexpected answer on serial port.")))

;; some tricks with two's complement here!  be sure to generate a
;; 24bit signed number consecutive application of pos-um->request and
;; response->pos-um should be the identity (if you don't consider the
;; prefix "PF" that response->pos-um expects)

(defun pos-um->request (pos-um)
  (declare (single-float pos-um)
       (values string &optional))
  (format nil "~6,'0X"
      (let ((val (round pos-um +step-size+)))
        (if (< val 0)
        (+ #xffffff val 1)
        val))))

(defun get-position ()
  (declare (values single-float &optional))
  (response->pos-um (talk-zeiss *fd* *stream* "FPZp")))

(defun set-position (position-um)
  "Decreasing the position moves away from sample."
  (declare (single-float position-um))
  (write-zeiss *stream*
           (format nil "FPZT~a" (pos-um->request position-um))))

#+nil
(format nil "FPZT~a" (pos-um->request -8.0d0))

#+nil
(defparameter current-pos (get-position *fd* *stream*))
#+nil
(format t "pos: ~a~%" (get-position *fd2* *s2*))
#    +nil
(time (format t "response ~a~%"
          (set-position *s2* (+ current-pos 0.7d0))))

#+nil
(progn
  (set-position *s2* (+ current-pos 135d0))
  (dotimes (i 20)
    (format t "pos ~a~%" (list i (get-position *fd2* *s2*)))))

#+nil
(loop for i below 100 do
     (sleep .1)
     (format t "~a~%" (response->pos-um (talk-zeiss "FPZp"))))

---

I don't know if there's a free one available, but LispWorks has one - SERIAL-PORT.

Failing that, you might have to write your own. You could try simply writing the FFI wrappers for the Windows calls (GetCommState, WaitCommEvent, etc.) as a start. It's most certainly doable.

---

This isn't really a lisp question, but I'll attempt to answer it anyway. Short answer: no. Long answer: possibly. It depends on how the FFI works and what environment you're using(raw windows, cygwin, mingw) If you are using raw windows, the chances is very slim. Actually, either way I'd bet the chances are slim. Lisp is a fairly high-level language, and isn't designed for stuff such as this.