projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
1.0.1.16:
[sbcl.git]
/
src
/
code
/
run-program.lisp
diff --git
a/src/code/run-program.lisp
b/src/code/run-program.lisp
index
cafb1de
..
ea4fe4c
100644
(file)
--- a/
src/code/run-program.lisp
+++ b/
src/code/run-program.lisp
@@
-459,7
+459,9
@@
status slot."
:dual-channel-p t)))))
(defmacro round-bytes-to-words (n)
:dual-channel-p t)))))
(defmacro round-bytes-to-words (n)
- `(logand (the fixnum (+ (the fixnum ,n) 3)) (lognot 3)))
+ (let ((bytes-per-word (/ sb-vm:n-machine-word-bits sb-vm:n-byte-bits)))
+ `(logandc2 (the fixnum (+ (the fixnum ,n)
+ (1- ,bytes-per-word))) (1- ,bytes-per-word))))
(defun string-list-to-c-strvec (string-list)
;; Make a pass over STRING-LIST to calculate the amount of memory
(defun string-list-to-c-strvec (string-list)
;; Make a pass over STRING-LIST to calculate the amount of memory
@@
-467,7
+469,7
@@
status slot."
(let ((string-bytes 0)
;; We need an extra for the null, and an extra 'cause exect
;; clobbers argv[-1].
(let ((string-bytes 0)
;; We need an extra for the null, and an extra 'cause exect
;; clobbers argv[-1].
- (vec-bytes (* #.(/ sb-vm::n-machine-word-bits sb-vm::n-byte-bits)
+ (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)
(+ (length string-list) 2))))
(declare (fixnum string-bytes vec-bytes))
(dolist (s string-list)
@@
-477,7
+479,7
@@
status slot."
(let* ((total-bytes (+ string-bytes vec-bytes))
(vec-sap (sb-sys:allocate-system-memory total-bytes))
(string-sap (sap+ vec-sap vec-bytes))
(let* ((total-bytes (+ string-bytes vec-bytes))
(vec-sap (sb-sys:allocate-system-memory total-bytes))
(string-sap (sap+ vec-sap vec-bytes))
- (i #.(/ sb-vm::n-machine-word-bits sb-vm::n-byte-bits)))
+ (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 (type (and unsigned-byte fixnum) total-bytes i)
(type sb-sys:system-area-pointer vec-sap string-sap))
(dolist (s string-list)
@@
-493,11
+495,11
@@
status slot."
;; 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))))
;; 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 #.(/ sb-vm::n-machine-word-bits sb-vm::n-byte-bits))))
+ (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))
;; Blast in the last null pointer.
(setf (sap-ref-sap vec-sap i) (int-sap 0))
- (values vec-sap (sap+ vec-sap #.(/ sb-vm::n-machine-word-bits
- sb-vm::n-byte-bits))
+ (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)
total-bytes))))
(defmacro with-c-strvec ((var str-list) &body body)
@@
-845,12
+847,9
@@
Common Lisp Users Manual for details about the PROCESS structure.
(coerce
;; Apparently any spaces or double quotes in the arguments
;; need to be escaped on win32.
(coerce
;; Apparently any spaces or double quotes in the arguments
;; need to be escaped on win32.
- #+win32
(if (position-if (lambda (c) (find c '(#\" #\Space))) x)
(write-to-string x)
x)
(if (position-if (lambda (c) (find c '(#\" #\Space))) x)
(write-to-string x)
x)
- #-win32
- x
'simple-string))
args)))
(unwind-protect
'simple-string))
args)))
(unwind-protect
@@
-882,7
+881,7
@@
Common Lisp Users Manual for details about the PROCESS structure.
(spawn pfile args-vec
stdin stdout stderr
(if wait 1 0)))))
(spawn pfile args-vec
stdin stdout stderr
(if wait 1 0)))))
- (when (< handle 0)
+ (when (= handle -1)
(error "Couldn't spawn program: ~A" (strerror)))
(setf proc
(if wait
(error "Couldn't spawn program: ~A" (strerror)))
(setf proc
(if wait