0.8.7.53:

	Implement tc{get,set}attr() for sb-posix
	... yet more horrible kludges that will need fixing once sb-grovel
		generates alien types -- including one in constants.lisp

diff --git a/CREDITS b/CREDITS
index fe88f80..1e79aa1 100644 (file)
--- a/CREDITS
+++ b/CREDITS
@@ -675,10 +675,12 @@ Raymond Wiker:
 
 INITIALS GLOSSARY (helpful when reading comments, CVS commit logs, etc.)
 
+VJA  Vincent Arkesteijn
 MNA  Martin Atzmueller
 DB   Daniel Barlow (also "dan")
 DTC  Douglas Crosher
 APD  Alexey Dejneka
+PFD  Paul F. Dietz
 NJF  Nathan Froyd
 AL   Arthur Lemmens
 RAM  Robert MacLachlan
@@ -687,4 +689,3 @@ WHN  William ("Bill") Newman
 CSR  Christophe Rhodes
 PVE  Peter Van Eynde
 PW   Paul Werkowski
-PFD  Paul F. Dietz

diff --git a/NEWS b/NEWS
index 564f221..eb0ab0d 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2259,6 +2259,8 @@ changes in sbcl-0.8.8 relative to sbcl-0.8.7:
     recursive manner.
   * bug fix: arrays specialized on (UNSIGNED-BYTE 15) are now
     recognized as being TYPEP their class.
+  * bug fix: the PUSHNEW documentation string has been corrected.
+    (thanks to Vincent Arkesteijn)
   * optimization: implemented multiplication as a modular
     (UNSIGNED-BYTE 32) operation on the x86 backend.
   * optimization: SEARCH on simple-base-strings can now be open-coded.

diff --git a/contrib/sb-posix/constants.lisp b/contrib/sb-posix/constants.lisp
index b5707b2..eb69613 100644 (file)
--- a/contrib/sb-posix/constants.lisp
+++ b/contrib/sb-posix/constants.lisp
@@ -11,7 +11,9 @@
  "sys/socket.h" "sys/un.h" "netinet/in.h" "netinet/in_systm.h"
  "netinet/ip.h" "net/if.h" "netdb.h" "errno.h" "netinet/tcp.h"
  "fcntl.h" "sys/mman.h"
- "dirent.h" "signal.h")
+ "dirent.h" "signal.h"
+
+ "termios.h")
 
 ;;; then the stuff we're looking for
 ((:integer af-inet "AF_INET" "IP Protocol family")
@@ -268,7 +270,7 @@
  (:integer o-directory "O_DIRECTORY")
  (:integer o-direct "O_DIRECT")
  (:integer o-async "O_ASYNC")
- (:integer o-largefile "O_LARGEFILE") ; hmm...
+ (:integer o-largefile "O_LARGEFILE")  ; hmm...
  (:integer o-dsync "O_DSYNC")
  (:integer o-rsync "O_RSYNC")
 
@@ -288,5 +290,128 @@
  (:integer f-setlkw "F_SETLKW")
  (:integer f-getown "F_GETOWN")
  (:integer f-setown "F_SETOWN")
+
+ ;; tcgetattr(), tcsetattr()
+ (:type cc-t "cc_t")
+ (:type speed-t "speed_t")
+ (:type tcflag-t "tcflag_t")
+ (:integer nccs "NCCS")
+ 
+ (:structure termios
+            ("struct termios"
+             (tcflag-t iflag "tcflag_t" "c_iflag")
+             (tcflag-t oflag "tcflag_t" "c_oflag")
+             (tcflag-t cflag "tcflag_t" "c_cflag")
+             (tcflag-t lflag "tcflag_t" "c_lflag")
+             ;; Uh, so what's the point of grovelling CC-T if I can't
+             ;; use it here?  the c_cc field is an array of NCCS
+             ;; elements of type cc_t.  FIXME
+             ((array (unsigned 8)) cc "cc_t" "c_cc")))
+ 
+ (:integer veof "VEOF")
+ (:integer veol "VEOL")
+ (:integer verase "VERASE")
+ (:integer vintr "VINTR")
+ (:integer vkill "VKILL")
+ (:integer vmin "VMIN")
+ (:integer vquit "VQUIT")
+ (:integer vstart "VSTART")
+ (:integer vstop "VSTOP")
+ (:integer vsusp "VSUSP")
+ (:integer vtime "VTIME")
+
+ (:integer brkint "BRKINT")
+ (:integer icrnl "ICRNL")
+ (:integer ignbrk "IGNBRK")
+ (:integer igncr "IGNCR")
+ (:integer ignpar "IGNPAR")
+ (:integer inlcr "INLCR")
+ (:integer inpck "INPCK")
+ (:integer istrip "ISTRIP")
+ #+xsi                              ; FIXME: an extension, apparently
+ (:integer ixany "IXANY")
+ (:integer ixoff "IXOFF")
+ (:integer ixon "IXON")
+ (:integer parmrk "PARMRK")
+
+ (:integer opost "OPOST")
+ #+xsi
+ (:integer onlcr "ONLCR")
+ (:integer ocrnl "OCRNL")
+ (:integer onlret "ONLRET")
+ (:integer ofill "OFILL")
+ (:integer nldly "NLDLY")
+ (:integer nl0 "NL0")
+ (:integer nl1 "NL1")
+ (:integer crdly "CRDLY")
+ (:integer cr0 "CR0")
+ (:integer cr1 "CR1")
+ (:integer cr2 "CR2")
+ (:integer cr3 "CR3")
+ (:integer tabdly "TABDLY")
+ (:integer tab0 "TAB0")
+ (:integer tab1 "TAB1")
+ (:integer tab2 "TAB2")
+ (:integer tab3 "TAB3")
+ (:integer bsdly "BSDLY")
+ (:integer bs0 "BS0")
+ (:integer bs1 "BS1")
+ (:integer vtdly "VTDLY")
+ (:integer vt0 "VT0")
+ (:integer vt1 "VT1")
+ (:integer ffdly "FFDLY")
+ (:integer ff0 "FF0")
+ (:integer ff1 "FF1")
+
+ (:integer b0 "B0")
+ (:integer b50 "B50")
+ (:integer b75 "B75")
+ (:integer b110 "B110")
+ (:integer b134 "B134")
+ (:integer b150 "B150")
+ (:integer b200 "B200")
+ (:integer b300 "B300")
+ (:integer b600 "B600")
+ (:integer b1200 "B1200")
+ (:integer b1800 "B1800")
+ (:integer b2400 "B2400")
+ (:integer b4800 "B4800")
+ (:integer b9600 "B9600")
+ (:integer b19200 "B19200")
+ (:integer b38400 "B38400")
+
+ (:integer csize "CSIZE")
+ (:integer cs5 "CS5")
+ (:integer cs6 "CS6")
+ (:integer cs7 "CS7")
+ (:integer cs8 "CS8")
+ (:integer cstopb "CSTOPB")
+ (:integer cread "CREAD")
+ (:integer parenb "PARENB")
+ (:integer parodd "PARODD")
+ (:integer hupcl "HUPCL")
+ (:integer clocal "CLOCAL")
+
+ (:integer echo "ECHO")
+ (:integer echoe "ECHOE")
+ (:integer echok "ECHOK")
+ (:integer echonl "ECHONL")
+ (:integer icanon "ICANON")
+ (:integer iexten "IEXTEN")
+ (:integer isig "ISIG")
+ (:integer noflsh "NOFLSH")
+ (:integer tostop "TOSTOP")
+
+ (:integer tcsanow "TCSANOW")
+ (:integer tcsadrain "TCSADRAIN")
+ (:integer tcsaflush "TCSAFLUSH")
+
+ (:integer tciflush "TCIFLUSH")
+ (:integer tcioflush "TCIOFLUSH")
+ (:integer tcoflush "TCOFLUSH")
+ (:integer tcioff "TCIOFF")
+ (:integer tcion "TCION")
+ (:integer tcooff "TCOOFF")
+ (:integer tcoon "TCOON")
  
  )

diff --git a/contrib/sb-posix/interface.lisp b/contrib/sb-posix/interface.lisp
index 06f9c30..7c83661 100644 (file)
--- a/contrib/sb-posix/interface.lisp
+++ b/contrib/sb-posix/interface.lisp
@@ -197,3 +197,41 @@
     (when (minusp r)
       (syscall-error)))
   (values (aref filedes2 0) (aref filedes2 1)))
+
+(export 'sb-posix::tcsetattr :sb-posix)
+(declaim (inline sb-posix::tcsetattr))
+(defun sb-posix::tcsetattr (fd actions termios)
+  (let ((fd (sb-posix::file-descriptor fd)))
+    (let* ((s (sb-sys:int-sap
+              ;; FIXME: WILL NOT WORK ON 64-BIT LISP.  VECTOR-SAP would
+              ;; be better if the STAT object were guaranteed to be a
+              ;; vector, but it's not (and may well turn into an alien
+              ;; soon).
+              (+ 8 (logandc2 (sb-kernel:get-lisp-obj-address termios) 7))))
+          (r (alien-funcall
+              ;; it's the old (* T) problem again :-(
+              (extern-alien "tcsetattr" (function int int int (* t)))
+              fd actions s)))
+      (when (minusp r)
+       (syscall-error)))
+    (values)))
+(export 'sb-posix::tcgetattr :sb-posix)
+(declaim (inline sb-posix::tcgetattr))
+(defun sb-posix::tcgetattr (fd &optional termios)
+  (unless termios
+    (setq termios (sb-posix::allocate-termios)))
+       ;; FIXME: Hmm.  WITH-PINNED-OBJECTS/WITHOUT-GCING or something
+       ;; is probably needed round here.
+  (let* ((s (sb-sys:int-sap
+            ;; FIXME: WILL NOT WORK ON 64-BIT LISP.  VECTOR-SAP would
+            ;; be better if the STAT object were guaranteed to be a
+            ;; vector, but it's not (and may well turn into an alien
+            ;; soon).
+            (+ 8 (logandc2 (sb-kernel:get-lisp-obj-address termios) 7))))
+        (r (alien-funcall
+            (extern-alien "tcgetattr" (function int int (* t)))
+            (sb-posix::file-descriptor fd)
+            s)))
+    (when (minusp r)
+      (syscall-error)))
+  termios)

diff --git a/version.lisp-expr b/version.lisp-expr
index 28199b0..3c8b81a 100644 (file)
--- 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.8.7.52"
+"0.8.7.53"