From 90d43117bf404e6f1d6e45ad35c7b990d422cdd2 Mon Sep 17 00:00:00 2001 From: shivers Date: Wed, 8 Sep 1999 15:20:26 +0000 Subject: [PATCH] Disgusting hackitude to work around mysterious S48 bug in C-calling system. --- scsh/tty.c | 12 +++++++++++ scsh/tty.scm | 58 +++++++++++++++++++++++++++++++++++++++++++++++++++- scsh/tty1.c | 24 ++++++++++++++++++++++ scsh/tty1.h | 2 ++ 4 files changed, 95 insertions(+), 1 deletion(-) diff --git a/scsh/tty.c b/scsh/tty.c index fc6e03a..293c25c 100644 --- a/scsh/tty.c +++ b/scsh/tty.c @@ -49,6 +49,18 @@ scheme_value df_scheme_tcgetattr(long nargs, scheme_value *args) return ret1; } +scheme_value df_scheme_tcgetattrB(long nargs, scheme_value *args) +{ + extern int scheme_tcgetattrB(int , char *, scheme_value ); + scheme_value ret1; + int r1; + + cig_check_nargs(3, nargs, "scheme_tcgetattrB"); + r1 = scheme_tcgetattrB(EXTRACT_FIXNUM(args[2]), cig_string_body(args[1]), args[0]); + ret1 = errno_or_false(r1); + return ret1; + } + scheme_value df_scheme_tcsetattr(long nargs, scheme_value *args) { extern int scheme_tcsetattr(int , int , const char *, int , int , int , int , int , int , int , int , int , int , int , int ); diff --git a/scsh/tty.scm b/scsh/tty.scm index 691a5c8..ae58571 100644 --- a/scsh/tty.scm +++ b/scsh/tty.scm @@ -122,8 +122,21 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Retrieve tty-info bits from a tty. Arg defaults to current input port. +;;; I don't understand why, but somehow returning 10 values from a +;;; define-foreign function seems to corrupt the stack. ??? See tty-bug +;;; for more details. As a workaround, we don't use %tty-info/errno. +;;; Instead, we have an alternate entry point, %bogus-tty-info/errno, +;;; which passes in a 10-elt vector into which the results are stored. +;;; Yech. I have no idea what has tickled this bug in S48 0.36. I hope +;;; if we port up to a modern S48, it'll go away. -Olin + +;;; Actually, I subsequently discovered that adding an extra, unused binding +;;; to the LET, cures the problem. So I backed out the really horrible code +;;; and did that. -Olin + (define (tty-info . maybe-tty) - (let ((control-chars (make-string num-ttychars))) + (let ((control-chars (make-string num-ttychars)) + (bogus #f)) (receive (iflag-hi8 iflag-lo24 oflag-hi8 oflag-lo24 cflag-hi8 cflag-lo24 lflag-hi8 lflag-lo24 ispeed-code ospeed-code) @@ -140,6 +153,27 @@ (char->ascii (string-ref control-chars ttychar/min)) (char->ascii (string-ref control-chars ttychar/time)))))) +;(define (tty-info . maybe-tty) +; (receive (iflag-hi8 iflag-lo24 oflag-hi8 oflag-lo24 +; cflag-hi8 cflag-lo24 lflag-hi8 lflag-lo24 +; ispeed-code ospeed-code control-chars) +; (sleazy-call/file (:optional maybe-tty (current-input-port)) +; call-with-input-file +; (lambda (fd) (%tty-info fd (make-string num-ttychars)))) +; (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) +; (decode-baud-rate ispeed-code) ispeed-code +; (decode-baud-rate ospeed-code) ospeed-code +; (char->ascii (string-ref control-chars ttychar/min)) +; (char->ascii (string-ref control-chars ttychar/time))))) + +;(define (%tty-info fdes cc) +; (receive (v1 v2 v3 v4 v5 v6 v7 v8 v9 v10) (%real-tty-info fdes cc) +; (values v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 cc))) + (define-errno-syscall (%tty-info fdes control-chars) %tty-info/errno iflag-hi8 iflag-lo24 oflag-hi8 oflag-lo24 @@ -157,6 +191,28 @@ integer integer integer integer) +(define-foreign %bogus-tty-info/errno + ("scheme_tcgetattrB" (integer fdes) + (var-string control-chars) + (vector-desc ivec)) + (to-scheme integer errno_or_false)) + +(define-errno-syscall (%bogus-tty-info fdes control-chars ivec) + %bogus-tty-info/errno) + +(define (%%bogus-tty-info fd control-chars) + (let ((ivec (make-vector 10))) + (%bogus-tty-info fd control-chars ivec) + ivec)) + +;(define (%tty-info fdes cc) +; (let ((ivec (%%bogus-tty-info fdes cc))) +; (values (vector-ref ivec 0) (vector-ref ivec 1) +; (vector-ref ivec 2) (vector-ref ivec 3) +; (vector-ref ivec 4) (vector-ref ivec 5) +; (vector-ref ivec 6) (vector-ref ivec 7) +; (vector-ref ivec 8) (vector-ref ivec 9) +; cc))) ;;; (set-tty-info tty option info) [Not exported] ;;; (set-tty-info/now tty option info) diff --git a/scsh/tty1.c b/scsh/tty1.c index 3deabec..4d67f5f 100644 --- a/scsh/tty1.c +++ b/scsh/tty1.c @@ -17,6 +17,7 @@ #include #include #include +#include "../scheme48.h" /* This #include is for the #ifdef'd code in open_ctty() below, and ** is therefor ifdef'd identically. @@ -52,6 +53,29 @@ int scheme_tcgetattr(int fd, char *control_chars, return result; } +int scheme_tcgetattrB(int fd, char *control_chars, scheme_value scmvec) +{ + struct termios t; + int result = tcgetattr(fd, &t); + int *ivec = ADDRESS_AFTER_HEADER(scmvec, int); + + if (result != -1) { + memcpy(control_chars, t.c_cc, NCCS); + ivec[0] = ENTER_FIXNUM(t.c_iflag >> 24); + ivec[1] = ENTER_FIXNUM(t.c_iflag & 0xffffff); + ivec[2] = ENTER_FIXNUM(t.c_oflag >> 24); + ivec[3] = ENTER_FIXNUM(t.c_oflag & 0xffffff); + ivec[4] = ENTER_FIXNUM(t.c_cflag >> 24); + ivec[5] = ENTER_FIXNUM(t.c_cflag & 0xffffff); + ivec[6] = ENTER_FIXNUM(t.c_lflag >> 24); + ivec[7] = ENTER_FIXNUM(t.c_lflag & 0xffffff); + ivec[8] = ENTER_FIXNUM(cfgetispeed(&t)); + ivec[9] = ENTER_FIXNUM(cfgetospeed(&t)); + } + + return result; + } + /*****************************************************************************/ diff --git a/scsh/tty1.h b/scsh/tty1.h index 3ea61f7..7f99d7a 100644 --- a/scsh/tty1.h +++ b/scsh/tty1.h @@ -7,6 +7,8 @@ int scheme_tcgetattr(int fd, char *control_chars, int *lflag_hi8, int *lflag_lo24, int *ispeed, int *ospeed); +int scheme_tcgetattrB(int fd, char *control_chars, scheme_value ivec); + int scheme_tcsetattr(int fd, int option, const char *control_chars, int iflag_hi8, int iflag_lo24,