/[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.2 by rtoy, Wed Oct 31 14:37:38 2007 UTC revision 1.2.4.3 by rtoy, Mon Jun 23 15:03:31 2008 UTC
# Line 14  Line 14 
14  (in-package "STREAM")  (in-package "STREAM")
15    
16  (export '(string-to-octets octets-to-string *default-external-format*  (export '(string-to-octets octets-to-string *default-external-format*
17            encode-string decode-string))            string-encode string-decode))
18    
19  (defvar *default-external-format* :iso8859-1)  (defvar *default-external-format* :iso8859-1)
20    
21  (defvar *external-formats* (make-hash-table))  (defvar *external-formats* (make-hash-table :test 'equal))
22  (defvar *external-format-aliases* (make-hash-table))  (defvar *external-format-aliases* (make-hash-table))
23    
24    (defconstant +ef-os+ 2)
25    (defconstant +ef-so+ 3)
26    (defconstant +ef-en+ 4)
27    (defconstant +ef-de+ 5)
28    (defconstant +ef-max+ 6)
29    
30  (define-condition external-format-not-implemented (error)  (define-condition external-format-not-implemented (error)
31    ()    ()
32    (:report    (:report
# Line 32  Line 38 
38    (declare (ignore a b c d))    (declare (ignore a b c d))
39    (error 'external-format-not-implemented))    (error 'external-format-not-implemented))
40    
41    (defstruct efx
42      (octets-to-code #'%efni :type function :read-only t)
43      (code-to-octets #'%efni :type function :read-only t)
44      (cache nil :type (or null simple-vector)))
45    
46  (defstruct (external-format  (defstruct (external-format
47               (:conc-name ef-)               (:conc-name ef-)
48               (:print-function %print-external-format)               (:print-function %print-external-format)
49               (:constructor make-external-format (name               (:constructor make-external-format (name efx composingp
50                                                   &optional slots slotd                                                   &optional slots slotd)))
51                                                             octets-to-code    (name (ext:required-argument) :type (or keyword cons) :read-only t)
52                                                             code-to-octets)))    (efx (ext:required-argument) :type efx :read-only t)
53    (name (ext:required-argument) :type keyword :read-only t)    (composingp (ext:required-argument) :type boolean :read-only t)
54    (slots #() :type simple-vector :read-only t)    (slots #() :type simple-vector :read-only t)
55    (slotd nil :type list :read-only t)    (slotd nil :type list :read-only t))
   (octets-to-code #'%efni :type function :read-only t)  
   (code-to-octets #'%efni :type function :read-only t))  
56    
57  (defun %print-external-format (ef stream depth)  (defun %print-external-format (ef stream depth)
58    (declare (ignore depth))    (declare (ignore depth))
59    (print-unreadable-object (ef stream :type t :identity t)    (print-unreadable-object (ef stream :type t :identity t)
60      (princ (ef-name ef) stream)))      (princ (ef-name ef) stream)))
61    
62    (defun %whatsit (ef)
63      (setf (gethash (ef-name ef) *external-formats*) ef))
64    
65    (declaim (inline ef-octets-to-code ef-code-to-octets ef-cache))
66    
67    (defun ef-octets-to-code (ef)
68      (efx-octets-to-code (ef-efx ef)))
69    
70    (defun ef-code-to-octets (ef)
71      (efx-code-to-octets (ef-efx ef)))
72    
73    (defun ef-cache (ef)
74      (efx-cache (ef-efx ef)))
75    
76  (defmacro define-external-format (name octets-to-code code-to-octets)  (defmacro define-external-format (name octets-to-code code-to-octets)
77    (let ((tmp (gensym)))    (let ((tmp1 (gensym)) (tmp2 (gensym)))
78      `(macrolet ((octets-to-code ((state input unput) &body body)      `(macrolet ((octets-to-code ((state input unput &rest vars) body)
79                    `(lambda (,',tmp ,state ,input ,unput)                    `(lambda (,',tmp1 ,state ,input ,unput)
80                       (declare (type (function () (unsigned-byte 8)) ,input)                       (declare (ignore ,',tmp1)
81                                (type (function (lisp::index) t) ,unput)                                (ignorable ,state ,input ,unput)
82                                (ignore ,',tmp)                                (optimize (ext:inhibit-warnings 3)))
83                                (ignorable ,state ,unput)                       (let ((,input `(the (or (unsigned-byte 8) null) ,,input))
84                                (values (unsigned-byte 31) lisp::index t))                             ,@(loop for var in vars collect `(,var (gensym))))
85                       ,@body))                         ,body)))
86                  (code-to-octets ((code state output) &body body)                  (code-to-octets ((code state output &rest vars) body)
87                    `(lambda (,',tmp ,code ,state ,output)                    `(lambda (,',tmp1 ,',tmp2 ,state ,output)
88                       (declare (type (unsigned-byte 31) ,code)                       (declare (ignore ,',tmp1)
89                                (type (function ((unsigned-byte 8)) t) ,output)                                (ignorable ,state ,output)
90                                (ignore ,',tmp)                                (optimize (ext:inhibit-warnings 3)))
91                         (let ((,code ',code)
92                               ,@(loop for var in vars collect `(,var (gensym))))
93                           `(let ((,',code (the (unsigned-byte 31) ,,',tmp2)))
94                              (declare (ignorable ,',code))
95                              ,,body)))))
96           (%whatsit (make-external-format ,name
97                      (make-efx :octets-to-code ,octets-to-code
98                                :code-to-octets ,code-to-octets
99                                :cache (make-array +ef-max+ :initial-element nil))
100                      nil
101                      #() '())))))
102    
103    (defmacro define-composing-external-format (name input output)
104      (let ((tmp1 (gensym)) (tmp2 (gensym)))
105        `(macrolet ((input ((state input unput &rest vars) body)
106                      `(lambda (,',tmp1 ,state ,input ,unput)
107                         (declare (ignore ,',tmp1)
108                                  (ignorable ,state ,input ,unput)
109                                  (optimize (ext:inhibit-warnings 3)))
110                         (let ((,input `(the (values (or (unsigned-byte 31) null)
111                                                     lisp::index)
112                                             ,,input))
113                               ,@(loop for var in vars collect `(,var (gensym))))
114                           ,body)))
115                    (output ((code state output &rest vars) body)
116                      `(lambda (,',tmp1 ,',tmp2 ,state ,output)
117                         (declare (ignore ,',tmp1)
118                                (ignorable ,state ,output)                                (ignorable ,state ,output)
119                                (values t))                                (optimize (ext:inhibit-warnings 3)))
120                       ,@body)))                       (let ((,code ',code)
121         (setf (gethash ,name *external-formats*)                             ,@(loop for var in vars collect `(,var (gensym))))
122               (make-external-format ,name #() '()                         `(let ((,',code (the (unsigned-byte 31) ,,',tmp2)))
123                                     ,octets-to-code ,code-to-octets)))))                            (declare (ignorable ,',code))
124                              ,,body)))))
125           (%whatsit (make-external-format ,name
126                      (make-efx :octets-to-code ,input
127                                :code-to-octets ,output)
128                      t
129                      #() '())))))
130    
131  (defun load-external-format-aliases ()  (defun load-external-format-aliases ()
132    (let ((*package* (find-package "KEYWORD")))    (let ((*package* (find-package "KEYWORD")))
133      (with-open-file (stm "library:ext-formats/aliases" :if-does-not-exist nil)      (with-open-file (stm "ext-formats:aliases" :if-does-not-exist nil)
134        (when stm        (when stm
135          (do ((alias (read stm nil stm) (read stm nil stm))          (do ((alias (read stm nil stm) (read stm nil stm))
136               (value (read stm nil stm) (read stm nil stm)))               (value (read stm nil stm) (read stm nil stm)))
# Line 86  Line 142 
142                (warn "Bad entry in external-format aliases file: ~S => ~S."                (warn "Bad entry in external-format aliases file: ~S => ~S."
143                      alias value)))))))                      alias value)))))))
144    
145  (defun find-external-format (name &optional (error-p t))  (defun %find-external-format (name)
   (when (external-format-p name)  
     (return-from find-external-format name))  
   
   (when (eq name :default)  
     (setq name *default-external-format*))  
   
   #+(or)  
   (unless (ext:search-list-defined-p "ef:")  
     (setf (ext:search-list "ef:") '("library:ef/")))  
   
146    (when (zerop (hash-table-count *external-format-aliases*))    (when (zerop (hash-table-count *external-format-aliases*))
147      (setf (gethash :latin1 *external-format-aliases*) :iso8859-1)      (setf (gethash :latin1 *external-format-aliases*) :iso8859-1)
148      (setf (gethash :latin-1 *external-format-aliases*) :iso8859-1)      (setf (gethash :latin-1 *external-format-aliases*) :iso8859-1)
# Line 114  Line 160 
160    (or (gethash name *external-formats*)    (or (gethash name *external-formats*)
161        (and (let ((*package* (find-package "STREAM"))        (and (let ((*package* (find-package "STREAM"))
162                   (lisp::*enable-package-locked-errors* nil))                   (lisp::*enable-package-locked-errors* nil))
163               (load (format nil "library:ext-formats/~(~A~)" name)               (load (format nil "ext-formats:~(~A~)" name)
164                     :if-does-not-exist nil))                     :if-does-not-exist nil))
165             (gethash name *external-formats*))             (gethash name *external-formats*))))
166        (if error-p (error "External format ~S not found." name) nil)))  
167    (defun %composed-ef-name (a b)
168      (if (consp a) (append a (list b)) (list a b)))
169    
170    (defun %compose-external-formats (a b &optional name)
171      (when (ef-composingp a)
172        (error "~S is a Composing-External-Format." (ef-name a)))
173      (unless (ef-composingp b)
174        (error "~S is not a Composing-External-Format." (ef-name b)))
175      (when name
176        (setf (getf name *external-format-aliases*)
177            (%composed-ef-name (ef-name a) (ef-name b))))
178      (make-external-format
179       (%composed-ef-name (ef-name a) (ef-name b))
180       (make-efx
181        :octets-to-code (lambda (tmp state input unput)
182                          (declare (ignore tmp))
183                          (funcall (ef-octets-to-code b) (ef-slots b)
184                                   state
185                                   (funcall (ef-octets-to-code a) (ef-slots a)
186                                            state
187                                            input
188                                            unput)
189                                   unput))
190        :code-to-octets (lambda (tmp code state output)
191                          (declare (ignore tmp))
192                          (funcall (ef-code-to-octets b) (ef-slots b)
193                                   code
194                                   state
195                                   `(lambda (x)
196                                     ,(funcall (ef-code-to-octets a)
197                                               (ef-slots a)
198                                               'x state output))))
199        :cache (make-array +ef-max+ :initial-element nil))
200       nil #() '()))
201    
202    (defun find-external-format (name &optional (error-p t))
203      (when (external-format-p name)
204        (return-from find-external-format name))
205    
206      (or (if (consp name) (every #'keywordp name) (keywordp name))
207          (error "~S is not a valid external format name." name))
208    
209      (when (eq name :default)
210        (setq name *default-external-format*))
211    
212      (when (and (consp name) (not (cdr name)))
213        (setq name (car name)))
214    
215      (if (consp name)
216          (let ((efs (mapcar #'%find-external-format name)))
217            (if (member nil efs)
218                (if error-p (error "External format ~S not found." name) nil)
219                (let ((name (reduce #'%composed-ef-name (mapcar #'ef-name efs))))
220                  (or (gethash name *external-formats*)
221                      (%whatsit (reduce #'%compose-external-formats efs))))))
222          (or (%find-external-format name)
223              (if error-p (error "External format ~S not found." name) nil))))
224    
225  (define-condition void-external-format (error)  (define-condition void-external-format (error)
226    ()    ()
# Line 129  Line 231 
231    
232  (define-external-format :void  (define-external-format :void
233    (octets-to-code (state input unput)    (octets-to-code (state input unput)
234      (declare (ignore input))      `(error 'void-external-format))
     (error 'void-external-format))  
235    (code-to-octets (code state output)    (code-to-octets (code state output)
236      (declare (ignore code))      `(error 'void-external-format)))
     (error 'void-external-format)))  
237    
238  (define-external-format :iso8859-1  (define-external-format :iso8859-1
239    (octets-to-code (state input unput)    (octets-to-code (state input unput)
240      (declare (optimize (speed 3) (space 0) (safety 0) (debug 0)))      `(values ,input 1))
     (values (funcall input) 1 nil))  
241    (code-to-octets (code state output)    (code-to-octets (code state output)
242      (declare (optimize (speed 3) (space 0) (safety 0) (debug 0)))      `(,output (if (> ,code 255) #x3F ,code))))
     (funcall output (if (> code 255) #x3F code))  
     nil))  
   
243    
244  (defmacro octets-to-codepoint (external-format state count input unput)  (defmacro octets-to-codepoint (external-format state count input unput)
245    (let ((tmp1 (gensym)) (tmp2 (gensym)) (tmp3 (gensym)))    (let ((tmp1 (gensym)) (tmp2 (gensym)))
246      `(multiple-value-bind (,tmp1 ,tmp2 ,tmp3)      `(let ((body (funcall (ef-octets-to-code ,external-format)
247           (funcall (ef-octets-to-code ,external-format) ,external-format                            (ef-slots ,external-format)
248                    ,state ,input ,unput)                            ',state ',input ',unput)))
249         (declare (type (unsigned-byte 31) ,tmp1) (type lisp::index ,tmp2))         `(multiple-value-bind (,',tmp1 ,',tmp2) ,body
250         (setf ,state ,tmp3 ,count ,tmp2)            (setf ,',count (the lisp::index ,',tmp2))
251         ,tmp1)))            (the (or (unsigned-byte 31) null) ,',tmp1)))))
252    
253  (defmacro codepoint-to-octets (external-format code state output)  (defmacro codepoint-to-octets (external-format code state output)
254    `(progn    `(funcall (ef-code-to-octets ,external-format) (ef-slots ,external-format)
255       (setf ,state (funcall (ef-code-to-octets ,external-format)              ',code ',state ',output))
256                             ,external-format ,code ,state ,output))  
257       nil))  
258    
259    (defvar *ef-base* +ef-max+)
260    (defvar *ef-extensions* '())
261    
262    (defun ensure-cache (ef id reqd)
263      (let ((base (or (getf *ef-extensions* id)
264                      (setf (getf *ef-extensions* id)
265                          (prog1 *ef-base* (incf *ef-base* reqd))))))
266        (when (< (length (ef-cache ef)) (+ base reqd))
267          (setf (efx-cache (ef-efx ef))
268              (adjust-array (ef-cache ef) (+ base reqd) :initial-element nil)))
269        base))
270    
271    (defmacro def-ef-macro (name (ef id reqd idx) body)
272      (let ((tmp (gensym)))
273        `(defun ,name (,ef)
274           (let ((,tmp ,(if (eq id 'lisp::lisp)
275                            idx
276                            `(+ (ensure-cache ,ef ',id ,reqd) ,idx))))
277             (or (aref (ef-cache ,ef) ,tmp)
278                 (setf (aref (ef-cache ,ef) ,tmp)
279                     (let ((*compile-print* nil)) (compile nil ,body))))))))
280    
281    
282    
283  (defmacro octets-to-char (external-format state count input unput)  (defmacro octets-to-char (external-format state count input unput)
284    `(let ((code (octets-to-codepoint ,external-format    `(let ((body (octets-to-codepoint ,external-format
285                                      ,state ,count ,input ,unput)))                                      ,state ,count ,input ,unput)))
286       (declare (type (unsigned-byte 31) code))       `(let ((code ,body))
287       (if (< code #x100) (code-char code) #\?)))          (declare (type (unsigned-byte 31) code))
288            (if (< code char-code-limit) (code-char code) #\?))))
289    
290  (defmacro char-to-octets (external-format char state output)  (defmacro char-to-octets (external-format char state output)
291    `(codepoint-to-octets ,external-format (char-code ,char) ,state ,output))    `(codepoint-to-octets ,external-format (char-code ,char) ,state ,output))
292    
293    (def-ef-macro ef-string-to-octets (extfmt lisp::lisp +ef-max+ +ef-so+)
294      `(lambda (string start end buffer &aux (ptr 0) (state nil))
295         (declare #|(optimize (speed 3) (safety 0) (space 0) (debug 0))|#
296                  (type simple-string string)
297                  (type lisp::index start end ptr)
298                  (type (simple-array (unsigned-byte 8) (*)) buffer)
299                  (ignorable state))
300         (dotimes (i (- end start) (values buffer ptr))
301           (declare (type lisp::index i))
302           ,(char-to-octets extfmt (schar string (+ start i)) state
303                            (lambda (b)
304                              (when (= ptr (length buffer))
305                                (setq buffer (adjust-array buffer (* 2 ptr))))
306                              (setf (aref buffer (1- (incf ptr))) b))))))
307    
308  (defun string-to-octets (string &key (start 0) end (external-format :default)  (defun string-to-octets (string &key (start 0) end (external-format :default)
309                                       (buffer nil bufferp))                                       (buffer nil bufferp))
310    (declare (type string string)    (declare (type string string)
311             (type lisp::index start)             (type lisp::index start)
312             (type (or null lisp::index) end)             (type (or lisp::index null) end)
313             (type (or null (simple-array (unsigned-byte 8) (*))) buffer)             (type (or (simple-array (unsigned-byte 8) (*)) null) buffer))
314             #|(optimize (speed 3) (safety 0) (space 0) (debug 0))|#)    (multiple-value-bind (buffer ptr)
315    (let ((ef (find-external-format external-format))        (lisp::with-array-data ((string string) (start start) (end end))
316          (buffer (or buffer (make-array (length string)          (funcall (ef-string-to-octets (find-external-format external-format))
317                                         :element-type '(unsigned-byte 8))))                   string start end
318          (ptr 0)                   (or buffer (make-array (length string)
319          (state nil))                                          :element-type '(unsigned-byte 8)))))
320      (declare (type external-format ef)      (values (if bufferp buffer (lisp::shrink-vector buffer ptr)) ptr)))
321               (type (simple-array (unsigned-byte 8) (*)) buffer)  
322               (type lisp::index ptr))  (def-ef-macro ef-octets-to-string (extfmt lisp::lisp +ef-max+ +ef-os+)
323      (flet ((out (b)    `(lambda (octets ptr end string &aux (pos -1) (count 0) (state nil))
324               (when (= ptr (length buffer))       (declare #|(optimize (speed 3) (safety 0) (space 0) (debug 0))|#
325                 (setq buffer (adjust-array buffer (* 2 ptr))))                (type (simple-array (unsigned-byte 8) (*)) octets)
326               (setf (aref buffer (1- (incf ptr))) b)))                (type lisp::index end count)
327        (dotimes (i (- (or end (length string)) start))                (type (integer -1 (#.array-dimension-limit)) ptr pos)
328          (declare (type lisp::index i))                (type simple-string string)
329          (char-to-octets ef (char string (+ start i)) state #'out))                (ignorable state))
330        (values (if bufferp buffer (lisp::shrink-vector buffer ptr)) ptr))))       (loop until (>= ptr end)
331            do (when (= pos (length string))
332                 (setq string (adjust-array string (* 2 pos))))
333               (setf (schar string (incf pos))
334                   ,(octets-to-char extfmt state count
335                                    (aref octets (incf ptr)) ;;@@ EOF??
336                                    (lambda (n) (decf ptr n))))
337            finally (return (values string (1+ pos))))))
338    
339  (defun octets-to-string (octets &key (start 0) end (external-format :default)  (defun octets-to-string (octets &key (start 0) end (external-format :default)
340                                       (string nil stringp))                                       (string nil stringp))
341    (declare (type (simple-array (unsigned-byte 8) (*)) octets)    (declare (type (simple-array (unsigned-byte 8) (*)) octets)
342             (type lisp::index start)             (type lisp::index start)
343             (type (or null lisp::index) end)             (type (or lisp::index null) end)
344             (type (or null simple-string string))             (type (or simple-string null) string))
345             #|(optimize (speed 3) (safety 0) (space 0) (debug 0))|#)    (multiple-value-bind (string pos)
346    (let ((ef (find-external-format external-format))        (funcall (ef-octets-to-string (find-external-format external-format))
347          (end (1- (or end (length octets))))                 octets (1- start) (1- (or end (length octets)))
348          (string (or string (make-string (length octets))))                 (or string (make-string (length octets))))
         (ptr (1- start))  
         (pos 0)  
         (count 0)  
         (state nil))  
     (declare (type external-format ef)  
              (type lisp::index end count)  
              (type (integer -1 (#.array-dimension-limit)) pos ptr)  
              (type simple-string string))  
     (flet ((input ()  
              (aref octets (incf ptr)))  
            (unput (n)  
              (decf ptr (the lisp::index n))))  
       (loop until (>= ptr end)  
             do (when (= pos (length string))  
                  (setq string (adjust-array string (* 2 pos))))  
                (setf (schar string (1- (incf pos)))  
                    (octets-to-char ef state count #'input #'unput))))  
349      (values (if stringp string (lisp::shrink-vector string pos)) pos)))      (values (if stringp string (lisp::shrink-vector string pos)) pos)))
350    
351    
352    
353  (defun encode-string (string external-format &optional (start 0) end)  (def-ef-macro ef-encode (extfmt lisp::lisp +ef-max+ +ef-en+)
354    (declare (type string string)    `(lambda (string start end result &aux (ptr 0) (state nil))
355             (type lisp::index start)       (declare #|(optimize (speed 3) (safety 0) (space 0) (debug 0))|#
356             (type (or null lisp::index) end)                (type simple-string string)
357             #|(optimize (speed 3) (safety 0) (space 0) (debug 0))|#)                (type lisp::index start end ptr)
358    (let ((ef (find-external-format external-format))                (type simple-base-string result)
359          (result (make-string (length string) :element-type 'base-char))                (ignorable state))
360          (ptr 0)       (dotimes (i (- end start) (values result ptr))
361          (state nil))         (declare (type lisp::index i))
362      (declare (type external-format ef)         ,(char-to-octets extfmt (schar string (+ start i)) state
363               (type simple-base-string result)                          (lambda (b)
364               (type lisp::index ptr))                            (when (= ptr (length result))
365      (flet ((out (b)                              (setq result (adjust-array result (* 2 ptr))))
366               (when (= ptr (length result))                            (setf (aref result (1- (incf ptr)))
367                 (setq result (adjust-array result (* 2 ptr))))                                (code-char b)))))))
368               (setf (char result (1- (incf ptr))) (code-char b))))  
369        (dotimes (i (- (or end (length string)) start))  (defun string-encode (string external-format &optional (start 0) end)
370          (declare (type lisp::index i))    (multiple-value-bind (result ptr)
371          (char-to-octets ef (char string (+ start i)) state #'out))        (lisp::with-array-data ((string string) (start start) (end end))
372        (lisp::shrink-vector result ptr))))          (funcall (ef-encode (find-external-format external-format))
373                     string start end
374  (defun decode-string (string external-format &optional (start 0) end)                   (make-string (length string) :element-type 'base-char)))
375    (declare (type string string)      (lisp::shrink-vector result ptr)))
376             (type lisp::index start)  
377             (type (or null lisp::index) end)  (def-ef-macro ef-decode (extfmt lisp::lisp +ef-max+ +ef-de+)
378             #|(optimize (speed 3) (safety 0) (space 0) (debug 0))|#)    `(lambda (string ptr end result &aux (pos -1) (count 0) (state nil))
379    (let ((ef (find-external-format external-format))       (declare #|(optimize (speed 3) (safety 0) (space 0) (debug 0))|#
380          (end (1- (or end (length string))))                (type simple-string string)
381          (result (make-string (length string)))                (type lisp::index end count)
382          (ptr (1- start))                (type (integer -1 (#.array-dimension-limit)) ptr pos)
383          (pos -1)                (type simple-string result)
384          (count 0)                (ignorable state))
385          (state nil))       (loop until (>= ptr end)
386      (declare (type external-format ef)          ;; increasing size of result shouldn't ever be necessary, unless
387               (type lisp::index end count)          ;; someone implements an encoding smaller than the source string...
388               (type (integer -1 (#.array-dimension-limit)) pos ptr)          do (setf (schar result (incf pos))
389               (type simple-string result))                 ,(octets-to-char extfmt state count
390      (flet ((input ()                                  ;; note the need to return NIL for EOF
391               (char-code (char string (incf ptr))))                                  (if (= (1+ ptr) (length string))
392             (unput (n)                                      nil
393               (decf ptr (the lisp::index n))))                                      (char-code (char string (incf ptr))))
394        (loop until (>= ptr end)                                  (lambda (n) (decf ptr n))))
395              ;; increasing size of result shouldn't ever be necessary, unless          finally (return (values result (1+ pos))))))
396              ;; someone implements an encoding smaller than the source string...  
397              do (setf (schar result (incf pos))  (defun string-decode (string external-format &optional (start 0) end)
398                     (octets-to-char ef state count #'input #'unput))))    (multiple-value-bind (result pos)
399      (lisp::shrink-vector result (1+ pos))))        (lisp::with-array-data ((string string) (start start) (end end))
400            (funcall (ef-decode (find-external-format external-format))
401                     string (1- start) (1- end) (make-string (length string))))
402        (lisp::shrink-vector result pos)))

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

  ViewVC Help
Powered by ViewVC 1.1.5