Disgusting hackitude to work around mysterious S48 bug in C-calling system.

This commit is contained in:
shivers 1999-09-08 15:20:26 +00:00
parent 64613d96db
commit 90d43117bf
4 changed files with 95 additions and 1 deletions

View File

@ -49,6 +49,18 @@ scheme_value df_scheme_tcgetattr(long nargs, scheme_value *args)
return ret1; 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) 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 ); extern int scheme_tcsetattr(int , int , const char *, int , int , int , int , int , int , int , int , int , int , int , int );

View File

@ -122,8 +122,21 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Retrieve tty-info bits from a tty. Arg defaults to current input port. ;;; 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) (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 (receive (iflag-hi8 iflag-lo24 oflag-hi8 oflag-lo24
cflag-hi8 cflag-lo24 lflag-hi8 lflag-lo24 cflag-hi8 cflag-lo24 lflag-hi8 lflag-lo24
ispeed-code ospeed-code) ispeed-code ospeed-code)
@ -140,6 +153,27 @@
(char->ascii (string-ref control-chars ttychar/min)) (char->ascii (string-ref control-chars ttychar/min))
(char->ascii (string-ref control-chars ttychar/time)))))) (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 (define-errno-syscall (%tty-info fdes control-chars) %tty-info/errno
iflag-hi8 iflag-lo24 iflag-hi8 iflag-lo24
oflag-hi8 oflag-lo24 oflag-hi8 oflag-lo24
@ -157,6 +191,28 @@
integer integer integer integer
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 tty option info) [Not exported]
;;; (set-tty-info/now tty option info) ;;; (set-tty-info/now tty option info)

View File

@ -17,6 +17,7 @@
#include <termios.h> #include <termios.h>
#include <string.h> #include <string.h>
#include <sys/types.h> #include <sys/types.h>
#include "../scheme48.h"
/* This #include is for the #ifdef'd code in open_ctty() below, and /* This #include is for the #ifdef'd code in open_ctty() below, and
** is therefor ifdef'd identically. ** is therefor ifdef'd identically.
@ -52,6 +53,29 @@ int scheme_tcgetattr(int fd, char *control_chars,
return result; 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;
}
/*****************************************************************************/ /*****************************************************************************/

View File

@ -7,6 +7,8 @@ int scheme_tcgetattr(int fd, char *control_chars,
int *lflag_hi8, int *lflag_lo24, int *lflag_hi8, int *lflag_lo24,
int *ispeed, int *ospeed); int *ispeed, int *ospeed);
int scheme_tcgetattrB(int fd, char *control_chars, scheme_value ivec);
int scheme_tcsetattr(int fd, int option, int scheme_tcsetattr(int fd, int option,
const char *control_chars, const char *control_chars,
int iflag_hi8, int iflag_lo24, int iflag_hi8, int iflag_lo24,