0.9.0.14:

[sbcl.git] / src / code / run-program.lisp

diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp
index 408b050..25c31c2 100644 (file)
--- a/src/code/run-program.lisp
+++ b/src/code/run-program.lisp
@@ -331,7 +331,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 +341,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 +665,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 +754,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)))))