/[cmucl]/src/code/extfmts.lisp
ViewVC logotype

Diff of /src/code/extfmts.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by rtoy, Thu Oct 25 15:17:07 2007 UTC revision 1.2 by rtoy, Wed Oct 31 14:37:38 2007 UTC
# Line 112  Line 112 
112      (setq name tmp))      (setq name tmp))
113    
114    (or (gethash name *external-formats*)    (or (gethash name *external-formats*)
115        (and (let ((*package* (find-package "STREAM")))        (and (let ((*package* (find-package "STREAM"))
116               (load (format nil "library:ext-formats/~(~A~)" name) :if-does-not-exist nil))                   (lisp::*enable-package-locked-errors* nil))
117                 (load (format nil "library:ext-formats/~(~A~)" name)
118                       :if-does-not-exist nil))
119             (gethash name *external-formats*))             (gethash name *external-formats*))
120        (if error-p (error "External format ~S not found." name) nil)))        (if error-p (error "External format ~S not found." name) nil)))
121    
# Line 169  Line 171 
171  (defmacro char-to-octets (external-format char state output)  (defmacro char-to-octets (external-format char state output)
172    `(codepoint-to-octets ,external-format (char-code ,char) ,state ,output))    `(codepoint-to-octets ,external-format (char-code ,char) ,state ,output))
173    
174  (defun string-to-octets (string &key (start 0) end (external-format :default))  (defun string-to-octets (string &key (start 0) end (external-format :default)
175                                         (buffer nil bufferp))
176    (declare (type string string)    (declare (type string string)
177             (type lisp::index start)             (type lisp::index start)
178             (type (or null lisp::index) end)             (type (or null lisp::index) end)
179               (type (or null (simple-array (unsigned-byte 8) (*))) buffer)
180             #|(optimize (speed 3) (safety 0) (space 0) (debug 0))|#)             #|(optimize (speed 3) (safety 0) (space 0) (debug 0))|#)
181    (let ((ef (find-external-format external-format))    (let ((ef (find-external-format external-format))
182          (buffer (make-array (length string) :element-type '(unsigned-byte 8)))          (buffer (or buffer (make-array (length string)
183                                           :element-type '(unsigned-byte 8))))
184          (ptr 0)          (ptr 0)
185          (state nil))          (state nil))
186      (declare (type external-format ef)      (declare (type external-format ef)
# Line 188  Line 193 
193        (dotimes (i (- (or end (length string)) start))        (dotimes (i (- (or end (length string)) start))
194          (declare (type lisp::index i))          (declare (type lisp::index i))
195          (char-to-octets ef (char string (+ start i)) state #'out))          (char-to-octets ef (char string (+ start i)) state #'out))
196        (lisp::shrink-vector buffer ptr))))        (values (if bufferp buffer (lisp::shrink-vector buffer ptr)) ptr))))
197    
198  (defun octets-to-string (octets &key (start 0) end (external-format :default))  (defun octets-to-string (octets &key (start 0) end (external-format :default)
199                                         (string nil stringp))
200    (declare (type (simple-array (unsigned-byte 8) (*)) octets)    (declare (type (simple-array (unsigned-byte 8) (*)) octets)
201             (type lisp::index start)             (type lisp::index start)
202             (type (or null lisp::index) end)             (type (or null lisp::index) end)
203               (type (or null simple-string string))
204             #|(optimize (speed 3) (safety 0) (space 0) (debug 0))|#)             #|(optimize (speed 3) (safety 0) (space 0) (debug 0))|#)
205    (let ((ef (find-external-format external-format))    (let ((ef (find-external-format external-format))
206          (end (1- (or end (length octets))))          (end (1- (or end (length octets))))
207          (string (make-string (length octets)))          (string (or string (make-string (length octets))))
208          (ptr (1- start))          (ptr (1- start))
209          (pos -1)          (pos 0)
210          (count 0)          (count 0)
211          (state nil))          (state nil))
212      (declare (type external-format ef)      (declare (type external-format ef)
213               (type lisp::index end count)               (type lisp::index end count)
214               (type (integer -1 (#.array-dimension-limit)) pos ptr)               (type (integer -1 (#.array-dimension-limit)) pos ptr)
215               (type simple-base-string string))               (type simple-string string))
216      (flet ((input ()      (flet ((input ()
217               (aref octets (incf ptr)))               (aref octets (incf ptr)))
218             (unput (n)             (unput (n)
219               (decf ptr (the lisp::index n))))               (decf ptr (the lisp::index n))))
220        (loop until (>= ptr end)        (loop until (>= ptr end)
221              ;; increasing size of string shouldn't ever be necessary, unless              do (when (= pos (length string))
222              ;; someone implements an encoding smaller than the source string...                   (setq string (adjust-array string (* 2 pos))))
223              do (setf (schar string (incf pos))                 (setf (schar string (1- (incf pos)))
224                     (octets-to-char ef state count #'input #'unput))))                     (octets-to-char ef state count #'input #'unput))))
225      (lisp::shrink-vector string (1+ pos))))      (values (if stringp string (lisp::shrink-vector string pos)) pos)))
226    
227    
228    
# Line 225  Line 232 
232             (type (or null lisp::index) end)             (type (or null lisp::index) end)
233             #|(optimize (speed 3) (safety 0) (space 0) (debug 0))|#)             #|(optimize (speed 3) (safety 0) (space 0) (debug 0))|#)
234    (let ((ef (find-external-format external-format))    (let ((ef (find-external-format external-format))
235          (result (make-string (length string)))          (result (make-string (length string) :element-type 'base-char))
236          (ptr 0)          (ptr 0)
237          (state nil))          (state nil))
238      (declare (type external-format ef)      (declare (type external-format ef)
# Line 255  Line 262 
262      (declare (type external-format ef)      (declare (type external-format ef)
263               (type lisp::index end count)               (type lisp::index end count)
264               (type (integer -1 (#.array-dimension-limit)) pos ptr)               (type (integer -1 (#.array-dimension-limit)) pos ptr)
265               (type simple-base-string result))               (type simple-string result))
266      (flet ((input ()      (flet ((input ()
267               (char-code (char string (incf ptr))))               (char-code (char string (incf ptr))))
268             (unput (n)             (unput (n)
# Line 266  Line 273 
273              do (setf (schar result (incf pos))              do (setf (schar result (incf pos))
274                     (octets-to-char ef state count #'input #'unput))))                     (octets-to-char ef state count #'input #'unput))))
275      (lisp::shrink-vector result (1+ pos))))      (lisp::shrink-vector result (1+ pos))))
   
   
 (provide :external-formats)  

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

  ViewVC Help
Powered by ViewVC 1.1.5