From b76e5fdf19ce4ab1c6983e6f4b301196484eecc2 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Sun, 9 Dec 2007 18:11:51 +0000 Subject: [PATCH] 1.0.12.21: using default external format for RUN-PROGRAM args and env * Patch by Harald Hanche-Olsen: use STRING-TO-OCTETS to build the vector of string pointers. Also allows non-simple strings. --- NEWS | 3 ++ src/code/run-program.lisp | 95 +++++++++++++++++++++++------------------------ tests/run-program.test.sh | 22 ++++++++++- version.lisp-expr | 2 +- 4 files changed, 71 insertions(+), 51 deletions(-) diff --git a/NEWS b/NEWS index 28cef496a..f2699ca7d 100644 --- a/NEWS +++ b/NEWS @@ -4,6 +4,9 @@ changes in sbcl-1.0.13 relative to sbcl-1.0.12: unparsing of directory pathnames as files. Analogously, SB-EXT:PARSE-NATIVE-NAMESTRING takes an AS-DIRECTORY, forcing a filename to parse into a directory pathname. + * enhancement: RUN-PROGRAM allows unicode arguments and environments + to be used (using the default stream external format), and allows + non-simple strings to be used. (thanks to Harald Hanche-Olsen) * optimizations: COPY-SEQ, FILL, and SUBSEQ are 30-80% faster for strings and vectors whose element-type or simplicity is not fully known at compile-time. diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp index 5c4f9fc22..3c6cf2b66 100644 --- a/src/code/run-program.lisp +++ b/src/code/run-program.lisp @@ -67,7 +67,7 @@ (defun unix-environment-cmucl-from-sbcl (sbcl) (mapcan (lambda (string) - (declare (type simple-base-string string)) + (declare (string string)) (let ((=-pos (position #\= string :test #'equal))) (if =-pos (list @@ -90,8 +90,8 @@ (mapcar (lambda (cons) (destructuring-bind (key . val) cons - (declare (type keyword key) (type simple-base-string val)) - (concatenate 'simple-base-string (symbol-name key) "=" val))) + (declare (type keyword key) (string val)) + (concatenate 'simple-string (symbol-name key) "=" val))) cmucl)) ;;;; Import wait3(2) from Unix. @@ -462,53 +462,46 @@ status slot." (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 - ;; needed to hold the strvec. - (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) - (+ (length string-list) 2)))) - (declare (fixnum string-bytes vec-bytes)) - (dolist (s string-list) - (enforce-type s simple-string) - (incf string-bytes (round-bytes-to-words (1+ (length s))))) - ;; Now allocate the memory and fill it in. - (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))) - (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-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 #.(/ 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 #.(/ sb-vm:n-machine-word-bits - sb-vm:n-byte-bits)) - total-bytes)))) + (let* ((bytes-per-word (/ sb-vm:n-machine-word-bits sb-vm:n-byte-bits)) + ;; We need an extra for the null, and an extra 'cause exect + ;; clobbers argv[-1]. + (vec-bytes (* bytes-per-word (+ (length string-list) 2))) + (octet-vector-list (mapcar (lambda (s) + (string-to-octets s :null-terminate t)) + string-list)) + (string-bytes (reduce #'+ octet-vector-list + :key (lambda (s) + (round-bytes-to-words (length s))))) + (total-bytes (+ string-bytes vec-bytes)) + ;; Memory to hold the vector of pointers and all the strings. + (vec-sap (sb-sys:allocate-system-memory total-bytes)) + (string-sap (sap+ vec-sap vec-bytes)) + ;; Index starts from [1]! + (vec-index-offset bytes-per-word)) + (declare (index string-bytes vec-bytes total-bytes) + (sb-sys:system-area-pointer vec-sap string-sap)) + (dolist (octets octet-vector-list) + (declare (type (simple-array (unsigned-byte 8) (*)) octets)) + (let ((size (length octets))) + ;; Copy string. + (sb-kernel:copy-ub8-to-system-area octets 0 string-sap 0 size) + ;; Put the pointer in the vector. + (setf (sap-ref-sap vec-sap vec-index-offset) string-sap) + ;; Advance string-sap for the next string. + (setf string-sap (sap+ string-sap (round-bytes-to-words (1+ size)))) + (incf vec-index-offset bytes-per-word))) + ;; Final null pointer. + (setf (sap-ref-sap vec-sap vec-index-offset) (int-sap 0)) + (values vec-sap (sap+ vec-sap bytes-per-word) total-bytes))) (defmacro with-c-strvec ((var str-list) &body body) (with-unique-names (sap size) - `(multiple-value-bind - (,sap ,var ,size) - (string-list-to-c-strvec ,str-list) - (unwind-protect - (progn - ,@body) - (sb-sys:deallocate-system-memory ,sap ,size))))) + `(multiple-value-bind (,sap ,var ,size) + (string-list-to-c-strvec ,str-list) + (unwind-protect + (progn + ,@body) + (sb-sys:deallocate-system-memory ,sap ,size))))) #-win32 (sb-alien:define-alien-routine spawn sb-alien:int @@ -625,6 +618,9 @@ standard arguments that can be passed to a Unix program. For no arguments, use NIL (which means that just the name of the program is passed as arg 0). +The program arguments and the environment are encoded using the +default external format for streams. + RUN-PROGRAM will return a PROCESS structure. See the CMU Common Lisp Users Manual for details about the PROCESS structure. @@ -644,7 +640,7 @@ Users Manual for details about the PROCESS structure. The &KEY arguments have the following meanings: :ENVIRONMENT - a list of SIMPLE-BASE-STRINGs describing the new Unix environment + a list of STRINGs describing the new Unix environment (as in \"man environ\"). The default is to copy the environment of the current process. :ENV @@ -786,6 +782,9 @@ argument. ARGS are the standard arguments that can be passed to a program. For no arguments, use NIL (which means that just the name of the program is passed as arg 0). +The program arguments will be encoded using the default external +format for streams. + RUN-PROGRAM will return a PROCESS structure. See the CMU Common Lisp Users Manual for details about the PROCESS structure. diff --git a/tests/run-program.test.sh b/tests/run-program.test.sh index b95931a42..50e12f31c 100644 --- a/tests/run-program.test.sh +++ b/tests/run-program.test.sh @@ -20,7 +20,7 @@ export SOMETHING_IN_THE_ENVIRONMENT PATH=/some/path/that/does/not/exist:${PATH} export PATH -${SBCL:-sbcl} <