Skip to content
Snippets Groups Projects
Commit 8d915bdb authored by Raymond Toy's avatar Raymond Toy
Browse files

STRING-TO-OCTETS returns the buffer, the number of octets written and

the number of characters converted when a buffer is given.  If the
buffer is not large enough, not all characters are converted.  This is
an incompatible change from the previous version.

Suggested by Helmut Eller, cmucl-imp, 2011-10-29.
parent d4dc2cd1
No related branches found
No related tags found
No related merge requests found
...@@ -851,39 +851,66 @@ character and illegal outputs are replaced by a question mark.") ...@@ -851,39 +851,66 @@ character and illegal outputs are replaced by a question mark.")
(funcall f state)))) (funcall f state))))
(def-ef-macro ef-string-to-octets (extfmt lisp::lisp +ef-max+ +ef-so+) (def-ef-macro ef-string-to-octets (extfmt lisp::lisp +ef-max+ +ef-so+)
`(lambda (string start end buffer error &aux (ptr 0) (state nil)) `(lambda (string start end buffer buffer-start buffer-end error bufferp
&aux (ptr buffer-start) (state nil) (last-octet buffer-start))
(declare #|(optimize (speed 3) (safety 0) (space 0) (debug 0))|# (declare #|(optimize (speed 3) (safety 0) (space 0) (debug 0))|#
(type simple-string string) (type simple-string string)
(type kernel:index start end ptr) (type kernel:index start end ptr)
(type (simple-array (unsigned-byte 8) (*)) buffer) (type (simple-array (unsigned-byte 8) (*)) buffer)
(ignorable state)) (ignorable state))
(dotimes (i (- end start) (values buffer ptr)) (if bufferp
(declare (type kernel:index i)) (block ef-string-done
(char-to-octets ,extfmt (schar string (+ start i)) state (dotimes (i (- end start) (values buffer ptr i))
(lambda (b) (declare (type kernel:index i))
(when (= ptr (length buffer)) (char-to-octets ,extfmt (schar string (+ start i)) state
(setq buffer (adjust-array buffer (* 2 ptr)))) (lambda (b)
(setf (aref buffer (1- (incf ptr))) b)) (when (= ptr buffer-end)
error)))) (return-from ef-string-done
(values buffer last-octet i)))
(setf (aref buffer (1- (incf ptr))) b))
error)
(setf last-octet ptr)))
(dotimes (i (- end start) (values buffer ptr i))
(declare (type kernel:index i))
(char-to-octets ,extfmt (schar string (+ start i)) state
(lambda (b)
(when (= ptr (length buffer))
(setq buffer (adjust-array buffer (* 2 ptr))))
(setf (aref buffer (1- (incf ptr))) b))
error)))))
(defun string-to-octets (string &key (start 0) end (external-format :default) (defun string-to-octets (string &key (start 0) end (external-format :default)
(buffer nil bufferp) (buffer nil bufferp)
(buffer-start 0)
error) error)
"Convert String to octets using the specified External-format. The "Convert String to octets using the specified External-format. The
string is bounded by Start (defaulting to 0) and End (defaulting to string is bounded by Start (defaulting to 0) and End (defaulting to
the end of the string. If Buffer is given, the octets are stored the end of the string. If Buffer is given, the octets are stored
there. If not, a new buffer is created." there. If not, a new buffer is created. Buffer-start specifies
where in the buffer the first octet will be placed.
Three values are returned: The buffer, the number of valid octets
written, and the number of characters converted. Note that the
actual number of octets written may be greater than the returned
value, These represent the partial octets of the next character to
be converted, but there was not enough room to hold the complete set
of octets."
(declare (type string string) (declare (type string string)
(type kernel:index start) (type kernel:index start)
(type (or kernel:index null) end) (type (or kernel:index null) end)
(type (or (simple-array (unsigned-byte 8) (*)) null) buffer)) (type (or (array (unsigned-byte 8) (*)) null) buffer))
(let* ((buffer (or buffer (make-array (length string) (let* ((buffer (or buffer (make-array (length string)
:element-type '(unsigned-byte 8))))) :element-type '(unsigned-byte 8)))))
(multiple-value-bind (buffer ptr) (lisp::with-array-data ((b buffer) (b-start)
(lisp::with-array-data ((string string) (start start) (end end)) (b-end))
(funcall (ef-string-to-octets external-format) (multiple-value-bind (result ptr octets)
string start end buffer error)) (lisp::with-array-data ((string string) (start start) (end end))
(values (if bufferp buffer (lisp::shrink-vector buffer ptr)) ptr)))) (funcall (ef-string-to-octets external-format)
string start end b
(+ b-start buffer-start) b-end
error bufferp))
(values (if bufferp buffer (lisp::shrink-vector result ptr))
(- ptr b-start buffer-start) octets)))))
(def-ef-macro ef-octets-to-string (extfmt lisp::lisp +ef-max+ +ef-os+) (def-ef-macro ef-octets-to-string (extfmt lisp::lisp +ef-max+ +ef-os+)
`(lambda (octets ptr end state string s-start s-end error `(lambda (octets ptr end state string s-start s-end error
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment