From 0ae16c8daaa9ff6ebb111261a7a1b953fe0608e8 Mon Sep 17 00:00:00 2001 From: shivers Date: Mon, 16 Oct 1995 22:19:16 +0000 Subject: [PATCH] Renamed tc* to tty*, and rehacked extensively. --- scsh/tc.c | 60 --------- scsh/tc.scm | 274 ----------------------------------------- scsh/tty-consts.scm | 1 + scsh/tty.scm | 269 ++++++++++++++++++++++++++++++++++++++++ scsh/{tc1.c => tty1.c} | 51 ++++---- 5 files changed, 298 insertions(+), 357 deletions(-) delete mode 100644 scsh/tc.c delete mode 100644 scsh/tc.scm create mode 100644 scsh/tty-consts.scm create mode 100644 scsh/tty.scm rename scsh/{tc1.c => tty1.c} (50%) diff --git a/scsh/tc.c b/scsh/tc.c deleted file mode 100644 index 0681d19..0000000 --- a/scsh/tc.c +++ /dev/null @@ -1,60 +0,0 @@ -/* This is an Scheme48/C interface file, -** automatically generated by cig. -*/ - -#include -#include /* For malloc. */ -#include "libcig.h" - -#include - - -extern int errno; - -#define errno_on_zero_or_false(x) ((x) ? SCHFALSE : ENTER_FIXNUM(errno)) -#define errno_or_false(x) (((x) == -1) ? ENTER_FIXNUM(errno) : SCHFALSE) -#define False_on_zero(x) ((x) ? ENTER_FIXNUM(x) : SCHFALSE) -scheme_value df_scheme_tcgetattr(long nargs, scheme_value *args) -{ - extern int scheme_tcgetattr(int , const char *, int *, int *, int *, int *, int *, int *, int *, int *, int *, int *); - scheme_value ret1; - int r1; - int r2; - int r3; - int r4; - int r5; - int r6; - int r7; - int r8; - int r9; - int r10; - int r11; - - cig_check_nargs(3, nargs, "scheme_tcgetattr"); - r1 = scheme_tcgetattr(EXTRACT_FIXNUM(args[2]), cig_string_body(args[1]), &r2, &r3, &r4, &r5, &r6, &r7, &r8, &r9, &r10, &r11); - ret1 = errno_or_false(r1); - VECTOR_REF(*args,0) = ENTER_FIXNUM(r2); - VECTOR_REF(*args,1) = ENTER_FIXNUM(r3); - VECTOR_REF(*args,2) = ENTER_FIXNUM(r4); - VECTOR_REF(*args,3) = ENTER_FIXNUM(r5); - VECTOR_REF(*args,4) = ENTER_FIXNUM(r6); - VECTOR_REF(*args,5) = ENTER_FIXNUM(r7); - VECTOR_REF(*args,6) = ENTER_FIXNUM(r8); - VECTOR_REF(*args,7) = ENTER_FIXNUM(r9); - VECTOR_REF(*args,8) = ENTER_FIXNUM(r10); - VECTOR_REF(*args,9) = ENTER_FIXNUM(r11); - return ret1; - } - -scheme_value df_scheme_tcsetattr(long nargs, scheme_value *args) -{ - extern int scheme_tcsetattr(int , int , int , int , int , int , int , int , int , int , const char *, int , int ); - scheme_value ret1; - int r1; - - cig_check_nargs(13, nargs, "scheme_tcsetattr"); - r1 = scheme_tcsetattr(EXTRACT_FIXNUM(args[12]), EXTRACT_FIXNUM(args[11]), EXTRACT_FIXNUM(args[10]), EXTRACT_FIXNUM(args[9]), EXTRACT_FIXNUM(args[8]), EXTRACT_FIXNUM(args[7]), EXTRACT_FIXNUM(args[6]), EXTRACT_FIXNUM(args[5]), EXTRACT_FIXNUM(args[4]), EXTRACT_FIXNUM(args[3]), cig_string_body(args[2]), EXTRACT_FIXNUM(args[1]), EXTRACT_FIXNUM(args[0])); - ret1 = errno_or_false(r1); - return ret1; - } - diff --git a/scsh/tc.scm b/scsh/tc.scm deleted file mode 100644 index 258c2cc..0000000 --- a/scsh/tc.scm +++ /dev/null @@ -1,274 +0,0 @@ -;;; Terminal Control for the Scheme Shell -;;; Copyright (c) 1995 by Brian D. Carlstrom. - -;;; Scheme48 implementation. - -(foreign-source - "#include " - "" - "" - "extern int errno;" - "" - "#define errno_on_zero_or_false(x) ((x) ? SCHFALSE : ENTER_FIXNUM(errno))" - "#define errno_or_false(x) (((x) == -1) ? ENTER_FIXNUM(errno) : SCHFALSE)" - "#define False_on_zero(x) ((x) ? ENTER_FIXNUM(x) : SCHFALSE)" - "" ) - -;;; terminal-info -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define-record terminal-info - input-flags - output-flags - control-flags - local-flags - control-chars - input-speed - output-speed) - -;;; tcgetattr -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define (terminal-info fdport) - (let ((control-chars (make-string cc/nccs))) - (receive (iflag-hi8 iflag-lo24 - oflag-hi8 oflag-lo24 - cflag-hi8 cflag-lo24 - lflag-hi8 lflag-lo24 - ispeed ospeed) - (%tcgetattr (->fdes fdport) control-chars) - (make-terminal-info (bitwise-ior - (arithmetic-shift iflag-hi8 24) iflag-lo24) - (bitwise-ior - (arithmetic-shift oflag-hi8 24) oflag-lo24) - (bitwise-ior - (arithmetic-shift cflag-hi8 24) cflag-lo24) - (bitwise-ior - (arithmetic-shift lflag-hi8 24) lflag-lo24) - control-chars - ispeed ospeed)))) - -(define-errno-syscall (%tcgetattr fdes control-chars) %tcgetattr/errno - iflag-hi8 iflag-lo24 - oflag-hi8 oflag-lo24 - cflag-hi8 cflag-lo24 - lflag-hi8 lflag-lo24 - ispeed ospeed) - -(define-foreign %tcgetattr/errno - (scheme_tcgetattr (integer fdes) - (string control-chars)) - (to-scheme integer errno_or_false) - integer integer - integer integer - integer integer - integer integer - integer integer) - -;;; tcsetattr -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define (set-terminal-info fdport option info) - (let ((if (terminal-info:input-flags info)) - (of (terminal-info:output-flags info)) - (cf (terminal-info:control-flags info)) - (lf (terminal-info:local-flags info)) - (cc (terminal-info:control-chars info)) - (is (terminal-info:input-speed info)) - (os (terminal-info:output-speed info))) - (let ((iflag-hi8 (arithmetic-shift if -24)) - (iflag-lo24 (bitwise-and if #xffffff)) - (oflag-hi8 (arithmetic-shift of -24)) - (oflag-lo24 (bitwise-and of #xffffff)) - (cflag-hi8 (arithmetic-shift cf -24)) - (cflag-lo24 (bitwise-and cf #xffffff)) - (lflag-hi8 (arithmetic-shift lf -24)) - (lflag-lo24 (bitwise-and lf #xffffff))) - (%tcsetattr (->fdes fdport) option - iflag-hi8 iflag-lo24 - oflag-hi8 oflag-lo24 - cflag-hi8 cflag-lo24 - lflag-hi8 lflag-lo24 - cc - is os)))) - -(define-simple-errno-syscall (%tcsetattr fdes option - iflag-hi8 iflag-lo24 - oflag-hi8 oflag-lo24 - cflag-hi8 cflag-lo24 - lflag-hi8 lflag-lo24 - control-chars - ispeed ospeed) - %tcsetattr/errno) - -(define-foreign %tcsetattr/errno - (scheme_tcsetattr (integer fdes) - (integer option) - (integer iflag-hi8) - (integer iflag-lo24) - (integer oflag-hi8) - (integer oflag-lo24) - (integer cflag-hi8) - (integer cflag-lo24) - (integer lflag-hi8) - (integer lflag-lo24) - (string control-chars) - (integer ispeed) - (integer ospeed)) - (to-scheme integer errno_or_false)) - -;;; ->fdes - Peeks at fdes of a port -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define (->fdes fdport) - (cond ((integer? fdport) fdport) - ((input-port? fdport) - (fdport-data:fd (extensible-input-port-local-data fdport))) - ((output-port? fdport) - (fdport-data:fd (extensible-output-port-local-data fdport))))) - -;;; Magic Numbers -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -(define tc/set-attributes/now 0) ; make change immediate -(define tc/set-attributes/drain 1) ; drain output, then change -(define tc/set-attributes/flush 2) ; drain output, flush input - -;;; Special Control Characters -;; Index into c_cc[] character array. -;; Name Subscript Enabled by - -;; POSIX -(define cc/veof 0) ; icanon -(define cc/veol 1) ; icanon -(define cc/verase 2) ; icanon -(define cc/vkill 3) ; icanon -(define cc/vintr 4) ; isig -(define cc/vquit 5) ; isig -(define cc/vsusp 6) ; isig -(define cc/vstart 7) ; ixon, ixoff -(define cc/vstop 8) ; ixon, ixoff -(define cc/vmin 9) ; !icanon -(define cc/vtime 10) ; !icanon -;; NeXT -(define cc/vwerase 11) ; icanon -(define cc/vreprint 12) ; icanon -(define cc/vlnext 13) ; iexten -(define cc/vdiscard 14) ; iexten -(define cc/vdsusp 15) ; isig -(define cc/vquote 16) ; icanon -;; Number of Control Characters - *Not Exported* -(define cc/nccs 17) - -;;; Input flags - software input processing -;; POSIX -(define iflag/ignbrk #x00000001) ; ignore break condition -(define iflag/brkint #x00000002) ; map break to sigintr -(define iflag/ignpar #x00000004) ; ignore (discard) parity errors -(define iflag/parmrk #x00000008) ; mark parity and framing errors -(define iflag/inpck #x00000010) ; enable checking of parity errors -(define iflag/istrip #x00000020) ; strip 8th bit off chars -(define iflag/inlcr #x00000040) ; map nl into cr -(define iflag/igncr #x00000080) ; ignore cr -(define iflag/icrnl #x00000100) ; map cr to nl (ala crmod) -(define iflag/ixon #x00000200) ; enable output flow control -(define iflag/ixoff #x00000400) ; enable input flow control -;;NeXT -(define iflag/ixany #x00000800) ; any char will restart after stop -(define iflag/imaxbel #x00002000) ; ring bell on input queue full - - -;;; Output flags - software output processing -;; POSIX -(define oflag/opost #x00000001) ; enable following output processing -;; NeXT -(define oflag/onlcr #x00000002) ; map nl to cr-nl (ala crmod) -; use the same bits as old delay flags -(define oflag/nldelay #x00000300) ; \n delay -(define oflag/nl0 #x00000000) -(define oflag/nl1 #x00000100) ; tty 37 -(define oflag/nl2 #x00000200) ; vt05 -(define oflag/nl3 #x00000300) -(define oflag/tbdelay #x00000c00) ; horizontal tab delay -(define oflag/tab0 #x00000000) -(define oflag/tab1 #x00000400) ; tty 37 -(define oflag/tab2 #x00000800) -(define oflag/xtabs #x00000c00) ; expand tabs on output -(define oflag/crdelay #x00003000) ; \r delay -(define oflag/cr0 #x00000000) -(define oflag/cr1 #x00001000) ; tn 300 -(define oflag/cr2 #x00002000) ; tty 37 -(define oflag/cr3 #x00003000) ; concept 100 -(define oflag/vtdelay #x00004000) ; vertical tab delay -(define oflag/ff0 #x00000000) -(define oflag/ff1 #x00004000) ; tty 37 -(define oflag/bsdelay #x00008000) ; \b delay -(define oflag/bs0 #x00000000) -(define oflag/bs1 #x00008000) -(define oflag/alldelay (bitwise-ior - (bitwise-ior - (bitwise-ior oflag/nldelay oflag/tbdelay) - (bitwise-ior oflag/crdelay oflag/vtdelay)) - oflag/bsdelay)) - -;;; Control flags - hardware control of terminal -;; NeXT -(define cflag/cignore #x00000001) ; ignore control flags -;; POSIX -(define cflag/csize #x00000300) ; character size mask -(define cflag/cs5 #x00000000) ; 5 bits (pseudo) -(define cflag/cs6 #x00000100) ; 6 bits -(define cflag/cs7 #x00000200) ; 7 bits -(define cflag/cs8 #x00000300) ; 8 bits -(define cflag/cstopb #x00000400) ; send 2 stop bits -(define cflag/cread #x00000800) ; enable receiver -(define cflag/parenb #x00001000) ; parity enable -(define cflag/parodd #x00002000) ; odd parity, else even -(define cflag/hupcl #x00004000) ; hang up on last close -(define cflag/clocal #x00008000) ; ignore modem status lines -;; NeXT -(define cflag/cstopb110 #x00010000) -(define cflag/par0 #x00020000) ; space parity -(define cflag/par1 #x00040000) ; mark parity - -;;; "Local" flags - dumping ground for other state -;; Warning: some flags in this structure begin with -;; the letter "I" and look like they belong in the -;; input flag. -;; NeXT -(define lflag/echoke #x00000001) ; visual erase for line kill -;; POSIX -(define lflag/echoe #x00000002) ; visually erase chars -(define lflag/echok #x00000004) ; echo nl after line kill -(define lflag/echo #x00000008) ; enable echoing -(define lflag/echonl #x00000010) ; echo nl even if echo is off -(define lflag/icanon #x00000020) ; canonicalize input lines -(define lflag/isig #x00000040) ; enable signals intr, quit, [d]susp -(define lflag/iexten #x00000080) ; enable discard and lnext -;; NeXT -(define lflag/echocrt #x00000100) ; visual erase mode for crt -(define lflag/echoprt #x00000200) ; visual erase mode for hardcopy -(define lflag/echoctl #x00000400) ; echo control chars as ^(char) -(define lflag/altwerase #x00000800) ; use alternate werase algorithm -(define lflag/mdmbuf #x00100000) ; flow control output via carrier -;; POSIX -(define lflag/tostop #x00400000) ; stop background jobs from output -;; NeXT -(define lflag/xlcase #x04000000) -(define lflag/xeucbksp #x08000000) -;; POSIX -(define lflag/noflsh #x80000000) ; don't flush after interrupt - -;;; Baud Rates -(define baud/0 0) -(define baud/50 1) -(define baud/75 2) -(define baud/110 3) -(define baud/134 4) -(define baud/150 5) -(define baud/200 6) -(define baud/300 7) -(define baud/600 8) -(define baud/1200 9) -(define baud/1800 10) -(define baud/2400 11) -(define baud/4800 12) -(define baud/9600 13) -(define baud/19200 14) -(define baud/38400 15) diff --git a/scsh/tty-consts.scm b/scsh/tty-consts.scm new file mode 100644 index 0000000..9bc149b --- /dev/null +++ b/scsh/tty-consts.scm @@ -0,0 +1 @@ +;;; Constant definitions for tty control code (POSIX termios). ;;; Copyright (c) 1995 by Brian Carlstrom. ;;; Largely rehacked by Olin. ;;; Special Control Characters ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Indices into the c_cc[] character array. ;;; Name Subscript Enabled by ;;; ---- --------- ---------- ;; POSIX (define ttychar/eof 0) ; icanon (define ttychar/eol 1) ; icanon (define ttychar/erase 2) ; icanon (define ttychar/kill 3) ; icanon (define ttychar/intr 4) ; isig (define ttychar/quit 5) ; isig (define ttychar/susp 6) ; isig (define ttychar/start 7) ; ixon, ixoff (define ttychar/stop 8) ; ixon, ixoff (define ttychar/min 9) ; !icanon ; Not exported (define ttychar/time 10) ; !icanon ; Not exported ;; NeXT (define ttychar/word-erase 11) ; icanon (define ttychar/reprint 12) ; icanon (define ttychar/lnext 13) ; iexten (Vas ist das?) (define ttychar/discard 14) ; iexten ('n das?) (define ttychar/dsusp 15) ; isig (define ttychar/quote 16) ; icanon ;; Number of Control Characters - *Not Exported* (define num-ttychars 17) ;;; Flags controllling input processing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; POSIX (define ttyin/ignore-break #x00000001) ; ignbrk (define ttyin/interrupt-on-break #x00000002) ; brkint (define ttyin/ignore-bad-parity-chars #x00000004) ; ignpar (define ttyin/mark-parity-errors #x00000008) ; parmrk (define ttyin/enable-parity #x00000010) ; inpck (define ttyin/strip-8th #x00000020) ; istrip (define ttyin/nl->cr #x00000040) ; inlcr (define ttyin/ignore-cr #x00000080) ; igncr (define ttyin/cr->nl #x00000100) ; icrnl (define ttyin/output-flow-ctl #x00000200) ; ixon (define ttyin/input-flow-ctl #x00000400) ; ixoff ;;Next (define ttyin/xon-any #x00000800) ; ixany: Any char will restart after stop. (define ttyin/beep-on-overflow #x00002000) ; imaxbel: Ring bell on input queue full ;;; Flags controlling output processing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; POSIX (define ttyout/process #x00000001) ; opost: enable output processing. ;; NeXT (define ttyout/nl->crnl #x00000002) ; onlcr: map nl to cr-nl (ala crmod) ; use the same bits as old delay flags (define ttyout/nl-delay #x00000300) ; \n delay (define ttyout/nl-delay0 #x00000000) (define ttyout/nl-delay1 #x00000100) ; tty 37 (define ttyout/nl-delay2 #x00000200) ; vt05 (define ttyout/nl-delay3 #x00000300) (define ttyout/tab-delay #x00000c00) ; horizontal tab delay (define ttyout/tab-delay0 #x00000000) (define ttyout/tab-delay1 #x00000400) ; tty 37 (define ttyout/tab-delay2 #x00000800) ;;; HEY -- This is identical to ttout/tab-delay! (define ttyout/expand-tabs #x00000c00) ; xtabs: expand tabs on output (define ttyout/cr-delay #x00003000) ; \r delay (define ttyout/cr-delay0 #x00000000) (define ttyout/cr-delay1 #x00001000) ; tn 300 (define ttyout/cr-delay2 #x00002000) ; tty 37 (define ttyout/cr-delay3 #x00003000) ; concept 100 (define ttyout/vtab-delay #x00004000) ; vertical tab delay (define ttyout/vtab-delay0 #x00000000) (define ttyout/vtab-delay1 #x00004000) ; tty 37 (define ttyout/bs-delay #x00008000) ; \b delay (define ttyout/bs-delay0 #x00000000) (define ttyout/bs-delay1 #x00008000) (define ttyout/all-delay (bitwise-ior (bitwise-ior (bitwise-ior ttyout/nl-delay ttyout/tab-delay) (bitwise-ior ttyout/cr-delay ttyout/vtab-delay)) ttyout/bsdelay)) ;;; Control flags - hardware control of terminal ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; POSIX (define ttyc/char-size #x00000300) ; csize: character size mask (define ttyc/char-size5 #x00000000) ; 5 bits (cs5) (define ttyc/char-size6 #x00000100) ; 6 bits (cs6) (define ttyc/char-size7 #x00000200) ; 7 bits (cs7) (define ttyc/char-size8 #x00000300) ; 8 bits (cs8) (define ttyc/2-stop-bits #x00000400) ; cstopb: Send 2 stop bits. (define ttyc/read #x00000800) ; cread: Enable receiver. (define ttyc/enable-parity #x00001000) ; parenb (define ttyc/odd-parity #x00002000) ; parodd (define ttyc/hup-on-close #x00004000) ; hupcl: Hang up on last close. (define ttyc/no-modem-sync #x00008000) ; local: Ignore modem lines. ;; NeXT (define ttyc/ignore #x00000001) ; ignore control flags (define ttyc/stopb110 #x00010000) ; VAS IST DAS? -Olin (define ttyc/mark-parity #x00020000) ; par1 (define ttyc/space-parity #x00040000) ; par0 ;;; "Local" flags - dumping ground for other state ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Warning: some flags in this structure begin with the ;; letter "I" and look like they belong in the input flag. ;; POSIX (define ttyl/echo-erase #x00000002) ; echoe: Visually erase chars. (define ttyl/echo-kill #x00000004) ; echok: Echo nl after line kill. (define ttyl/echo #x00000008) ; echo: Enable echoing. (define ttyl/echo-nl #x00000010) ; echonl: Echo nl even if echo is off. (define ttyl/icanon #x00000020) ; icanon: Canonicalize input. (define ttyl/enable-signals #x00000040) ; isig: Enable ^c, ^z signalling. (define ttyl/extended #x00000080) ; iexten: Enable extensions. (define ttyl/ttou-signal #x00400000) ; itostop: Send SIGTTOU on background output. (define ttyl/no-flush-on-interrupt #x80000000) ; noflsh: Don't flush after interrupt. ;; NeXT (define ttyl/visual-echo-kill #x00000001) ; echoke: visually erase line kill (define ttyl/echo-crt #x00000100) ; visual erase mode for crt (define ttyl/echo-printer #x00000200) ; visual erase mode for hardcopy (define ttyl/echo-ctl #x00000400) ; echo control chars as ^(char) (define ttyl/alt-word-erase #x00000800) ; use alternate werase algorithm (define ttyl/carrier-sync #x00100000) ; mdmbuf flow control output via carrier (define ttyl/xlcase #x04000000) ; VAS IST DAS? (define ttyl/xeucbksp #x08000000) ; VAS IST DAS? ;;; NOTE: altwerase xlcase and xeucbksp don't appear in the NeXT tty(4) man ;;; page. Where do they appear? ;;; Baud Rates (define baud/0 0) (define baud/50 1) (define baud/75 2) (define baud/110 3) (define baud/134 4) (define baud/150 5) (define baud/200 6) (define baud/300 7) (define baud/600 8) (define baud/1200 9) (define baud/1800 10) (define baud/2400 11) (define baud/4800 12) (define baud/9600 13) (define baud/19200 14) (define baud/38400 15) ;;; tcflush magic ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define %flush-tty/input ...) ; TCIFLUSH (define %flush-tty/output ...) ; TCOFLUSH (define %flush-tty/both ...) ; TCIOFLUSH ;;; tcflow magic ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define %tcflow/start-out ...) ; TCOON (define %tcflow/stop-out ...) ; TCOOFF (define %tcflow/start-in ...) ; TCION (define %tcflow/stop-in ...) ; TCIOFF \ No newline at end of file diff --git a/scsh/tty.scm b/scsh/tty.scm new file mode 100644 index 0000000..15f72e0 --- /dev/null +++ b/scsh/tty.scm @@ -0,0 +1,269 @@ +;;; To do: +;;; Add new bindings to scsh-level-0 interface defn. +;;; Magic constant defns. + +;;; My comments: +;;; - We have a lot of NeXT-specific stuff. More importantly, what is the +;;; Linux, Solaris, and HP-UX specific stuff? +;;; +;;; - I would suggest totally flushing the ttychars vector from the interface +;;; in favor of individual slots in the TTY-INFO record. Keep the vec +;;; in the implementation, and define the TTY-INFO:EOL, etc. procs by +;;; hand as being indices into the vector. We could *also* expose the +;;; vector if we liked. +;;; -Olin + +;;; Terminal Control for the Scheme Shell +;;; Copyright (c) 1995 by Brian D. Carlstrom. +;;; Rehacked by Olin 8/95. + +(foreign-source + "#include " + "" + "extern int errno;" + "" + "#define errno_or_false(x) (((x) == -1) ? ENTER_FIXNUM(errno) : SCHFALSE)" + "" ) + + +;;; tty-info records +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; I have to fake out my record package so I can define my very own +;;; MAKE-TTY-INFO procedure. Ech. I oughta have a lower-level record macro +;;; for this kind of thing. + +(define-record %tty-info + control-chars + input-flags + output-flags + control-flags + local-flags + input-speed + output-speed + min + time + ((disclose info) '(tty-info))) + +(define tty-info? %tty-info?) +(define type/tty-info %type/tty-info) + +(define tty-info:control-chars %tty-info:control-chars) +(define tty-info:input-flags %tty-info:input-flags) +(define tty-info:output-flags %tty-info:output-flags) +(define tty-info:control-flags %tty-info:control-flags) +(define tty-info:local-flags %tty-info:local-flags) +(define tty-info:input-speed %tty-info:input-speed) +(define tty-info:output-speed %tty-info:output-speed) +(define tty-info:min %tty-info:min) + +(define set-tty-info:control-chars set-%tty-info:control-chars) +(define set-tty-info:input-flags set-%tty-info:input-flags) +(define set-tty-info:output-flags set-%tty-info:output-flags) +(define set-tty-info:control-flags set-%tty-info:control-flags) +(define set-tty-info:local-flags set-%tty-info:local-flags) +(define set-tty-info:input-speed set-%tty-info:input-speed) +(define set-tty-info:output-speed set-%tty-info:output-speed) +(define set-tty-info:min set-%tty-info:min) + +(define (make-tty-info iflags oflags cflags lflags ispeed ospeed min time) + (make-%tty-info (make-string num-ttychars (ascii->char 0)) + iflags oflags cflags lflags ispeed ospeed min time)) + +(define (copy-tty-info info) + (make-%tty-info (string-copy (tty-info:control-chars info)) + (tty-info:input-flags info) + (tty-info:output-flags info) + (tty-info:control-flags info) + (tty-info:local-flags info) + (tty-info:input-speed info) + (tty-info:output-speed info) + (tty-info:min info) + (tty-info:time info))) + + +;;; (tty-info fd/port) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Retrieve tty-info bits from a tty. + +(define (tty-info fdport) + (let ((control-chars (make-string num-ttychars))) + (receive (iflag-hi8 iflag-lo24 oflag-hi8 oflag-lo24 + cflag-hi8 cflag-lo24 lflag-hi8 lflag-lo24 + ispeed ospeed) + (call/fdes fdport (lambda (fd) (%tty-info fd control-chars))) + (make-%tty-info control-chars + (bitwise-ior (arithmetic-shift iflag-hi8 24) iflag-lo24) + (bitwise-ior (arithmetic-shift oflag-hi8 24) oflag-lo24) + (bitwise-ior (arithmetic-shift cflag-hi8 24) cflag-lo24) + (bitwise-ior (arithmetic-shift lflag-hi8 24) lflag-lo24) + ispeed ospeed + (char->ascii (string-ref control-chars ttychar/min)) + (char->ascii (string-ref control-chars ttychar/time)))))) + +(define-errno-syscall (%tty-info fdes control-chars) %tty-info/errno + iflag-hi8 iflag-lo24 + oflag-hi8 oflag-lo24 + cflag-hi8 cflag-lo24 + lflag-hi8 lflag-lo24 + ispeed ospeed) + +(define-foreign %tty-info/errno + (scheme_tty_info (integer fdes) + (string control-chars)) + (to-scheme integer errno_or_false) + integer integer + integer integer + integer integer + integer integer + integer integer) + + +;;; (set-tty-info fdport option info) [Not exported] +;;; (set-tty-info/now fdport option info) +;;; (set-tty-info/drain fdport option info) +;;; (set-tty-info/flush fdport option info) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Assign tty-info bits to a tty. + +(define (set-tty-info fdport option info) + (let ((if (tty-info:input-flags info)) + (of (tty-info:output-flags info)) + (cf (tty-info:control-flags info)) + (lf (tty-info:local-flags info)) + (cc (tty-info:control-chars info)) + (is (tty-info:input-speed info)) + (os (tty-info:output-speed info))) + (let ((iflag-hi8 (arithmetic-shift if -24)) + (iflag-lo24 (bitwise-and if #xffffff)) + (oflag-hi8 (arithmetic-shift of -24)) + (oflag-lo24 (bitwise-and of #xffffff)) + (cflag-hi8 (arithmetic-shift cf -24)) + (cflag-lo24 (bitwise-and cf #xffffff)) + (lflag-hi8 (arithmetic-shift lf -24)) + (lflag-lo24 (bitwise-and lf #xffffff))) + (call/fdes fdport + (lambda (fd) + (%set-tty-info fd option + cc + iflag-hi8 iflag-lo24 + oflag-hi8 oflag-lo24 + cflag-hi8 cflag-lo24 + lflag-hi8 lflag-lo24 + is os + (tty-info:min info) + (tty-info:time info))))))) + +(define-simple-errno-syscall (%set-tty-info fdes option + control-chars + iflag-hi8 iflag-lo24 + oflag-hi8 oflag-lo24 + cflag-hi8 cflag-lo24 + lflag-hi8 lflag-lo24 + ispeed ospeed + min time) + %set-tty-info/errno) + +(define-foreign %set-tty-info/errno + (scheme_set_tty_info (integer fdes) + (integer option) + (string control-chars) + (integer iflag-hi8) + (integer iflag-lo24) + (integer oflag-hi8) + (integer oflag-lo24) + (integer cflag-hi8) + (integer cflag-lo24) + (integer lflag-hi8) + (integer lflag-lo24) + (integer ispeed) + (integer ospeed) + (integer min) + (integer time)) + (to-scheme integer errno_or_false)) + + +;;; Magic Numbers +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; +(define %set-tty-info/now 0) ; Make change immediately. +(define %set-tty-info/drain 1) ; Drain output, then change. +(define %set-tty-info/flush 2) ; Drain output, flush input. + +;;; Exported procs +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (set-tty-info/now fd/port info) + (set-tty-info fd/port %set-tty-info/now info)) + +(define (set-tty-info/drain fd/port info) + (set-tty-info fd/port %set-tty-info/drain info)) + +(define (set-tty-info/flush fd/port info) + (set-tty-info fd/port %set-tty-info/flush info)) + + +;;; Send a break on the serial line. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (send-tty-break fdport . maybe-duration) + (call/fdes fdport + (lambda (fdes) + (%send-tty-break-fdes fdes (optional-arg maybe-duration 0))))) + +(define-errno-syscall (%send-tty-break-fdes fdes duration) + %send-tty-break-fdes/errno) + +(define-foreign %send-tty-break-fdes/errno + (tcsendbreak (integer fdes) (integer duration)) + (to-scheme integer errno_or_false)) + + +;;; Drain the main vein. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (drain-tty fdport) + (cond ((integer? fdport) (%tcdrain fdport)) ; File descriptor. + ((fdport? fdport) ; Scheme port -- flush first. + (force-output fdport) + (call/fdes fdport %tcdrain)) + (else (error "Illegal argument to DRAIN-TTY" fdport)))) + +(define-errno-syscall (%tcdrain fdes) %tcdrain/errno) +(define-foreign %tcdrain/errno (tcdrain (integer fdes)) + (to-scheme integer errno_or_false)) + + +;;; Flushing the device queues. (tcflush) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (make-tty-flusher flag) + (lambda (fdport) + (call/fdes fdport (lambda (fdes) (%tcflush fdes flag))))) + +(define flush-tty/input (make-tty-flusher %flush-tty/input)) +(define flush-tty/output (make-tty-flusher %flush-tty/output)) +(define flush-tty/both (make-tty-flusher %flush-tty/both)) + +(define-errno-syscall (%tcflush fdes flag) %tcflush/errno) +(define-foreign %tcflush/errno (tcflush (integer fdes) (integer flag)) + (to-scheme integer errno_or_false)) + + +;;; Stopping and starting I/O (tcflow) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (make-flow-controller action) + (lambda (fdport) + (call/fdes fdport (lambda (fdes) (%tcflow fdes action))))) + +(define start-tty-output (make-tty-flow-controller %tcflow/start-out)) +(define stop-tty-output (make-tty-flow-controller %tcflow/stop-out)))) +(define start-tty-input (make-tty-flow-controller %tcflow/start-in)) +(define stop-tty-input (make-tty-flow-controller %tcflow/stop-in)) + +(define-errno-syscall (%tcflow fdes action) %tcflow/errno) + +(define-foreign %tcflow/errno + (tcflow (integer fdes) (integer action)) + (to-scheme integer errno_or_false)) diff --git a/scsh/tc1.c b/scsh/tty1.c similarity index 50% rename from scsh/tc1.c rename to scsh/tty1.c index 06c1e3f..e334308 100644 --- a/scsh/tc1.c +++ b/scsh/tty1.c @@ -1,15 +1,17 @@ +/* To do: + * - Replace explicit 8/24 splits with macros. + */ + /* * Scheme48/scsh terminal control interface. * Routines that require custom C support. * Copyright (c) 1995 by Brian D. Carlstrom */ -#include "cstuff.h" #include -#include +#include -int scheme_tcgetattr(int fd, - char control_chars[NCCS], +int scheme_tcgetattr(int fd, char control_chars[NCCS], int *iflag_hi8, int *iflag_lo24, int *oflag_hi8, int *oflag_lo24, int *cflag_hi8, int *cflag_lo24, @@ -17,33 +19,36 @@ int scheme_tcgetattr(int fd, int *ispeed, int *ospeed) { struct termios t; - int result=tcgetattr(fd,&t); + int result = tcgetattr(fd, &t); - if (result == -1) - return result; - - memcpy(control_chars,t.c_cc,NCCS); - *iflag_hi8 =t.c_iflag >> 24; *iflag_lo24=t.c_iflag & 0xffffff; - *oflag_hi8 =t.c_oflag >> 24; *oflag_lo24=t.c_oflag & 0xffffff; - *cflag_hi8 =t.c_cflag >> 24; *cflag_lo24=t.c_cflag & 0xffffff; - *lflag_hi8 =t.c_lflag >> 24; *lflag_lo24=t.c_lflag & 0xffffff; - *ispeed=cfgetispeed(&t); - *ospeed=cfgetospeed(&t); - return result; -} + if (result != -1) { + memcpy(control_chars, t.c_cc, NCCS); + *iflag_hi8 =t.c_iflag >> 24; *iflag_lo24=t.c_iflag & 0xffffff; + *oflag_hi8 =t.c_oflag >> 24; *oflag_lo24=t.c_oflag & 0xffffff; + *cflag_hi8 =t.c_cflag >> 24; *cflag_lo24=t.c_cflag & 0xffffff; + *lflag_hi8 =t.c_lflag >> 24; *lflag_lo24=t.c_lflag & 0xffffff; + *ispeed=cfgetispeed(&t); + *ospeed=cfgetospeed(&t); + } -int scheme_tcsetattr(int fd, - int option, + return result; + } + + +int scheme_tcsetattr(int fd, int option, + char *control_chars, int iflag_hi8, int iflag_lo24, int oflag_hi8, int oflag_lo24, int cflag_hi8, int cflag_lo24, int lflag_hi8, int lflag_lo24, - char *control_chars, - int ispeed, int ospeed) + int ispeed, int ospeed, + int min, int time) { struct termios t; - memcpy(t.c_cc,control_chars,NCCS); + memcpy(t.c_cc, control_chars, NCCS); + t.c_cc[VMIN] = min; + t.c_cc[VTIME] = time; t.c_iflag = (iflag_hi8 << 24) | iflag_lo24; t.c_oflag = (oflag_hi8 << 24) | oflag_lo24; t.c_cflag = (cflag_hi8 << 24) | cflag_lo24; @@ -51,5 +56,5 @@ int scheme_tcsetattr(int fd, cfsetispeed(&t, ispeed); cfsetospeed(&t, ospeed); - return(tcsetattr(fd,option,&t)); + return tcsetattr(fd, option, &t); }