From: Nikodemus Siivola Date: Wed, 18 Oct 2006 11:42:26 +0000 (+0000) Subject: 0.9.17.13: SB-POSIX:CFSET*SPEED, SB-POSIX:CFGET*SPEED, and related constants X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=b665ae77fc8e369b8713abf3ca9e3d8455e4c5a7;p=sbcl.git 0.9.17.13: SB-POSIX:CFSET*SPEED, SB-POSIX:CFGET*SPEED, and related constants * Patch by Max-Gerd Retzlaff. cfsetspeed left out as non-portable, cfgetispeed and cfgetospeed added. * Tests -- which have not been properly run, and aren't run as part of the SB-POSIX suite, since they require serial port access. --- diff --git a/NEWS b/NEWS index a30ad70..a984c1b 100644 --- a/NEWS +++ b/NEWS @@ -1,5 +1,8 @@ ;;;; -*- coding: utf-8; -*- -changes in sbcl-0.9.18 (1.0.beta?) relative to sbcl-0.9.16: +changes in sbcl-0.9.18 (1.0.beta?) relative to sbcl-0.9.17: + * enhancement: SB-POSIX now supports cfsetispeed(3), cfsetospeed(3), + cfgetispeed(3), cfgetospeed(3), and related constants. (thanks to + Max-Gerd Retzlaff) * bug fix: two potential GC deadlocks affecting threaded builds. * bug fix: (TYPEP #\A '(NOT (MEMBER #\" #\{ #\:))) now correctly returns T (reported by Anton Kazennikov) diff --git a/contrib/sb-posix/constants.lisp b/contrib/sb-posix/constants.lisp index fc99cb8..a040eba 100644 --- a/contrib/sb-posix/constants.lisp +++ b/contrib/sb-posix/constants.lisp @@ -420,6 +420,9 @@ (:integer b9600 "B9600" nil t) (:integer b19200 "B19200" nil t) (:integer b38400 "B38400" nil t) + (:integer b57600 "B57600" nil t) + (:integer b115200 "B115200" nil t) + (:integer b230400 "B230400" nil t) (:integer csize "CSIZE" nil t) (:integer cs5 "CS5" nil t) diff --git a/contrib/sb-posix/interface.lisp b/contrib/sb-posix/interface.lisp index 8b8d2b4..6460052 100644 --- a/contrib/sb-posix/interface.lisp +++ b/contrib/sb-posix/interface.lisp @@ -10,6 +10,7 @@ collect (ldiff slotd (member :array-length slotd))) ,@options) (declaim (inline ,to-alien ,to-protocol)) + (declaim (inline ,to-protocol ,to-alien)) (defun ,to-protocol (alien &optional instance) (declare (type (sb-alien:alien (* ,alien-type)) alien) (type (or null ,name) instance)) @@ -366,6 +367,7 @@ (export 'tcsetattr :sb-posix) (declaim (inline tcsetattr)) (defun tcsetattr (fd actions termios) + (declare (type termios termios)) (with-alien-termios a-termios () (termios-to-alien termios a-termios) (let ((fd (file-descriptor fd))) @@ -380,6 +382,7 @@ (export 'tcgetattr :sb-posix) (declaim (inline tcgetattr)) (defun tcgetattr (fd &optional termios) + (declare (type (or null termios) termios)) (with-alien-termios a-termios () (let ((r (alien-funcall (extern-alien "tcgetattr" @@ -389,7 +392,53 @@ (when (minusp r) (syscall-error)) (setf termios (alien-to-termios a-termios termios)))) - termios)) + termios) + (export 'cfsetispeed :sb-posix) + (declaim (inline cfsetispeed)) + (defun cfsetispeed (speed &optional termios) + (declare (type (or null termios) termios)) + (with-alien-termios a-termios () + (let ((r (alien-funcall + (extern-alien "cfsetispeed" + (function int (* alien-termios) speed-t)) + a-termios + speed))) + (when (minusp r) + (syscall-error)) + (setf termios (alien-to-termios a-termios termios)))) + termios) + (export 'cfsetospeed :sb-posix) + (declaim (inline cfsetospeed)) + (defun cfsetospeed (speed &optional termios) + (declare (type (or null termios) termios)) + (with-alien-termios a-termios () + (let ((r (alien-funcall + (extern-alien "cfsetospeed" + (function int (* alien-termios) speed-t)) + a-termios + speed))) + (when (minusp r) + (syscall-error)) + (setf termios (alien-to-termios a-termios termios)))) + termios) + (export 'cfgetispeed :sb-posix) + (declaim (inline cfgetispeed)) + (defun cfgetispeed (termios) + (declare (type termios termios)) + (with-alien-termios a-termios () + (termios-to-alien termios a-termios) + (alien-funcall (extern-alien "cfgetispeed" + (function speed-t (* alien-termios))) + a-termios))) + (export 'cfgetospeed :sb-posix) + (declaim (inline cfgetospeed)) + (defun cfgetospeed (termios) + (declare (type termios termios)) + (with-alien-termios a-termios () + (termios-to-alien termios a-termios) + (alien-funcall (extern-alien "cfgetospeed" + (function speed-t (* alien-termios))) + a-termios)))) ;;; environment diff --git a/contrib/sb-posix/posix-tests.lisp b/contrib/sb-posix/posix-tests.lisp index 4eead06..4e6e6c9 100644 --- a/contrib/sb-posix/posix-tests.lisp +++ b/contrib/sb-posix/posix-tests.lisp @@ -431,3 +431,33 @@ ;; make sure that we found something (not (sb-posix:getpwnam "root")) nil) + +#+nil +;; Requires root or special group + plus a sensible thing on the port +(deftest cfget/setispeed.1 + (with-open-file (s "/dev/ttyS0") + (let* ((termios (sb-posix:tcgetattr s)) + (old (sb-posix:cfgetispeed termios)) + (new (if (= old sb-posix:b2400) + sb-posix:b9600 + sb-posix:b2400))) + (sb-posix:cfsetispeed new termios) + (sb-posix:tcsetattr 0 sb-posix:tcsadrain termios) + (setf termios (sb-posix:tcgetattr s)) + (= new (sb-posix:cfgetispeed termios)))) + t) + +#+nil +;; Requires root or special group + a sensible thing on the port +(deftest cfget/setospeed.1 + (with-open-file (s "/dev/ttyS0" :direction :output :if-exists :append) + (let* ((termios (sb-posix:tcgetattr s)) + (old (sb-posix:cfgetospeed termios)) + (new (if (= old sb-posix:b2400) + sb-posix:b9600 + sb-posix:b2400))) + (sb-posix:cfsetospeed new termios) + (sb-posix:tcsetattr 0 sb-posix:tcsadrain termios) + (setf termios (sb-posix:tcgetattr 0)) + (= new (sb-posix:cfgetospeed termios)))) + t) diff --git a/version.lisp-expr b/version.lisp-expr index a5f9eb5..19b8859 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.9.17.12" +"0.9.17.13"