[Sbcl-commits] CVS: sbcl/src/code run-program.lisp,1.29,1.29.6.1 target-thread.lisp,1.1.2.8,1.1.2.9

[Daniel B. <da...@us...>]

Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs1:/tmp/cvs-serv19926/src/code

Modified Files:
      Tag: dan_native_threads_branch
	run-program.lisp target-thread.lisp 
Log Message:
"0.7.9.54.thread.16"
	#+angels-fear-to-thread

	Shortened RUN-PROGRAM considerably: it now does tty mode
	setting in C, using Posix calls, instead of in Lisp using 
	old BSD sgtty stuff.

	Introduce (MAKE-LISTENER-THREAD "/path/to/tty"): new function
	that runs a listener in a thread on the given tty

	Fix race condition in thread startup that was causing 
	occasional GC assertions

	Minor loss of debugging printfs (not serious)

	[To test the listener stuff, you need to give it the name of a
	tty that is (a) open, readable, writable, (b) not actively
	being read by any other process that may confuse things.
	
	:; cat ./src/runtime/nop.sh 
	#!/bin/sh
	echo "tty is `tty`"
	while : ; do sleep 3600; done    
	:; sh ./src/runtime/nop.sh 
	tty is /dev/pts/2
	
	* (make-listener-thread "/dev/pts/2")

	]




Index: run-program.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/run-program.lisp,v
retrieving revision 1.29
retrieving revision 1.29.6.1
diff -u -d -r1.29 -r1.29.6.1
--- run-program.lisp	23 Jul 2002 17:22:36 -0000	1.29
+++ run-program.lisp	17 Jan 2003 03:30:31 -0000	1.29.6.1
@@ -284,21 +284,6 @@
 ;;; list of handlers installed by RUN-PROGRAM
 (defvar *handlers-installed* nil)
 
-#+FreeBSD
-(define-alien-type nil
-  (struct sgttyb
-	  (sg-ispeed sb-alien:char)	; input speed
-	  (sg-ospeed sb-alien:char)	; output speed
-	  (sg-erase sb-alien:char)	; erase character
-	  (sg-kill sb-alien:char)	; kill character
-	  (sg-flags sb-alien:short)))	; mode flags
-#+OpenBSD
-(define-alien-type nil
-  (struct sgttyb
-	  (sg-four sb-alien:int)
-	  (sg-chars (array sb-alien:char 4))
-	  (sg-flags sb-alien:int)))
-
 ;;; Find an unused pty. Return three values: the file descriptor for
 ;;; the master side of the pty, the file descriptor for the slave side
 ;;; of the pty, and the name of the tty device for the slave side.
@@ -315,34 +300,6 @@
 					      sb-unix:o_rdwr
 					      #o666)))
 	    (when slave-fd
-	      ;; comment from classic CMU CL:
-	      ;;   Maybe put a vhangup here?
-	      ;;
-	      ;; FIXME: It seems as though this logic should be in
-	      ;; OPEN-PTY, not FIND-A-PTY (both from the comments
-	      ;; documenting DEFUN FIND-A-PTY, and from the
-	      ;; connotations of the function names).
-	      ;;
-	      ;; FIXME: It would be nice to have a note, and/or a pointer
-	      ;; to some reference material somewhere, explaining
-	      ;; why we need this on *BSD and not on Linux.
-              #+bsd
-	      (sb-alien:with-alien ((stuff (sb-alien:struct sgttyb)))
-		(let ((sap (sb-alien:alien-sap stuff)))
-		  (sb-unix:unix-ioctl slave-fd sb-unix:TIOCGETP sap)
-		  (setf (sb-alien:slot stuff 'sg-flags)
-			;; This is EVENP|ODDP, the same numeric code
-			;; both on FreeBSD and on OpenBSD. -- WHN 20000929
-			#o300) ; EVENP|ODDP
-		  (sb-unix:unix-ioctl slave-fd sb-unix:TIOCSETP sap)
-		  (sb-unix:unix-ioctl master-fd sb-unix:TIOCGETP sap)
-		  (setf (sb-alien:slot stuff 'sg-flags)
-			(logand (sb-alien:slot stuff 'sg-flags)
-				;; This is ~ECHO, the same numeric
-				;; code both on FreeBSD and on OpenBSD.
-				;; -- WHN 20000929
-				(lognot 8))) ; ~ECHO
-		  (sb-unix:unix-ioctl master-fd sb-unix:TIOCSETP sap)))
 	      (return-from find-a-pty
 		(values master-fd
 			slave-fd

Index: target-thread.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/Attic/target-thread.lisp,v
retrieving revision 1.1.2.8
retrieving revision 1.1.2.9
diff -u -d -r1.1.2.8 -r1.1.2.9
--- target-thread.lisp	16 Jan 2003 17:15:20 -0000	1.1.2.8
+++ target-thread.lisp	17 Jan 2003 03:30:31 -0000	1.1.2.9
@@ -15,6 +15,33 @@
 (make-thread #'thread-nnop)
 |#
 
+(defun make-listener-thread (tty-name)
+  (assert (probe-file tty-name))
+  (let* ((in (sb!unix:unix-open (namestring tty-name) sb!unix:o_rdwr #o666))
+	 (out (sb!unix:unix-dup in))
+	 (err (sb!unix:unix-dup in))
+	 (sb!impl::*stdin* 
+	  (sb!sys:make-fd-stream in :input t :buffering :line))
+	 (sb!impl::*stdout* 
+	  (sb!sys:make-fd-stream out :output t :buffering :line))
+	 (sb!impl::*stderr* 
+	  (sb!sys:make-fd-stream err :output t :buffering :line))
+	 (sb!impl::*tty* 
+	  (sb!sys:make-fd-stream err :input t :output t :buffering :line)))
+    (labels ((thread-repl () 
+	       (with-simple-restart 
+		   (destroy-thread
+		    (format nil "~~@<Destroy this thread (~A)~~@:>"
+			    SB!VM::*CURRENT-THREAD*))
+		 (sb!impl::toplevel-repl nil))))
+      (make-thread #'thread-repl))))
+
+#|
+(make-listener-thread "/dev/pts/6")
+
+
+|#
+
 ;;;; mutex and read/write locks, originally inspired by CMUCL multi-proc.lisp
 
 (defun sleep-a-bit (timeout)