No longer export baud-rate encodings.
This commit is contained in:
		
							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. | ||||
|  |  | |||
							
								
								
									
										52
									
								
								scsh/tty.scm
								
								
								
								
							
							
						
						
									
										52
									
								
								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)) | ||||
| 	(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
	
	 shivers
						shivers