Need foreign string method for translate-into-foreign-memory?

[Liam Healy]

On Sun, Oct 6, 2013 at 11:53 AM, Luís Oliveira
<loliveira at common-lisp.net> wrote:

>
> Right, the slot lookup shouldn't be very relevant. Invoking the
> octet-counter closure, though, will iterate across the string.
>
> Cheers,
> Luís

OK, I rewrote as two functions lisp-string-to-foreign-int (engine),
lisp-string-to-foreign (wrapper), and now lisp-string-to-foreign and
foreign-string-alloc each compute the size.

(defun lisp-string-to-foreign-int
    (string buffer bufsize &key (start 0) end offset
                             (encoding *default-foreign-encoding*)
                             computed-size computed-end)
  (check-type string string)
  (when offset
    (setq buffer (inc-pointer buffer offset)))
  (with-checked-simple-vector ((string (coerce string 'babel:unicode-string))
                               (start start) (end end))
    (declare (ignorable end))           ; Supress SBCL style warning
    (declare (type simple-string string))
    (let ((mapping (lookup-mapping *foreign-string-mappings* encoding))
          (nul-len (null-terminator-len encoding)))
      (assert (plusp bufsize))
      (funcall (encoder mapping) string start computed-end buffer 0)
      (dotimes (i nul-len)
        (setf (mem-ref buffer :char (+ computed-size i)) 0))))
  buffer))

(defun lisp-string-to-foreign (string buffer bufsize &key (start 0) end offset
                                                       (encoding
*default-foreign-encoding*))
  (multiple-value-bind (computed-size computed-end)
      (funcall (octet-counter (lookup-mapping
*foreign-string-mappings* encoding))
               string start end 0)
    (lisp-string-to-foreign-int
     string buffer bufsize
     :start start
     :end end
     :offset offset
     :encoding encoding
     :computed-size computed-size
     :computed-end computed-end)))

;;; LMH new
(defun foreign-string-alloc (string &key (encoding *default-foreign-encoding*)
                                      (null-terminated-p t) (start 0) end)
  "Allocate a foreign string containing Lisp string STRING.
The string must be freed with FOREIGN-STRING-FREE."
  (multiple-value-bind (computed-size computed-end)
      (funcall (octet-counter (lookup-mapping
*foreign-string-mappings* encoding))
               string start end 0)
    (let* ((length
             (+ computed-size
                (if null-terminated-p
                    (null-terminator-len encoding)
                    0)))
           (ptr (foreign-alloc :char :count length)))
      (lisp-string-to-foreign-int
       string ptr length
       :start start
       :end end
       :encoding encoding
       :computed-size computed-size
       :computed-end computed-end)
      (values ptr length))))

How does this look?

Liam