removed all hi8/lo24 hacks and replaced many integer types by fixnums. This has not been tested !
This commit is contained in:
parent
d6c8c400c6
commit
41c9c192b5
40
scsh/tty.c
40
scsh/tty.c
|
@ -21,7 +21,7 @@ extern int errno;
|
|||
#define errno_on_zero_or_false(x) ((x) ? S48_FALSE : s48_enter_fixnum(errno))
|
||||
s48_value df_scheme_tcgetattr(s48_value g1, s48_value g2, s48_value mv_vec)
|
||||
{
|
||||
extern int scheme_tcgetattr(int , char *, int *, int *, int *, int *, int *, int *, int *, int *, int *, int *);
|
||||
extern int scheme_tcgetattr(int , char *, int *, int *, int *, int *, int *, int *);
|
||||
s48_value ret1;
|
||||
int r1;
|
||||
int r2;
|
||||
|
@ -30,24 +30,16 @@ s48_value df_scheme_tcgetattr(s48_value g1, s48_value g2, s48_value mv_vec)
|
|||
int r5;
|
||||
int r6;
|
||||
int r7;
|
||||
int r8;
|
||||
int r9;
|
||||
int r10;
|
||||
int r11;
|
||||
|
||||
|
||||
r1 = scheme_tcgetattr(s48_extract_fixnum(g1), s48_extract_string(g2), &r2, &r3, &r4, &r5, &r6, &r7, &r8, &r9, &r10, &r11);
|
||||
r1 = scheme_tcgetattr(s48_extract_fixnum(g1), s48_extract_string(g2), &r2, &r3, &r4, &r5, &r6, &r7);
|
||||
ret1 = errno_or_false(r1);
|
||||
S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r2));
|
||||
S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r3));
|
||||
S48_VECTOR_SET(mv_vec,2,s48_enter_fixnum(r4));
|
||||
S48_VECTOR_SET(mv_vec,3,s48_enter_fixnum(r5));
|
||||
S48_VECTOR_SET(mv_vec,0,s48_enter_integer(r2));
|
||||
S48_VECTOR_SET(mv_vec,1,s48_enter_integer(r3));
|
||||
S48_VECTOR_SET(mv_vec,2,s48_enter_integer(r4));
|
||||
S48_VECTOR_SET(mv_vec,3,s48_enter_integer(r5));
|
||||
S48_VECTOR_SET(mv_vec,4,s48_enter_fixnum(r6));
|
||||
S48_VECTOR_SET(mv_vec,5,s48_enter_fixnum(r7));
|
||||
S48_VECTOR_SET(mv_vec,6,s48_enter_fixnum(r8));
|
||||
S48_VECTOR_SET(mv_vec,7,s48_enter_fixnum(r9));
|
||||
S48_VECTOR_SET(mv_vec,8,s48_enter_fixnum(r10));
|
||||
S48_VECTOR_SET(mv_vec,9,s48_enter_fixnum(r11));
|
||||
return ret1;
|
||||
}
|
||||
|
||||
|
@ -63,14 +55,14 @@ s48_value df_scheme_tcgetattrB(s48_value g1, s48_value g2, s48_value g3)
|
|||
return ret1;
|
||||
}
|
||||
|
||||
s48_value df_scheme_tcsetattr(s48_value g1, s48_value g2, s48_value g3, s48_value g4, s48_value g5, s48_value g6, s48_value g7, s48_value g8, s48_value g9, s48_value g10, s48_value g11, s48_value g12, s48_value g13, s48_value g14, s48_value g15)
|
||||
s48_value df_scheme_tcsetattr(s48_value g1, s48_value g2, s48_value g3, s48_value g4, s48_value g5, s48_value g6, s48_value g7, s48_value g8, s48_value g9, s48_value g10, s48_value g11)
|
||||
{
|
||||
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 );
|
||||
s48_value ret1;
|
||||
int r1;
|
||||
|
||||
|
||||
r1 = scheme_tcsetattr(s48_extract_fixnum(g1), s48_extract_fixnum(g2), s48_extract_string(g3), s48_extract_fixnum(g4), s48_extract_fixnum(g5), s48_extract_fixnum(g6), s48_extract_fixnum(g7), s48_extract_fixnum(g8), s48_extract_fixnum(g9), s48_extract_fixnum(g10), s48_extract_fixnum(g11), s48_extract_fixnum(g12), s48_extract_fixnum(g13), s48_extract_fixnum(g14), s48_extract_fixnum(g15));
|
||||
r1 = scheme_tcsetattr(s48_extract_fixnum(g1), s48_extract_fixnum(g2), s48_extract_string(g3), s48_extract_integer(g4), s48_extract_integer(g5), s48_extract_integer(g6), s48_extract_integer(g7), s48_extract_fixnum(g8), s48_extract_fixnum(g9), s48_extract_fixnum(g10), s48_extract_fixnum(g11));
|
||||
ret1 = errno_or_false(r1);
|
||||
return ret1;
|
||||
}
|
||||
|
@ -82,7 +74,7 @@ s48_value df_tcsendbreak(s48_value g1, s48_value g2)
|
|||
int r1;
|
||||
|
||||
|
||||
r1 = tcsendbreak(s48_extract_fixnum(g1), s48_extract_fixnum(g2));
|
||||
r1 = tcsendbreak(s48_extract_integer(g1), s48_extract_integer(g2));
|
||||
ret1 = errno_or_false(r1);
|
||||
return ret1;
|
||||
}
|
||||
|
@ -94,7 +86,7 @@ s48_value df_tcdrain(s48_value g1)
|
|||
int r1;
|
||||
|
||||
|
||||
r1 = tcdrain(s48_extract_fixnum(g1));
|
||||
r1 = tcdrain(s48_extract_integer(g1));
|
||||
ret1 = errno_or_false(r1);
|
||||
return ret1;
|
||||
}
|
||||
|
@ -106,7 +98,7 @@ s48_value df_tcflush(s48_value g1, s48_value g2)
|
|||
int r1;
|
||||
|
||||
|
||||
r1 = tcflush(s48_extract_fixnum(g1), s48_extract_fixnum(g2));
|
||||
r1 = tcflush(s48_extract_integer(g1), s48_extract_integer(g2));
|
||||
ret1 = errno_or_false(r1);
|
||||
return ret1;
|
||||
}
|
||||
|
@ -118,7 +110,7 @@ s48_value df_tcflow(s48_value g1, s48_value g2)
|
|||
int r1;
|
||||
|
||||
|
||||
r1 = tcflow(s48_extract_fixnum(g1), s48_extract_fixnum(g2));
|
||||
r1 = tcflow(s48_extract_integer(g1), s48_extract_integer(g2));
|
||||
ret1 = errno_or_false(r1);
|
||||
return ret1;
|
||||
}
|
||||
|
@ -157,7 +149,7 @@ s48_value df_open_ctty(s48_value g1, s48_value g2, s48_value mv_vec)
|
|||
|
||||
r1 = open_ctty(s48_extract_string(g1), s48_extract_fixnum(g2));
|
||||
ret1 = errno_or_false(r1);
|
||||
S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r1));
|
||||
S48_VECTOR_SET(mv_vec,0,s48_enter_integer(r1));
|
||||
return ret1;
|
||||
}
|
||||
|
||||
|
@ -168,7 +160,7 @@ s48_value df_isatty(s48_value g1)
|
|||
int r1;
|
||||
|
||||
|
||||
r1 = isatty(s48_extract_fixnum(g1));
|
||||
r1 = isatty(s48_extract_integer(g1));
|
||||
ret1 = ENTER_BOOLEAN(r1);
|
||||
return ret1;
|
||||
}
|
||||
|
@ -180,7 +172,7 @@ s48_value df_ttyname(s48_value g1, s48_value mv_vec)
|
|||
char *r1;
|
||||
|
||||
|
||||
r1 = ttyname(s48_extract_fixnum(g1));
|
||||
r1 = ttyname(s48_extract_integer(g1));
|
||||
ret1 = errno_on_zero_or_false(r1);
|
||||
SetAlienVal(S48_CAR(S48_VECTOR_REF(mv_vec,0)),(long) r1); S48_SET_CDR(S48_VECTOR_REF(mv_vec,0),strlen_or_false(r1));//str-and-len
|
||||
return ret1;
|
||||
|
|
105
scsh/tty.scm
105
scsh/tty.scm
|
@ -127,48 +127,48 @@
|
|||
|
||||
(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
|
||||
(receive (iflag oflag
|
||||
cflag lflag
|
||||
ispeed-code ospeed-code)
|
||||
(sleazy-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)
|
||||
iflag
|
||||
oflag
|
||||
cflag
|
||||
lflag
|
||||
(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-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
|
||||
iflag
|
||||
oflag
|
||||
cflag
|
||||
lflag
|
||||
ispeed-code ospeed-code)
|
||||
|
||||
(define-foreign %tty-info/errno
|
||||
(scheme_tcgetattr (integer fdes)
|
||||
(scheme_tcgetattr (fixnum fdes)
|
||||
(var-string control-chars))
|
||||
(to-scheme integer errno_or_false)
|
||||
integer integer
|
||||
integer integer
|
||||
integer integer
|
||||
integer integer
|
||||
integer integer)
|
||||
(to-scheme fixnum errno_or_false)
|
||||
integer
|
||||
integer
|
||||
integer
|
||||
integer
|
||||
fixnum fixnum)
|
||||
|
||||
(define-foreign %bogus-tty-info/errno
|
||||
("scheme_tcgetattrB" (integer fdes)
|
||||
("scheme_tcgetattrB" (fixnum fdes)
|
||||
(var-string control-chars)
|
||||
(vector-desc ivec))
|
||||
(to-scheme integer errno_or_false))
|
||||
(to-scheme fixnum 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)))
|
||||
(let ((ivec (make-vector 6)))
|
||||
(%bogus-tty-info fd control-chars ivec)
|
||||
ivec))
|
||||
|
||||
|
@ -196,55 +196,44 @@
|
|||
(cc (tty-info:control-chars info))
|
||||
(is (%tty-info:input-speed-code info))
|
||||
(os (%tty-info:output-speed-code 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)))
|
||||
(sleazy-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)))))))
|
||||
(sleazy-call/fdes
|
||||
fdport
|
||||
(lambda (fd)
|
||||
(%set-tty-info fd option
|
||||
cc
|
||||
if
|
||||
of
|
||||
cf
|
||||
lf
|
||||
is os
|
||||
(tty-info:min info)
|
||||
(tty-info:time info))))))
|
||||
|
||||
|
||||
(define-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
|
||||
iflag
|
||||
oflag
|
||||
cflag
|
||||
lflag
|
||||
ispeed-code ospeed-code
|
||||
min time)
|
||||
%set-tty-info/errno)
|
||||
|
||||
|
||||
(define-foreign %set-tty-info/errno
|
||||
(scheme_tcsetattr (integer fdes)
|
||||
(integer option)
|
||||
(scheme_tcsetattr (fixnum fdes)
|
||||
(fixnum 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-code)
|
||||
(integer ospeed-code)
|
||||
(integer min)
|
||||
(integer time))
|
||||
(to-scheme integer errno_or_false))
|
||||
(integer iflag)
|
||||
(integer oflag)
|
||||
(integer cflag)
|
||||
(integer lflag)
|
||||
(fixnum ispeed-code)
|
||||
(fixnum ospeed-code)
|
||||
(fixnum min)
|
||||
(fixnum time))
|
||||
(to-scheme fixnum errno_or_false))
|
||||
|
||||
|
||||
;;; Exported procs
|
||||
|
|
48
scsh/tty1.c
48
scsh/tty1.c
|
@ -32,10 +32,10 @@ extern int errno;
|
|||
/*****************************************************************************/
|
||||
|
||||
int scheme_tcgetattr(int fd, 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,
|
||||
int *iflag,
|
||||
int *oflag,
|
||||
int *cflag,
|
||||
int *lflag,
|
||||
int *ispeed, int *ospeed)
|
||||
{
|
||||
struct termios t;
|
||||
|
@ -43,10 +43,10 @@ int scheme_tcgetattr(int fd, char *control_chars,
|
|||
|
||||
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;
|
||||
*iflag =t.c_iflag;
|
||||
*oflag =t.c_oflag;
|
||||
*cflag =t.c_cflag;
|
||||
*lflag =t.c_lflag;
|
||||
*ispeed=cfgetispeed(&t);
|
||||
*ospeed=cfgetospeed(&t);
|
||||
}
|
||||
|
@ -62,16 +62,12 @@ int scheme_tcgetattrB(int fd, char *control_chars, s48_value scmvec)
|
|||
|
||||
if (result != -1) {
|
||||
memcpy(control_chars, t.c_cc, NCCS);
|
||||
S48_VECTOR_SET(scmvec, 0, s48_enter_fixnum(t.c_iflag >> 24));
|
||||
S48_VECTOR_SET(scmvec, 1, s48_enter_fixnum(t.c_iflag & 0xffffff));
|
||||
S48_VECTOR_SET(scmvec, 2, s48_enter_fixnum(t.c_oflag >> 24));
|
||||
S48_VECTOR_SET(scmvec, 3, s48_enter_fixnum(t.c_oflag & 0xffffff));
|
||||
S48_VECTOR_SET(scmvec, 4, s48_enter_fixnum(t.c_cflag >> 24));
|
||||
S48_VECTOR_SET(scmvec, 5, s48_enter_fixnum(t.c_cflag & 0xffffff));
|
||||
S48_VECTOR_SET(scmvec, 6, s48_enter_fixnum(t.c_lflag >> 24));
|
||||
S48_VECTOR_SET(scmvec, 7, s48_enter_fixnum(t.c_lflag & 0xffffff));
|
||||
S48_VECTOR_SET(scmvec, 8, s48_enter_fixnum(cfgetispeed(&t)));
|
||||
S48_VECTOR_SET(scmvec, 9, s48_enter_fixnum(cfgetospeed(&t)));
|
||||
S48_VECTOR_SET(scmvec, 0, s48_enter_integer(t.c_iflag));
|
||||
S48_VECTOR_SET(scmvec, 1, s48_enter_integer(t.c_oflag));
|
||||
S48_VECTOR_SET(scmvec, 2, s48_enter_integer(t.c_cflag));
|
||||
S48_VECTOR_SET(scmvec, 3, s48_enter_integer(t.c_lflag));
|
||||
S48_VECTOR_SET(scmvec, 4, s48_enter_fixnum(cfgetispeed(&t)));
|
||||
S48_VECTOR_SET(scmvec, 5, s48_enter_fixnum(cfgetospeed(&t)));
|
||||
}
|
||||
|
||||
return result;
|
||||
|
@ -82,10 +78,10 @@ int scheme_tcgetattrB(int fd, char *control_chars, s48_value scmvec)
|
|||
|
||||
int scheme_tcsetattr(int fd, int option,
|
||||
const 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,
|
||||
int iflag,
|
||||
int oflag,
|
||||
int cflag,
|
||||
int lflag,
|
||||
int ispeed, int ospeed,
|
||||
int min, int time)
|
||||
{
|
||||
|
@ -105,10 +101,10 @@ int scheme_tcsetattr(int fd, int option,
|
|||
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;
|
||||
t.c_lflag = (lflag_hi8 << 24) | lflag_lo24;
|
||||
t.c_iflag = iflag;
|
||||
t.c_oflag = oflag;
|
||||
t.c_cflag = cflag;
|
||||
t.c_lflag = lflag;
|
||||
|
||||
cfsetispeed(&t, ispeed);
|
||||
cfsetospeed(&t, ospeed);
|
||||
|
|
16
scsh/tty1.h
16
scsh/tty1.h
|
@ -1,18 +1,18 @@
|
|||
/* Exports from tty1.c. */
|
||||
|
||||
int scheme_tcgetattr(int fd, 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,
|
||||
int *iflag,
|
||||
int *oflag,
|
||||
int *cflag,
|
||||
int *lflag,
|
||||
int *ispeed, int *ospeed);
|
||||
|
||||
int scheme_tcsetattr(int fd, int option,
|
||||
const 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,
|
||||
int iflag,
|
||||
int oflag,
|
||||
int cflag,
|
||||
int lflag,
|
||||
int ispeed, int ospeed,
|
||||
int min, int time);
|
||||
|
||||
|
|
Loading…
Reference in New Issue