No longer export baud-rate encodings.

scsh/hpux/tty-consts.scm

@@ -190,47 +190,17 @@
 (define ttyl/case-map #o4)	; xcase: canonical upper/lower presentation
 
 
-;;; Baud Rates
+;;; Vector of (speed . code) pairs.
-(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
 
-;;; Rather cheesy mechanism here.
+(define baud-rates '#((0  . 0)		(1  . 50)	(2  .    75)
-;;; Vector of lists because some OS's define EXTA and EXTB to be
+		      (3  . 110)	(4  . 134)	(5  .   150)
-;;; the same code as 19.2k and 38.4k baud.
+		      (6  . 200)	(7  . 300)	(8  .   600)
-
+		      (9  . 900)	(10 . 1200)	(11 .  1800)
-(define baud-rates '#((0)		(50)		(75)
+		      (12 . 2400)	(13 . 3600)	(14 .  4800)
-		      (110)		(134)		(150)
+		      (15 . 7200)	(16 . 9600)	(17 .  19200)
-		      (200)		(300)		(600)
+		      (18 . 38400)	(19 . 57600)	(20 . 115200)
-		      (900)		(1200)		(1800)
+		      (21 . 230400)	(22 . 460800)   ; 23-29 unused.
-		      (2400)		(3600)		(4800)
+		      (30 . exta)	(31 . extb)))
-		      (7200)		(9600)		(19200)
-		      (38400)		(57600)		(115200)
-		      (230400)		(460800)	#f
-		      #f #f		#f #f		#f #f ; 24-29
-		      (exta)		(extb)))
 
 
 ;;; tcflush() constants

scsh/scsh-interfaces.scm

@@ -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.

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,14 +64,25 @@
 (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))
@@ -78,7 +91,9 @@
 		  (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)))
 		  
@@ -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))
+	(is (%tty-info:input-speed-code  info))
-	(os (tty-info:output-speed  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 ispeed-code) 
-		    (integer ospeed)
+		    (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)))
+      ((eqv? (cdr (vector-ref baud-rates i)) speed)
-	 (and (pair? entry) (memv speed entry)))
+       (car (vector-ref baud-rates i)))
-       i)
     (if (< i 0) (error "Unknown baud rate." speed))))
 
-(define (decode-baud-rate code)		; value of BAUD/9600 -> 9600
+(define (decode-baud-rate code)		; BAUD/9600 -> 9600
-  (car (vector-ref baud-rates code)))
+  (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