X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Frun-program.lisp;h=f2dfe1075409dd8c9b0d0d675bd6d25c8de3404c;hb=dfe6138af5c38d92568b6dac48e852c01be0ec8e;hp=a04d1da2492f0b6aacf5430e6d1bcff64b3eb949;hpb=64a7331285b0eab2c216f52670763c7d192cfdaa;p=sbcl.git

diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp
index a04d1da..f2dfe10 100644
--- a/src/code/run-program.lisp
+++ b/src/code/run-program.lisp
@@ -124,10 +124,10 @@
 	     (values pid
 		     (if (position signal
 				   #.(vector
-				      (sb-unix:unix-signal-number :sigstop)
-				      (sb-unix:unix-signal-number :sigtstp)
-				      (sb-unix:unix-signal-number :sigttin)
-				      (sb-unix:unix-signal-number :sigttou)))
+				      sb-unix:sigstop
+				      sb-unix:sigtstp
+				      sb-unix:sigttin
+				      sb-unix:sigttou))
 			 :stopped
 			 :signaled)
 		     signal
@@ -212,7 +212,7 @@
 	   (sb-unix:unix-ioctl (sb-sys:fd-stream-fd (process-pty proc))
 			       sb-unix:TIOCSIGSEND
 			       (sb-sys:int-sap
-				(sb-unix:unix-signal-number signal))))
+				signal)))
 	  ((:process-group #-hpux :pty-process-group)
 	   (sb-unix:unix-killpg pid signal))
 	  (t
@@ -220,8 +220,7 @@
       (cond ((not okay)
 	     (values nil errno))
 	    ((and (eql pid (process-pid proc))
-		  (= (sb-unix:unix-signal-number signal)
-		     (sb-unix:unix-signal-number :sigcont)))
+		  (= signal sb-unix:sigcont))
 	     (setf (process-%status proc) :running)
 	     (setf (process-exit-code proc) nil)
 	     (when (process-status-hook proc)
@@ -290,12 +289,12 @@
 (defun find-a-pty ()
   (dolist (char '(#\p #\q))
     (dotimes (digit 16)
-      (let* ((master-name (format nil "/dev/pty~C~X" char digit))
+      (let* ((master-name (coerce (format nil "/dev/pty~C~X" char digit) 'base-string))
 	     (master-fd (sb-unix:unix-open master-name
 					   sb-unix:o_rdwr
 					   #o666)))
 	(when master-fd
-	  (let* ((slave-name (format nil "/dev/tty~C~X" char digit))
+	  (let* ((slave-name (coerce (format nil "/dev/tty~C~X" char digit) 'base-string))
 		 (slave-fd (sb-unix:unix-open slave-name
 					      sb-unix:o_rdwr
 					      #o666)))
@@ -348,7 +347,9 @@
 	(declare (simple-string s))
 	(let ((n (length s)))
 	  ;; Blast the string into place.
-	  (sb-kernel:copy-to-system-area (the simple-string s)
+	  (sb-kernel:copy-to-system-area (the simple-base-string
+                                           ;; FIXME
+                                           (coerce s 'simple-base-string))
 					 (* sb-vm:vector-data-offset
 					    sb-vm:n-word-bits)
 					 string-sap 0
@@ -383,6 +384,7 @@
 ;;; Is UNIX-FILENAME the name of a file that we can execute?
 (defun unix-filename-is-executable-p (unix-filename)
   (declare (type simple-string unix-filename))
+  (setf unix-filename (coerce unix-filename 'base-string))
   (values (and (eq (sb-unix:unix-file-kind unix-filename) :file)
 	       (sb-unix:unix-access unix-filename sb-unix:x_ok))))
 
@@ -395,11 +397,11 @@
 	while start
 	;; <Krystof> the truename of a file naming a directory is the
 	;; directory, at least until pfdietz comes along and says why
-	;; that's noncompliant
-	for fullpath = (merge-pathnames
-			pathname (truename
-				  (subseq search-path start end)))
-	when (unix-filename-is-executable-p (namestring fullpath))
+	;; that's noncompliant  -- CSR, c. 2003-08-10
+	for truename = (probe-file (subseq search-path start end))
+	for fullpath = (when truename (merge-pathnames pathname truename))
+	when (and fullpath
+		  (unix-filename-is-executable-p (namestring fullpath)))
 	return fullpath))
 
 ;;; FIXME: There shouldn't be two semiredundant versions of the
@@ -537,7 +539,7 @@
   (when (and env-p environment-p)
     (error "can't specify :ENV and :ENVIRONMENT simultaneously"))
   ;; Make sure that the interrupt handler is installed.
-  (sb-sys:enable-interrupt :sigchld #'sigchld-handler)
+  (sb-sys:enable-interrupt sb-unix:sigchld #'sigchld-handler)
   ;; Prepend the program to the argument list.
   (push (namestring program) args)
   (let (;; Clear various specials used by GET-DESCRIPTOR-FOR to
@@ -615,7 +617,7 @@
 ;;; stream.
 (defun copy-descriptor-to-stream (descriptor stream cookie)
   (incf (car cookie))
-  (let ((string (make-string 256))
+  (let ((string (make-string 256 :element-type 'base-char))
 	handler)
     (setf handler
 	  (sb-sys:add-fd-handler
@@ -684,7 +686,7 @@
 	 ;; Use /dev/null.
 	 (multiple-value-bind
 	       (fd errno)
-	     (sb-unix:unix-open "/dev/null"
+	     (sb-unix:unix-open #.(coerce "/dev/null" 'base-string)
 				(case direction
 				  (:input sb-unix:o_rdonly)
 				  (:output sb-unix:o_wronly)
@@ -736,7 +738,7 @@
 	    (dotimes (count
 		       256
 		      (error "could not open a temporary file in /tmp"))
-	      (let* ((name (format nil "/tmp/.run-program-~D" count))
+	      (let* ((name (coerce (format nil "/tmp/.run-program-~D" count) 'base-string))
 		     (fd (sb-unix:unix-open name
 					    (logior sb-unix:o_rdwr
 						    sb-unix:o_creat
@@ -751,7 +753,16 @@
 			    (read-line object nil nil)
 			  (unless line
 			    (return))
-			  (sb-unix:unix-write fd line 0 (length line))
+			  (sb-unix:unix-write
+                           fd
+                           ;; FIXME: this really should be
+                           ;; (STRING-TO-OCTETS :EXTERNAL-FORMAT ...).
+                           ;; RUN-PROGRAM should take an
+                           ;; external-format argument, which should
+                           ;; be passed down to here.  Something
+                           ;; similar should happen on :OUTPUT, too.
+                           (map '(vector (unsigned-byte 8)) #'char-code line)
+                           0 (length line))
 			  (if no-cr
 			      (return)
 			      (sb-unix:unix-write fd newline 0 1)))))