From: Christophe Rhodes Date: Tue, 17 Feb 2004 16:50:30 +0000 (+0000) Subject: 0.8.7.53: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=d6d808d530b3cce1dcb29a2db97ddfc3d1c37cbb;p=sbcl.git 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 --- 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 --- 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 --- 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 --- 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 --- 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"