From 73a4605a595c7a3af5382e6e4c99084fcf6a436a Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Thu, 13 May 2010 00:46:19 +0900 Subject: [PATCH] adding stty module --- Makefile | 8 +- lib/chibi/stty.module | 10 ++ lib/chibi/stty.scm | 224 ++++++++++++++++++++++++++++++++++++++++++ lib/chibi/stty.stub | 96 ++++++++++++++++++ 4 files changed, 336 insertions(+), 2 deletions(-) create mode 100644 lib/chibi/stty.module create mode 100644 lib/chibi/stty.scm create mode 100644 lib/chibi/stty.stub diff --git a/Makefile b/Makefile index d22b2dfa..60a3213d 100644 --- a/Makefile +++ b/Makefile @@ -92,7 +92,8 @@ COMPILED_LIBS := lib/srfi/27/rand$(SO) lib/srfi/33/bit$(SO) \ lib/srfi/69/hash$(SO) lib/srfi/95/qsort$(SO) lib/srfi/98/env$(SO) \ lib/chibi/ast$(SO) lib/chibi/net$(SO) lib/chibi/filesystem$(SO) \ lib/chibi/process$(SO) lib/chibi/time$(SO) lib/chibi/system$(SO) \ - lib/chibi/io/io$(SO) lib/chibi/heap-stats$(SO) lib/chibi/disasm$(SO) + lib/chibi/io/io$(SO) lib/chibi/stty$(SO) \ + lib/chibi/heap-stats$(SO) lib/chibi/disasm$(SO) libs: $(COMPILED_LIBS) @@ -108,7 +109,7 @@ include/chibi/install.h: Makefile sexp.o: sexp.c gc.c opt/bignum.c $(INCLUDES) Makefile $(CC) -c $(XCPPFLAGS) $(XCFLAGS) $(CLIBFLAGS) -o $@ $< -eval.o: eval.c opcodes.c vm.c opt/simplify.c $(INCLUDES) include/chibi/eval.h Makefile +eval.o: eval.c opcodes.c vm.c opt/x86.c opt/simplify.c $(INCLUDES) include/chibi/eval.h Makefile $(CC) -c $(XCPPFLAGS) $(XCFLAGS) $(CLIBFLAGS) -o $@ $< main.o: main.c $(INCLUDES) include/chibi/eval.h Makefile @@ -163,6 +164,9 @@ test-build: test-numbers: chibi-scheme$(EXE) LD_LIBRARY_PATH=".:$(LD_LIBRARY_PATH)" ./chibi-scheme$(EXE) tests/numeric-tests.scm +test-flonums: chibi-scheme$(EXE) + LD_LIBRARY_PATH=".:$(LD_LIBRARY_PATH)" ./chibi-scheme$(EXE) tests/flonum-tests.scm + test-hash: chibi-scheme$(EXE) LD_LIBRARY_PATH=".:$(LD_LIBRARY_PATH)" ./chibi-scheme$(EXE) tests/hash-tests.scm diff --git a/lib/chibi/stty.module b/lib/chibi/stty.module new file mode 100644 index 00000000..786a0d4b --- /dev/null +++ b/lib/chibi/stty.module @@ -0,0 +1,10 @@ + +(define-module (chibi stty) + (export stty with-stty TCSANOW TCSADRAIN TCSAFLUSH) + (import-immutable (scheme) + (srfi 33) + (srfi 69)) + (include-shared "stty") + (include "stty.scm") + ) + diff --git a/lib/chibi/stty.scm b/lib/chibi/stty.scm new file mode 100644 index 00000000..3e819b54 --- /dev/null +++ b/lib/chibi/stty.scm @@ -0,0 +1,224 @@ + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; symbolic representation of attributes + +(define stty-lookup (make-hash-table eq?)) + +(for-each + (lambda (c) + (let ((type (cadr c)) + (value (caddr c))) + (hash-table-set! stty-lookup (car c) (cdr c)))) + + ;; ripped from the stty man page, then trimmed down to what seemed + ;; available on most systems + + `(;; characters + ;;(dsusp char ,VDSUSP) ; CHAR will send a terminal stop signal + (eof char ,VEOF) ; CHAR will send an EOF (terminate input) + (eol char ,VEOL) ; CHAR will end the line + (eol2 char ,VEOL2) ; alternate CHAR for ending the line + (erase char ,VERASE) ; CHAR will erase the last character typed + (intr char ,VINTR) ; CHAR will send an interrupt signal + (kill char ,VKILL) ; CHAR will erase the current line + (lnext char ,VLNEXT) ; CHAR will enter the next character quoted + (quit char ,VQUIT) ; CHAR will send a quit signal + (rprnt char ,VREPRINT) ; CHAR will redraw the current line + (start char ,VSTART) ; CHAR will restart output after stopping it + (stop char ,VSTOP) ; CHAR will stop the output + (susp char ,VSUSP) ; CHAR will send a terminal stop signal + (werase char ,VWERASE) ; CHAR will erase the last word typed + + ;; special settings + (cols special #f) ; tell the kernel that the terminal has N columns + (columns special #f) ; same as cols N + (ispeed special #f) ; set the input speed to N + (line special #f) ; use line discipline N + (min special #f) ; with -icanon, set N characters minimum for a completed read + (ospeed special #f) ; set the output speed to N + (rows special #f) ; tell the kernel that the terminal has N rows + (size special #f) ; print the number of rows and columns according to the kernel + (speed special #f) ; print the terminal speed + (time special #f) ; with -icanon, set read timeout of N tenths of a second + + ;; control settings + (clocal control ,CLOCAL) ; disable modem control signals + (cread control ,CREAD) ; allow input to be received + (crtscts control ,CRTSCTS) ; enable RTS/CTS handshaking + (cs5 control ,CS5) ; set character size to 5 bits + (cs6 control ,CS6) ; set character size to 6 bits + (cs7 control ,CS7) ; set character size to 7 bits + (cs8 control ,CS8) ; set character size to 8 bits + (cstopb control ,CSTOPB) ; use two stop bits per character (one with `-') + (hup control ,HUPCL) ; send a hangup signal when the last process closes the tty + (hupcl control ,HUPCL) ; same as [-]hup + (parenb control ,PARENB) ; generate parity bit in output and expect parity bit in input + (parodd control ,PARODD) ; set odd parity (even with `-') + + ;; input settings + (brkint input ,BRKINT) ; breaks cause an interrupt signal + (icrnl input ,ICRNL) ; translate carriage return to newline + (ignbrk input ,IGNBRK) ; ignore break characters + (igncr input ,IGNCR) ; ignore carriage return + (ignpar input ,IGNPAR) ; ignore characters with parity errors + (imaxbel input ,IMAXBEL) ; * beep and do not flush a full input buffer on a character + (inlcr input ,INLCR) ; translate newline to carriage return + (inpck input ,INPCK) ; enable input parity checking + (istrip input ,ISTRIP) ; clear high (8th) bit of input characters + ;;(iuclc input ,IUCLC) ; * translate uppercase characters to lowercase + (ixany input ,IXANY) ; * let any character restart output, not only start character + (ixoff input ,IXOFF) ; enable sending of start/stop characters + (ixon input ,IXON) ; enable XON/XOFF flow control + (parmrk input ,PARMRK) ; mark parity errors (with a 255-0-character sequence) + (tandem input ,IXOFF) ; same as [-]ixoff + + ;; output settings + ;;(bs0 output ,BS0) ; backspace delay style, N in [0..1] + ;;(bs1 output ,BS1) ; backspace delay style, N in [0..1] + ;;(cr0 output ,CR0) ; carriage return delay style, N in [0..3] + ;;(cr1 output ,CR1) ; carriage return delay style, N in [0..3] + ;;(cr2 output ,CR2) ; carriage return delay style, N in [0..3] + ;;(cr3 output ,CR3) ; carriage return delay style, N in [0..3] + ;;(ff0 output ,FF0) ; form feed delay style, N in [0..1] + ;;(ff1 output ,FF1) ; form feed delay style, N in [0..1] + ;;(nl0 output ,NL0) ; newline delay style, N in [0..1] + ;;(nl1 output ,NL1) ; newline delay style, N in [0..1] + (ocrnl output ,OCRNL) ; translate carriage return to newline + ;;(ofdel output ,OFDEL) ; use delete characters for fill instead of null characters + ;;(ofill output ,OFILL) ; use fill (padding) characters instead of timing for delays + ;;(olcuc output ,OLCUC) ; translate lowercase characters to uppercase + (onlcr output ,ONLCR) ; translate newline to carriage return-newline + (onlret output ,ONLRET) ; newline performs a carriage return + (onocr output ,ONOCR) ; do not print carriage returns in the first column + (opost output ,OPOST) ; postprocess output + (tab0 output #f) ; horizontal tab delay style, N in [0..3] + (tab1 output #f) ; horizontal tab delay style, N in [0..3] + (tab2 output #f) ; horizontal tab delay style, N in [0..3] + (tab3 output #f) ; horizontal tab delay style, N in [0..3] + (tabs output #f) ; same as tab0 + ;;(-tabs output #f) ; same as tab3 + ;;(vt0 output ,VT0) ; vertical tab delay style, N in [0..1] + ;;(vt1 output ,VT1) ; vertical tab delay style, N in [0..1] + + ;; local settings + (crterase local ,ECHOE) ; echo erase characters as backspace-space-backspace + (crtkill local ,ECHOKE) ; kill all line by obeying the echoprt and echoe settings + ;;(-crtkill local #f) ; kill all line by obeying the echoctl and echok settings + (ctlecho local ,ECHOCTL) ; echo control characters in hat notation (`^c') + (echo local ,ECHO) ; echo input characters + (echoctl local ,ECHOCTL) ; same as [-]ctlecho + (echoe local ,ECHOE) ; same as [-]crterase + ;;(echok local ,ECHOK) ; echo a newline after a kill character + (echoke local ,ECHOKE) ; same as [-]crtkill + (echonl local ,ECHONL) ; echo newline even if not echoing other characters + (echoprt local ,ECHOPRT) ; echo erased characters backward, between `\' and '/' + (icanon local ,ICANON) ; enable erase, kill, werase, and rprnt special characters + ;;(iexten local ,IEXTEN) ; enable non-POSIX special characters + (isig local ,ISIG) ; enable interrupt, quit, and suspend special characters + (noflsh local ,NOFLSH) ; disable flushing after interrupt and quit special characters + (prterase local ,ECHOPRT) ; same as [-]echoprt + (tostop local ,TOSTOP) ; stop background jobs that try to write to the terminal + ;;(xcase local ,XCASE) ; with icanon, escape with `\' for uppercase characters + + ;; combination settings + (LCASE combine (lcase)) + (cbreak combine (not icanon)) + (cooked combine (brkint ignpar istrip icrnl ixon opost isig icanon)) + ; also eof and eol characters + ; to their default values + (crt combine (echoe echoctl echoke)) + (dec combine (echoe echoctl echoke (not ixany))) + ; also intr ^c erase 0177 kill ^u + (decctlq combine (ixany)) + (ek combine ()) ; erase and kill characters to their default values + (evenp combine (parenb (not parodd) cs7)) + ;;(-evenp combine #f) ; same as -parenb cs8 + (lcase combine (xcase iuclc olcuc)) + (litout combine (cs8 (not parenb istrip opost))) + ;;(-litout combine #f) ; same as parenb istrip opost cs7 + (nl combine (not icrnl onlcr)) + ;;(-nl combine #f) ; same as icrnl -inlcr -igncr onlcr -ocrnl -onlret + (oddp combine (parenb parodd cs7)) + (parity combine (evenp)) ; same as [-]evenp + (pass8 combine (cs8 (not parenb istrip))) + ;;(-pass8 combine #f) ; same as parenb istrip cs7 + (raw combine (not ignbrk brkint ignpar parmrk + inpck istrip inlcr igncr icrnl)) + (ixon combine (ixoff ixany imaxbel opost isig icanon)) ;; xcase iuclc + ;;(time combine #f) ; 0 + ;;(-raw combine #f) ; same as cooked + (sane combine (cread brkint icrnl imaxbel opost onlcr + isig icanon ;; nl0 cr0 bs0 vt0 ff0 ; tab0 + echo echoe echoctl echoke ;; iexten echok + (not ignbrk igncr ixoff ixany inlcr ;; iuclc + ocrnl onocr onlret ;; olcuc ofill ofdel + echonl noflsh tostop echoprt))) ;; xcase + ; plus all special characters to + ; their default values + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; high-level interface + +(define (port? x) (or (input-port? x) (output-port? x))) + +(define (stty . args) + (let* ((port (if (and (pair? args) (port? (car args))) + (car args) + (current-output-port))) + (attr (get-terminal-attributes port))) + ;; parse change requests + (let lp ((lst (if (and (pair? args) (port? (car args))) (cdr args) args)) + (iflag (term-attrs-iflag attr)) + (oflag (term-attrs-oflag attr)) + (cflag (term-attrs-cflag attr)) + (lflag (term-attrs-lflag attr)) + (invert? #f) + (return (lambda (iflag oflag cflag lflag) + (term-attrs-iflag-set! attr iflag) + (term-attrs-oflag-set! attr oflag) + (term-attrs-cflag-set! attr cflag) + (term-attrs-lflag-set! attr lflag) + (set-terminal-attributes! port TCSANOW attr)))) + (define (join old new) + (if invert? (bitwise-and old (bitwise-not new)) (bitwise-ior old new))) + (cond + ((pair? lst) + (let ((command (car lst))) + (cond + ((pair? command) ;; recurse on sub-expr + (lp command iflag oflag cflag lflag invert? + (lambda (i o c l) (lp (cdr lst) i o c l invert? return)))) + ((eq? command 'not) ;; toggle current setting + (lp (cdr lst) iflag oflag cflag lflag (not invert?) return)) + (else + (let ((x (hash-table-ref/default stty-lookup command #f))) + (case (and x (car x)) + ((input) + (lp (cdr lst) (join iflag (cadr x)) oflag cflag lflag invert? return)) + ((output) + (lp (cdr lst) iflag (join oflag (cadr x)) cflag lflag invert? return)) + ((control) + (lp (cdr lst) iflag oflag (join cflag (cadr x)) lflag invert? return)) + ((local) + (lp (cdr lst) iflag oflag cflag (join lflag (cadr x)) invert? return)) + ((char) + ;;(term-attrs-cc-set! attr (cadr x) (or (cadr lst) 0)) + (lp (cddr lst) iflag oflag cflag lflag invert? return)) + ((combine) ;; recurse on def of this command + (lp (cadr x) iflag oflag cflag lflag invert? + (lambda (i o c l) (lp (cdr lst) i o c l invert? return)))) + ((special) + (error "special settings not yet supported" command)) + (else + (error "unknown stty command" command)))))))) + (else + (return iflag oflag cflag lflag)))))) + +(define (with-stty setting thunk . o) + (let* ((port (if (pair? o) (car o) (current-input-port))) + (orig-attrs (get-terminal-attributes port))) + (dynamic-wind + (lambda () (stty setting)) + thunk + (lambda () (set-terminal-attributes! port TCSANOW orig-attrs))))) diff --git a/lib/chibi/stty.stub b/lib/chibi/stty.stub new file mode 100644 index 00000000..40a4a20b --- /dev/null +++ b/lib/chibi/stty.stub @@ -0,0 +1,96 @@ + +(c-system-include "termios.h") + +(define-c-struct termios + predicate: term-attrs? + constructor: (make-term-attrs) + ;;destructor: free-term-attrs + (unsigned-long c_iflag term-attrs-iflag term-attrs-iflag-set!) + (unsigned-long c_oflag term-attrs-oflag term-attrs-oflag-set!) + (unsigned-long c_cflag term-attrs-cflag term-attrs-cflag-set!) + (unsigned-long c_lflag term-attrs-lflag term-attrs-lflag-set!) + ;;(unsigned-char (c_cc 22) term-attrs-cc term-attrs-cc-set!) + (unsigned-long c_ispeed term-attrs-ispeed term-attrs-ispeed-set!) + (unsigned-long c_ospeed term-attrs-ospeed term-attrs-ospeed-set!)) + +(define-c-const int TCSANOW) +(define-c-const int TCSADRAIN) +(define-c-const int TCSAFLUSH) +;; (define-c-const int TCSASOFT) + +(define-c-const unsigned-long IGNBRK) +(define-c-const unsigned-long BRKINT) +(define-c-const unsigned-long IGNPAR) +(define-c-const unsigned-long PARMRK) +(define-c-const unsigned-long INPCK) +(define-c-const unsigned-long ISTRIP) +(define-c-const unsigned-long INLCR) +(define-c-const unsigned-long IGNCR) +(define-c-const unsigned-long ICRNL) +(define-c-const unsigned-long IXON) +(define-c-const unsigned-long IXOFF) +(define-c-const unsigned-long IXANY) +(define-c-const unsigned-long IMAXBEL) +;; (define-c-const unsigned-long IUCLC) + +(define-c-const unsigned-long OPOST) +(define-c-const unsigned-long ONLCR) +;; (define-c-const unsigned-long OXTABS) +;; (define-c-const unsigned-long ONOEOT) +(define-c-const unsigned-long OCRNL) +;; (define-c-const unsigned-long OLCUC) +(define-c-const unsigned-long ONOCR) +(define-c-const unsigned-long ONLRET) + +(define-c-const unsigned-long CSIZE) +(define-c-const unsigned-long CS5) +(define-c-const unsigned-long CS6) +(define-c-const unsigned-long CS7) +(define-c-const unsigned-long CS8) +(define-c-const unsigned-long CSTOPB) +(define-c-const unsigned-long CREAD) +(define-c-const unsigned-long PARENB) +(define-c-const unsigned-long PARODD) +(define-c-const unsigned-long HUPCL) +(define-c-const unsigned-long CLOCAL) +;; (define-c-const unsigned-long CCTS_OFLOW) +(define-c-const unsigned-long CRTSCTS) +;; (define-c-const unsigned-long CRTS_IFLOW) +;; (define-c-const unsigned-long MDMBUF) + +(define-c-const unsigned-long ECHOKE) +(define-c-const unsigned-long ECHOE) +(define-c-const unsigned-long ECHO) +(define-c-const unsigned-long ECHONL) +(define-c-const unsigned-long ECHOPRT) +(define-c-const unsigned-long ECHOCTL) +(define-c-const unsigned-long ISIG) +(define-c-const unsigned-long ICANON) +;; (define-c-const unsigned-long ALTWERASE) +(define-c-const unsigned-long IEXTEN) +;; (define-c-const unsigned-long EXTPROC) +(define-c-const unsigned-long TOSTOP) +(define-c-const unsigned-long FLUSHO) +;; (define-c-const unsigned-long NOKERNINFO) +(define-c-const unsigned-long PENDIN) +(define-c-const unsigned-long NOFLSH) + +(define-c-const unsigned-long VEOF) +(define-c-const unsigned-long VEOL) +(define-c-const unsigned-long VEOL2) +(define-c-const unsigned-long VERASE) +;; (define-c-const unsigned-long VERASE2) +(define-c-const unsigned-long VWERASE) +(define-c-const unsigned-long VINTR) +(define-c-const unsigned-long VKILL) +(define-c-const unsigned-long VQUIT) +(define-c-const unsigned-long VSUSP) +(define-c-const unsigned-long VSTART) +(define-c-const unsigned-long VSTOP) +;; (define-c-const unsigned-long VDSUSP) +(define-c-const unsigned-long VLNEXT) +(define-c-const unsigned-long VREPRINT) +;; (define-c-const unsigned-long VSTATUS) + +(define-c errno (get-terminal-attributes "tcgetattr") (port-or-fd (result termios))) +(define-c errno (set-terminal-attributes! "tcsetattr") (port-or-fd int termios))