No longer export baud-rate encodings.
This commit is contained in:
shivers
parent
fd3c209841
commit
f83504cc00
|
|
@ -190,47 +190,17 @@
|
|||
(define ttyl/case-map #o4) ; xcase: canonical upper/lower presentation
|
||||
|
||||
|
||||
;;; 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/900 9) ; Non-standard
|
||||
(define baud/1200 10)
|
||||
(define baud/1800 11)
|
||||
(define baud/2400 12)
|
||||
(define baud/3600 13) ; Non-standard
|
||||
(define baud/4800 14)
|
||||
(define baud/7200 15) ; Non-standard
|
||||
(define baud/9600 16)
|
||||
(define baud/19200 17)
|
||||
(define baud/38400 18)
|
||||
(define baud/57600 19) ; Non-standard
|
||||
(define baud/115200 20) ; Non-standard
|
||||
(define baud/230400 21) ; Non-standard
|
||||
(define baud/460800 22) ; Non-standard
|
||||
(define baud/exta 30) ; Non-standard
|
||||
(define baud/extb 31) ; Non-standard
|
||||
;;; Vector of (speed . code) pairs.
|
||||
|
||||
;;; Rather cheesy mechanism here.
|
||||
;;; Vector of lists because some OS's define EXTA and EXTB to be
|
||||
;;; the same code as 19.2k and 38.4k baud.
|
||||
|
||||
(define baud-rates '#((0) (50) (75)
|
||||
(110) (134) (150)
|
||||
(200) (300) (600)
|
||||
(900) (1200) (1800)
|
||||
(2400) (3600) (4800)
|
||||
(7200) (9600) (19200)
|
||||
(38400) (57600) (115200)
|
||||
(230400) (460800) #f
|
||||
#f #f #f #f #f #f ; 24-29
|
||||
(exta) (extb)))
|
||||
(define baud-rates '#((0 . 0) (1 . 50) (2 . 75)
|
||||
(3 . 110) (4 . 134) (5 . 150)
|
||||
(6 . 200) (7 . 300) (8 . 600)
|
||||
(9 . 900) (10 . 1200) (11 . 1800)
|
||||
(12 . 2400) (13 . 3600) (14 . 4800)
|
||||
(15 . 7200) (16 . 9600) (17 . 19200)
|
||||
(18 . 38400) (19 . 57600) (20 . 115200)
|
||||
(21 . 230400) (22 . 460800) ; 23-29 unused.
|
||||
(30 . exta) (31 . extb)))
|
||||
|
||||
|
||||
;;; tcflush() constants
|
||||
|
|
|
|||
|
|
@ -902,12 +902,6 @@
|
|||
|
||||
;; SVR4
|
||||
ttyl/case-map ; xcase: canonical upper/lower presentation
|
||||
|
||||
;; Baud Rates
|
||||
baud/0 baud/50 baud/75 baud/110
|
||||
baud/134 baud/150 baud/200 baud/300
|
||||
baud/600 baud/1200 baud/1800 baud/2400
|
||||
baud/4800 baud/9600 baud/19200 baud/38400
|
||||
))
|
||||
|
||||
;;; Non-exported values required by the tty code.
|
||||
|
|
|
|||
68
scsh/tty.scm
68
scsh/tty.scm
|
|
@ -39,7 +39,9 @@
|
|||
control-flags
|
||||
local-flags
|
||||
input-speed
|
||||
input-speed-code
|
||||
output-speed
|
||||
output-speed-code
|
||||
min
|
||||
time
|
||||
((disclose info) '("tty-info")))
|
||||
|
|
@ -62,25 +64,38 @@
|
|||
(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 set-tty-info:time set-%tty-info:time)
|
||||
|
||||
;;; Encode the speeds at assignment time.
|
||||
(define (set-tty-info:input-speed info speed)
|
||||
(set-%tty-info:input-speed-code info (encode-baud-rate speed))
|
||||
(set-%tty-info:input-speed info speed))
|
||||
|
||||
(define (set-tty-info:output-speed info speed)
|
||||
(set-%tty-info:output-speed-code info (encode-baud-rate speed))
|
||||
(set-%tty-info:output-speed info speed))
|
||||
|
||||
|
||||
(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))
|
||||
iflags oflags cflags lflags
|
||||
ispeed (encode-baud-rate ispeed)
|
||||
ospeed (encode-baud-rate 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: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:input-speed-code info)
|
||||
(tty-info:output-speed info)
|
||||
(%tty-info:output-speed-code info)
|
||||
(tty-info:min info)
|
||||
(tty-info:time info)))
|
||||
|
||||
|
||||
;;; (tty-info fd/port)
|
||||
|
|
@ -91,14 +106,15 @@
|
|||
(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)
|
||||
ispeed-code ospeed-code)
|
||||
(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
|
||||
(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))))))
|
||||
|
||||
|
|
@ -107,7 +123,7 @@
|
|||
oflag-hi8 oflag-lo24
|
||||
cflag-hi8 cflag-lo24
|
||||
lflag-hi8 lflag-lo24
|
||||
ispeed ospeed)
|
||||
ispeed-code ospeed-code)
|
||||
|
||||
(define-foreign %tty-info/errno
|
||||
(scheme_tcgetattr (integer fdes)
|
||||
|
|
@ -133,8 +149,8 @@
|
|||
(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)))
|
||||
(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))
|
||||
|
|
@ -162,7 +178,7 @@
|
|||
oflag-hi8 oflag-lo24
|
||||
cflag-hi8 cflag-lo24
|
||||
lflag-hi8 lflag-lo24
|
||||
ispeed ospeed
|
||||
ispeed-code ospeed-code
|
||||
min time)
|
||||
%set-tty-info/errno)
|
||||
|
||||
|
|
@ -179,8 +195,8 @@
|
|||
(integer cflag-lo24)
|
||||
(integer lflag-hi8)
|
||||
(integer lflag-lo24)
|
||||
(integer ispeed)
|
||||
(integer ospeed)
|
||||
(integer ispeed-code)
|
||||
(integer ospeed-code)
|
||||
(integer min)
|
||||
(integer time))
|
||||
(to-scheme integer errno_or_false))
|
||||
|
|
@ -271,16 +287,20 @@
|
|||
|
||||
;;; Baud rate translation
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; We should just move these guys out to the tty-consts file.
|
||||
;;; We currently search a vector of (code . speed) pairs.
|
||||
|
||||
(define (encode-baud-rate speed) ; 9600 -> value of BAUD/9600
|
||||
(do ((i (- (vector-length baud-rates) 1) (- i 1)))
|
||||
((let ((entry (vector-ref baud-rates i)))
|
||||
(and (pair? entry) (memv speed entry)))
|
||||
i)
|
||||
((eqv? (cdr (vector-ref baud-rates i)) speed)
|
||||
(car (vector-ref baud-rates i)))
|
||||
(if (< i 0) (error "Unknown baud rate." speed))))
|
||||
|
||||
(define (decode-baud-rate code) ; value of BAUD/9600 -> 9600
|
||||
(car (vector-ref baud-rates code)))
|
||||
(define (decode-baud-rate code) ; BAUD/9600 -> 9600
|
||||
(do ((i (- (vector-length baud-rates) 1) (- i 1)))
|
||||
((eqv? (car (vector-ref baud-rates i)) code)
|
||||
(cdr (vector-ref baud-rates i)))
|
||||
(if (< i 0) (error "Unknown baud rate code." code))))
|
||||
|
||||
|
||||
;;; Set/Get tty process group
|
||||
|
|
|
|||
Loading…
Reference in New Issue