Ignore:
Timestamp:
Feb 15, 2013, 7:24:29 AM (7 years ago)
Author:
gb
Message:

Propagate recent trunk changes.

Location:
release/1.9/source/level-1
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/1.9/source/level-1

  • release/1.9/source/level-1/linux-files.lisp

    r15684 r15706  
    10741074;;; Foreign (unix) processes.
    10751075
    1076 (defun call-with-string-vector (function strings)
    1077   (let ((bufsize (reduce #'+ strings
    1078                          :key #'(lambda (s) (1+ (length (string s))))))
    1079         (argvsize (ash (1+ (length strings)) target::word-shift))
    1080         (bufpos 0)
    1081         (argvpos 0))
     1076(defun call-with-string-vector (function strings encoding)
     1077  (let* ((encoding (if (typep encoding 'character-encoding)
     1078                     encoding
     1079                     (get-character-encoding encoding)))
     1080         (bufsize (reduce #'+ strings
     1081                          :key #'(lambda (s)
     1082                                   (let* ((string (string s)))
     1083                                     (cstring-encoded-length-in-bytes encoding
     1084                                                                      string
     1085                                                                      0
     1086                                                                      (length string))))))
     1087         (argvsize (ash (1+ (length strings)) target::word-shift))
     1088         (bufpos 0)
     1089         (argvpos 0))       
    10821090    (%stack-block ((buf bufsize) (argv argvsize))
    10831091      (flet ((init (s)
    1084              (multiple-value-bind (sstr start end) (get-sstring s)
    1085                (declare (fixnum start end))
    1086                (let ((len (- end start)))
    1087                  (declare (fixnum len))
    1088                  (do* ((i 0 (1+ i))
    1089                        (start start (1+ start))
    1090                        (bufpos bufpos (1+ bufpos)))
    1091                       ((= i len))
    1092                    (setf (%get-unsigned-byte buf bufpos)
    1093                          (logand #xff (%scharcode sstr start))))
    1094                  (setf (%get-byte buf (%i+ bufpos len)) 0)
    1095                  (setf (%get-ptr argv argvpos) (%inc-ptr buf bufpos))
    1096                  (setq bufpos (%i+ bufpos len 1))
    1097                  (setq argvpos (%i+ argvpos target::node-size))))))
     1092               (multiple-value-bind (sstr start end) (get-sstring s)
     1093                 (declare (fixnum start end))
     1094                 (let* ((len (- (encode-string-to-memory encoding buf bufpos sstr start end) bufpos)))
     1095                   (declare (fixnum len))
     1096                   (setf (%get-byte buf (%i+ bufpos len)) 0)
     1097                   (setf (%get-ptr argv argvpos) (%inc-ptr buf bufpos))
     1098                   (setq bufpos (%i+ bufpos len 1))
     1099                   (setq argvpos (%i+ argvpos target::node-size))))))
    10981100        (declare (dynamic-extent #'init))
    10991101        (map nil #'init strings))
     
    11011103      (funcall function argv))))
    11021104
    1103 (defmacro with-string-vector ((var strings) &body body)
    1104   `(call-with-string-vector #'(lambda (,var) ,@body) ,strings))
     1105(defmacro with-string-vector ((var strings &optional encoding) &body body)
     1106  `(call-with-string-vector #'(lambda (,var) ,@body) ,strings ,encoding))
    11051107
    11061108(defloadvar *max-os-open-files* #-windows-target (#_getdtablesize) #+windows-target 32)
     
    14531455    (unless (every #'(lambda (a) (typep a 'simple-string)) args)
    14541456      (error "Program args must all be simple strings : ~s" args))
     1457    (setq external-format (normalize-external-format t external-format))
    14551458    (dolist (pair env)
    14561459      (destructuring-bind (var . val) pair
     
    15151518                   #'run-external-process proc in-fd out-fd error-fd argv env)
    15161519                  (wait-on-semaphore (external-process-signal proc)))
    1517               args))
     1520              args
     1521              (external-format-character-encoding external-format)))
    15181522        (dolist (fd close-in-parent) (fd-close fd))
    15191523        (unless (external-process-pid proc)
Note: See TracChangeset for help on using the changeset viewer.