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.)
 
 
 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
 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
 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
 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.
     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.
   * 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"
  "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")
 
 ;;; 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-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")
 
  (: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")
  (: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)))
     (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".)
 ;;; 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"