X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Frun-program.lisp;h=ab9ebf72628f606d8827333338acf6377d277f70;hb=69d60b456b07a0256f08df0d02484f361ce5737c;hp=408b05088f2cc9745e1b741394da5a7954a1da7a;hpb=d334bb7db90f9f88b22cd4786083ba96d976ba33;p=sbcl.git

diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp
index 408b050..ab9ebf7 100644
--- a/src/code/run-program.lisp
+++ b/src/code/run-program.lisp
@@ -320,7 +320,8 @@
 	  (push new-fd *close-on-error*)
 	  (copy-descriptor-to-stream new-fd pty cookie)))
       (values name
-	      (sb-sys:make-fd-stream master :input t :output t)))))
+	      (sb-sys:make-fd-stream master :input t :output t 
+				     :dual-channel-p t)))))
 
 (defmacro round-bytes-to-words (n)
   `(logand (the fixnum (+ (the fixnum ,n) 3)) (lognot 3)))
@@ -331,7 +332,8 @@
   (let ((string-bytes 0)
 	;; We need an extra for the null, and an extra 'cause exect
 	;; clobbers argv[-1].
-	(vec-bytes (* #-alpha 4 #+alpha 8 (+ (length string-list) 2))))
+	(vec-bytes (* #.(/ sb-vm::n-machine-word-bits sb-vm::n-byte-bits)
+		      (+ (length string-list) 2))))
     (declare (fixnum string-bytes vec-bytes))
     (dolist (s string-list)
       (enforce-type s simple-string)
@@ -340,27 +342,28 @@
     (let* ((total-bytes (+ string-bytes vec-bytes))
 	   (vec-sap (sb-sys:allocate-system-memory total-bytes))
 	   (string-sap (sap+ vec-sap vec-bytes))
-	   (i #-alpha 4 #+alpha 8))
+	   (i #.(/ sb-vm::n-machine-word-bits sb-vm::n-byte-bits)))
       (declare (type (and unsigned-byte fixnum) total-bytes i)
 	       (type sb-sys:system-area-pointer vec-sap string-sap))
       (dolist (s string-list)
 	(declare (simple-string s))
 	(let ((n (length s)))
 	  ;; Blast the string into place.
-	  (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
-					 (* (1+ n) sb-vm:n-byte-bits))
+	  (sb-kernel:copy-ub8-to-system-area (the simple-base-string
+                                               ;; FIXME
+                                               (coerce s 'simple-base-string))
+                                             0
+                                             string-sap 0
+                                             (1+ n))
 	  ;; Blast the pointer to the string into place.
 	  (setf (sap-ref-sap vec-sap i) string-sap)
 	  (setf string-sap (sap+ string-sap (round-bytes-to-words (1+ n))))
-	  (incf i #-alpha 4 #+alpha 8)))
+	  (incf i #.(/ sb-vm::n-machine-word-bits sb-vm::n-byte-bits))))
       ;; Blast in the last null pointer.
       (setf (sap-ref-sap vec-sap i) (int-sap 0))
-      (values vec-sap (sap+ vec-sap #-alpha 4 #+alpha 8) total-bytes))))
+      (values vec-sap (sap+ vec-sap #.(/ sb-vm::n-machine-word-bits
+					 sb-vm::n-byte-bits))
+	      total-bytes))))
 
 (defmacro with-c-strvec ((var str-list) &body body)
   (with-unique-names (sap size)
@@ -663,11 +666,10 @@
                                      ~2I~_~A~:>"
 				 (strerror errno)))
 			       (t
-				(sb-kernel:copy-from-system-area
+				(sb-kernel:copy-ub8-from-system-area
 				 (alien-sap buf) 0
-				 string (* sb-vm:vector-data-offset
-					   sb-vm:n-word-bits)
-				 (* count sb-vm:n-byte-bits))
+				 string 0
+                                 count)
 				(write-string string stream
 					      :end count)))))))))))
 
@@ -753,7 +755,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)))))