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

Contents of /src/code/extfmts.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2.4.3.2.6 - (show annotations)
Tue Jul 8 16:09:06 2008 UTC (5 years, 9 months ago) by rtoy
Branch: unicode-utf16-extfmt-branch
Changes since 1.2.4.3.2.5: +6 -2 lines
Turn off *compile-verbose*, *compile-progress*, and *gc-verbose* to
minimize output messages when compiling the external format.  There's
a problem if COMPILE wants to produce output and the external format
isn't completely setup yet.  (Seems only to be a problem when you
change *default-external-format*.)

This is a workaround.  There ought to be a better solution.  This
change doesn't solve every issue since compiler notes are still output
sometimes.
1 ;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: STREAM -*-
2 ;;;
3 ;;; **********************************************************************
4 ;;; This code was written by Paul Foley and has been placed in the public
5 ;;; domain.
6 ;;;
7 (ext:file-comment
8 "$Header: /tiger/var/lib/cvsroots/cmucl/src/code/extfmts.lisp,v 1.2.4.3.2.6 2008/07/08 16:09:06 rtoy Exp $")
9 ;;;
10 ;;; **********************************************************************
11 ;;;
12 ;;; Implementation of external-formats
13
14 (in-package "STREAM")
15
16 (export '(string-to-octets octets-to-string *default-external-format*
17 string-encode string-decode))
18
19 (defvar *default-external-format* :iso8859-1)
20
21 (defvar *external-formats* (make-hash-table :test 'equal))
22 (defvar *external-format-aliases* (make-hash-table))
23
24 (defconstant +ef-cin+ 2)
25 (defconstant +ef-cout+ 3)
26 (defconstant +ef-sin+ 4)
27 (defconstant +ef-sout+ 5)
28 (defconstant +ef-os+ 6)
29 (defconstant +ef-so+ 7)
30 (defconstant +ef-en+ 8)
31 (defconstant +ef-de+ 9)
32 (defconstant +ef-max+ 10)
33
34 (define-condition external-format-not-implemented (error)
35 ()
36 (:report
37 (lambda (condition stream)
38 (declare (ignore condition))
39 (format stream "Attempting unimplemented external-format I/O."))))
40
41 (defun %efni (a b c d)
42 (declare (ignore a b c d))
43 (error 'external-format-not-implemented))
44
45 (defstruct efx
46 (octets-to-code #'%efni :type function :read-only t)
47 (code-to-octets #'%efni :type function :read-only t)
48 (cache nil :type (or null simple-vector))
49 (min 1 :type kernel:index :read-only t)
50 (max 1 :type kernel:index :read-only t))
51
52 (defstruct (external-format
53 (:conc-name ef-)
54 (:print-function %print-external-format)
55 (:constructor make-external-format (name efx composingp
56 &optional slots slotd)))
57 (name (ext:required-argument) :type (or keyword cons) :read-only t)
58 (efx (ext:required-argument) :type efx :read-only t)
59 (composingp (ext:required-argument) :type boolean :read-only t)
60 (slots #() :type simple-vector :read-only t)
61 (slotd nil :type list :read-only t))
62
63 (defun %print-external-format (ef stream depth)
64 (declare (ignore depth))
65 (print-unreadable-object (ef stream :type t :identity t)
66 (princ (ef-name ef) stream)))
67
68 (defun %intern-ef (ef)
69 (setf (gethash (ef-name ef) *external-formats*) ef))
70
71 (declaim (inline ef-octets-to-code ef-code-to-octets ef-cache
72 ef-min-octets ef-max-octets))
73
74 (defun ef-octets-to-code (ef)
75 (efx-octets-to-code (ef-efx ef)))
76
77 (defun ef-code-to-octets (ef)
78 (efx-code-to-octets (ef-efx ef)))
79
80 (defun ef-cache (ef)
81 (efx-cache (ef-efx ef)))
82
83 (defun ef-min-octets (ef)
84 (efx-min (ef-efx ef)))
85
86 (defun ef-max-octets (ef)
87 (efx-max (ef-efx ef)))
88
89 (eval-when (:compile-toplevel :load-toplevel :execute)
90 (defun %merge-slots (old new)
91 (let* ((pos (length old))
92 (tmp (mapcar (lambda (x)
93 (let* ((name (if (consp x) (first x) x))
94 (init (if (consp x) (second x) nil))
95 (list (if (consp x) (nthcdr 2 x) nil))
96 (prev (assoc name old))
97 (posn (if prev (second prev) (1- (incf pos)))))
98 (list name posn init (getf list :type t))))
99 new)))
100 (delete-duplicates (stable-sort (append old tmp) #'< :key #'second)
101 :key #'second))))
102
103 ;;; DEFINE-EXTERNAL-FORMAT -- Public
104 ;;;
105 ;;; name (&key min max size) (&rest slots) octets-to-code code-to-octets
106 ;;; Define a new external format. Min/Max/Size are the minimum and
107 ;;; maximum number of octets that make up a character (:size N is just
108 ;;; shorthand for :min N :max N). Slots is a list of slot descriptions
109 ;;; similar to defstruct.
110 ;;;
111 ;;; name (base) (&rest slots)
112 ;;; Define an external format based on a previously-defined external
113 ;;; format, Base. The slot names used in Slots must match those in Base.
114 ;;;
115 ;;; Note: external-formats work on code-points, not characters, so that
116 ;;; the entire 31 bit ISO-10646 range can be used internally regardless of
117 ;;; the size of a character recognized by Lisp and external formats
118 ;;; can be useful to people who want to process characters outside the
119 ;;; Lisp range (see CODEPOINT-TO-OCTETS, OCTETS-TO-CODEPOINT)
120 ;;;
121 (defmacro define-external-format (name (&rest args) (&rest slots)
122 &optional octets-to-code code-to-octets)
123 (when (and (oddp (length args)) (not (= (length args) 1)))
124 (warn "Nonsensical argument (~S) to DEFINE-EXTERNAL-FORMAT." args))
125 (let* ((tmp1 (gensym)) (tmp2 (gensym))
126 (min (if (evenp (length args))
127 (or (getf args :min) (getf args :size) 1)
128 1))
129 (max (if (evenp (length args))
130 (or (getf args :max) (getf args :size) 6)
131 6))
132 (base (if (= (length args) 1)
133 (find-external-format (first args))
134 nil))
135 (bslotd (if base (ef-slotd base) nil))
136 (slotd (%merge-slots bslotd slots))
137 (slotb (loop for slot in slotd
138 collect `(,(first slot)
139 (the ,(fourth slot)
140 (identity (svref ,tmp1 ,(second slot))))))))
141 `(macrolet ((octets-to-code ((state input unput &rest vars) body)
142 `(lambda (,',tmp1 ,state ,input ,unput)
143 (declare (type simple-vector ,',tmp1)
144 (ignorable ,state ,input ,unput)
145 (optimize (ext:inhibit-warnings 3)))
146 (let (,@',slotb
147 (,input `(the (or (unsigned-byte 8) null) ,,input))
148 ,@(loop for var in vars collect `(,var (gensym))))
149 ,body)))
150 (code-to-octets ((code state output &rest vars) body)
151 `(lambda (,',tmp1 ,',tmp2 ,state ,output)
152 (declare (type simple-vector ,',tmp1)
153 (ignorable ,state ,output)
154 (optimize (ext:inhibit-warnings 3)))
155 (let (,@',slotb
156 (,code ',code)
157 ,@(loop for var in vars collect `(,var (gensym))))
158 `(let ((,',code (the (unsigned-byte 31) ,,',tmp2)))
159 (declare (ignorable ,',code))
160 ,,body)))))
161 (%intern-ef (make-external-format ,name
162 ,(if base
163 `(ef-efx (find-external-format ,(ef-name base)))
164 `(make-efx :octets-to-code ,octets-to-code
165 :code-to-octets ,code-to-octets
166 :cache (make-array +ef-max+
167 :initial-element nil)
168 :min ,(min min max) :max ,(max min max)))
169 nil
170 (vector ,@(mapcar #'third slotd))
171 ',slotd)))))
172
173 ;;; DEFINE-COMPOSING-EXTERNAL-FORMAT -- Public
174 ;;;
175 ;;; A composing-external-format differs from an (ordinary) external-format
176 ;;; in that it translates characters (really codepoints, of course) into
177 ;;; other characters, rather than translating between characters and binary
178 ;;; octets. They have to be composed with a non-composing external-format
179 ;;; to be of any use.
180 ;;;
181 (defmacro define-composing-external-format (name (&key min max size)
182 input output)
183 (let ((tmp1 (gensym)) (tmp2 (gensym))
184 (min (or min size 1))
185 (max (or max size 1)))
186 `(macrolet ((input ((state input unput &rest vars) body)
187 `(lambda (,',tmp1 ,state ,input ,unput)
188 (declare (ignore ,',tmp1)
189 (ignorable ,state ,input ,unput)
190 (optimize (ext:inhibit-warnings 3)))
191 (let ((,input `(the (values (or (unsigned-byte 31) null)
192 kernel:index)
193 ,,input))
194 ,@(loop for var in vars collect `(,var (gensym))))
195 ,body)))
196 (output ((code state output &rest vars) body)
197 `(lambda (,',tmp1 ,',tmp2 ,state ,output)
198 (declare (ignore ,',tmp1)
199 (ignorable ,state ,output)
200 (optimize (ext:inhibit-warnings 3)))
201 (let ((,code ',code)
202 ,@(loop for var in vars collect `(,var (gensym))))
203 `(let ((,',code (the (unsigned-byte 31) ,,',tmp2)))
204 (declare (ignorable ,',code))
205 ,,body)))))
206 (%intern-ef (make-external-format ,name
207 (make-efx :octets-to-code ,input
208 :code-to-octets ,output
209 :min ,(min min max) :max ,(max min max))
210 t
211 #() '())))))
212
213 (defun load-external-format-aliases ()
214 (let ((*package* (find-package "KEYWORD"))
215 (unix::*filename-encoding* :iso8859-1))
216 (with-open-file (stm "ext-formats:aliases" :if-does-not-exist nil)
217 (when stm
218 (do ((alias (read stm nil stm) (read stm nil stm))
219 (value (read stm nil stm) (read stm nil stm)))
220 ((or (eq alias stm) (eq value stm))
221 (unless (eq alias stm)
222 (warn "External-format aliases file ends early.")))
223 (if (and (keywordp alias) (keywordp value))
224 (setf (gethash alias *external-format-aliases*) value)
225 (warn "Bad entry in external-format aliases file: ~S => ~S."
226 alias value)))))))
227
228 (defun %find-external-format (name)
229 ;; avoid loading files, etc., early in the boot sequence
230 (when (or (eq name :iso8859-1)
231 (and (eq name :default) (eq *default-external-format* :iso8859-1)))
232 (return-from %find-external-format
233 (gethash :iso8859-1 *external-formats*)))
234
235 (when (zerop (hash-table-count *external-format-aliases*))
236 (setf (gethash :latin1 *external-format-aliases*) :iso8859-1)
237 (setf (gethash :latin-1 *external-format-aliases*) :iso8859-1)
238 (setf (gethash :iso-8859-1 *external-format-aliases*) :iso8859-1)
239 (load-external-format-aliases))
240
241 (do ((tmp (gethash name *external-format-aliases*)
242 (gethash tmp *external-format-aliases*))
243 (cnt 0 (1+ cnt)))
244 ((or (null tmp) (= cnt 50))
245 (unless (null tmp)
246 (error "External-format aliasing depth exceeded.")))
247 (setq name tmp))
248
249 (or (gethash name *external-formats*)
250 (and (let ((*package* (find-package "STREAM"))
251 (lisp::*enable-package-locked-errors* nil)
252 (*default-external-format* :iso8859-1)
253 (unix::*filename-encoding* :iso8859-1))
254 (load (format nil "ext-formats:~(~A~)" name)
255 :if-does-not-exist nil))
256 (gethash name *external-formats*))))
257
258 (defun %composed-ef-name (a b)
259 (if (consp a) (append a (list b)) (list a b)))
260
261 (defun %compose-external-formats (a b)
262 (when (ef-composingp a)
263 (error "~S is a Composing-External-Format." (ef-name a)))
264 (unless (ef-composingp b)
265 (error "~S is not a Composing-External-Format." (ef-name b)))
266 (make-external-format
267 (%composed-ef-name (ef-name a) (ef-name b))
268 (make-efx
269 :octets-to-code (lambda (tmp state input unput)
270 (declare (ignore tmp))
271 (funcall (ef-octets-to-code b) (ef-slots b)
272 state
273 (funcall (ef-octets-to-code a) (ef-slots a)
274 state
275 input
276 unput)
277 unput))
278 :code-to-octets (lambda (tmp code state output)
279 (declare (ignore tmp))
280 (funcall (ef-code-to-octets b) (ef-slots b)
281 code
282 state
283 `(lambda (x)
284 ,(funcall (ef-code-to-octets a)
285 (ef-slots a)
286 'x state output))))
287 :cache (make-array +ef-max+ :initial-element nil)
288 :min (* (ef-min-octets a) (ef-min-octets b))
289 :max (* (ef-max-octets a) (ef-max-octets b)))
290 nil #() '()))
291
292 (defun find-external-format (name &optional (error-p t))
293 (when (external-format-p name)
294 (return-from find-external-format name))
295
296 (or (if (consp name) (every #'keywordp name) (keywordp name))
297 (error "~S is not a valid external format name." name))
298
299 (when (eq name :default)
300 (setq name *default-external-format*))
301
302 (when (and (consp name) (not (cdr name)))
303 (setq name (car name)))
304
305 (flet ((not-found ()
306 (when (equal *default-external-format* name)
307 (setq *default-external-format* :iso8859-1))
308 (if error-p (error "External format ~S not found." name) nil)))
309 (if (consp name)
310 (let ((efs (mapcar #'%find-external-format name)))
311 (if (member nil efs)
312 (not-found)
313 (let ((name (reduce #'%composed-ef-name (mapcar #'ef-name efs))))
314 (or (gethash name *external-formats*)
315 (%intern-ef (reduce #'%compose-external-formats efs))))))
316 (or (%find-external-format name) (not-found)))))
317
318 (defun flush-external-formats ()
319 (maphash (lambda (name ef)
320 (declare (ignore name))
321 (fill (ef-cache ef) nil))
322 *external-formats*))
323
324 (defvar *.table-inverse.* (make-hash-table :test 'eq :size 7))
325
326 (defun invert-table (table)
327 (declare (type (or (simple-array (unsigned-byte 31) *)
328 (simple-array (unsigned-byte 16) *))
329 table)
330 (optimize (speed 3) (space 0) (safety 0) (debug 0)
331 (ext:inhibit-warnings 3)))
332 (or (gethash table *.table-inverse.*)
333 (let* ((result (make-hash-table))
334 (width (array-dimension table 0))
335 (power (1- (array-rank table)))
336 (base (if (= width 94) 1 0)))
337 (assert (and (< power 3) (<= width 256)))
338 (dotimes (i (array-total-size table))
339 (declare (type (integer 0 (#.array-dimension-limit)) i))
340 (let ((tmp i) (val (row-major-aref table i)) (z 0))
341 (declare (type (integer 0 (#.array-dimension-limit)) tmp)
342 (type (unsigned-byte 32) z))
343 (unless (or (= val #xFFFE) (gethash val result))
344 (dotimes (j power)
345 ;; j is only ever 0 in reality, since no n^3 tables are
346 ;; defined; z was declared as 32-bit above, so that limits
347 ;; us to 0 <= j <= 2 (see the ASSERT)
348 (declare (type (integer 0 2) j))
349 (multiple-value-bind (x y) (floor tmp width)
350 (setq tmp x)
351 (setq z (logior z (ash (the (integer 0 255) (+ y base))
352 (the (integer 0 24)
353 (* 8 (- power j))))))))
354 (setf (gethash val result) (logior z (+ tmp base))))))
355 (setf (gethash table *.table-inverse.*) result))))
356
357
358 (define-condition void-external-format (error)
359 ()
360 (:report
361 (lambda (condition stream)
362 (declare (ignore condition))
363 (format stream "Attempting I/O through void external-format."))))
364
365 (define-external-format :void (:size 0) ()
366 (octets-to-code (state input unput)
367 `(error 'void-external-format))
368 (code-to-octets (code state output)
369 `(error 'void-external-format)))
370
371 (define-external-format :iso8859-1 (:size 1) ()
372 (octets-to-code (state input unput)
373 `(values ,input 1))
374 (code-to-octets (code state output)
375 `(,output (if (> ,code 255) #x3F ,code))))
376
377 ;;; OCTETS-TO-CODEPOINT, CODEPOINT-TO-OCTETS -- Semi-Public
378 ;;;
379 ;;; Normally you'd want to use OCTETS-TO-CHAR and CHAR-TO-OCTETS instead of
380 ;;; these, but that limits you to Lisp's idea of a character - either Latin-1
381 ;;; in 8 bit Lisp images, or the Unicode BMP in 16 bit images. If you want
382 ;;; to read or write texts containing characters not supported by your Lisp,
383 ;;; these macros can be used instead.
384 (defmacro octets-to-codepoint (external-format state count input unput)
385 (let ((tmp1 (gensym)) (tmp2 (gensym)))
386 `(let ((body (funcall (ef-octets-to-code ,external-format)
387 (ef-slots ,external-format)
388 ',state ',input ',unput)))
389 `(multiple-value-bind (,',tmp1 ,',tmp2) ,body
390 (setf ,',count (the kernel:index ,',tmp2))
391 (the (or (unsigned-byte 31) null) ,',tmp1)))))
392
393 (defmacro codepoint-to-octets (external-format code state output)
394 `(funcall (ef-code-to-octets ,external-format) (ef-slots ,external-format)
395 ',code ',state ',output))
396
397
398
399 (defvar *ef-base* +ef-max+)
400 (defvar *ef-extensions* '())
401
402 (defun ensure-cache (ef id reqd)
403 (let ((base (or (getf *ef-extensions* id)
404 (setf (getf *ef-extensions* id)
405 (prog1 *ef-base* (incf *ef-base* reqd))))))
406 (when (< (length (ef-cache ef)) (+ base reqd))
407 (setf (efx-cache (ef-efx ef))
408 (adjust-array (ef-cache ef) (+ base reqd) :initial-element nil)))
409 base))
410
411 ;;; DEF-EF-MACRO -- Public
412 ;;;
413 ;;;
414 (defmacro def-ef-macro (name (ef id reqd idx) body)
415 (let ((tmp (gensym)))
416 `(defun ,name (,ef)
417 (let ((,tmp ,(if (eq id 'lisp::lisp)
418 idx
419 `(+ (ensure-cache ,ef ',id ,reqd) ,idx))))
420 (or (aref (ef-cache ,ef) ,tmp)
421 (setf (aref (ef-cache ,ef) ,tmp)
422 (let ((*compile-print* nil)
423 (*compile-verbose* nil)
424 (*compile-progress* nil)
425 (*gc-verbose* nil))
426 (compile nil ,body))))))))
427
428
429
430 ;;; OCTETS-TO-CHAR, CHAR-TO-OCTETS -- Public
431 ;;;
432 ;;; Read and write one character through an external-format
433 ;;;
434 (defmacro octets-to-char (external-format state count input unput)
435 `(let ((body (octets-to-codepoint ,external-format
436 ,state ,count ,input ,unput)))
437 `(let ((code ,body))
438 (declare (type (unsigned-byte 31) code))
439 (if (< code char-code-limit) (code-char code)
440 #-(and unicode (not unicode-bootstrap)) #\?
441 #+(and unicode (not unicode-bootstrap)) #\U+FFFD))))
442
443 (defmacro char-to-octets (external-format char state output)
444 `(codepoint-to-octets ,external-format (char-code ,char) ,state ,output))
445
446
447 (def-ef-macro ef-string-to-octets (extfmt lisp::lisp +ef-max+ +ef-so+)
448 `(lambda (string start end buffer &aux (ptr 0) (state nil))
449 (declare #|(optimize (speed 3) (safety 0) (space 0) (debug 0))|#
450 (type simple-string string)
451 (type kernel:index start end ptr)
452 (type (simple-array (unsigned-byte 8) (*)) buffer)
453 (ignorable state))
454 (dotimes (i (- end start) (values buffer ptr))
455 (declare (type kernel:index i))
456 ,(char-to-octets extfmt (schar string (+ start i)) state
457 (lambda (b)
458 (when (= ptr (length buffer))
459 (setq buffer (adjust-array buffer (* 2 ptr))))
460 (setf (aref buffer (1- (incf ptr))) b))))))
461
462 (defun string-to-octets (string &key (start 0) end (external-format :default)
463 (buffer nil bufferp))
464 (declare (type string string)
465 (type kernel:index start)
466 (type (or kernel:index null) end)
467 (type (or (simple-array (unsigned-byte 8) (*)) null) buffer))
468 (let* ((buffer (or buffer (make-array (length string)
469 :element-type '(unsigned-byte 8)))))
470 (multiple-value-bind (buffer ptr)
471 (lisp::with-array-data ((string string) (start start) (end end))
472 (funcall (ef-string-to-octets (find-external-format external-format))
473 string start end buffer))
474 (values (if bufferp buffer (lisp::shrink-vector buffer ptr)) ptr))))
475
476 (def-ef-macro ef-octets-to-string (extfmt lisp::lisp +ef-max+ +ef-os+)
477 `(lambda (octets ptr end string &aux (pos -1) (count 0) (state nil))
478 (declare #|(optimize (speed 3) (safety 0) (space 0) (debug 0))|#
479 (type (simple-array (unsigned-byte 8) (*)) octets)
480 (type kernel:index end count)
481 (type (integer -1 (#.array-dimension-limit)) ptr pos)
482 (type simple-string string)
483 (ignorable state))
484 (loop until (>= ptr end)
485 do (when (= pos (length string))
486 (setq string (adjust-array string (* 2 pos))))
487 (setf (schar string (incf pos))
488 ,(octets-to-char extfmt state count
489 (aref octets (incf ptr)) ;;@@ EOF??
490 (lambda (n) (decf ptr n))))
491 finally (return (values string (1+ pos))))))
492
493 (defun octets-to-string (octets &key (start 0) end (external-format :default)
494 (string nil stringp))
495 (declare (type (simple-array (unsigned-byte 8) (*)) octets)
496 (type kernel:index start)
497 (type (or kernel:index null) end)
498 (type (or simple-string null) string))
499 (multiple-value-bind (string pos)
500 (funcall (ef-octets-to-string (find-external-format external-format))
501 octets (1- start) (1- (or end (length octets)))
502 (or string (make-string (length octets))))
503 (values (if stringp string (lisp::shrink-vector string pos)) pos)))
504
505
506
507 (def-ef-macro ef-encode (extfmt lisp::lisp +ef-max+ +ef-en+)
508 `(lambda (string start end result &aux (ptr 0) (state nil))
509 (declare #|(optimize (speed 3) (safety 0) (space 0) (debug 0))|#
510 (type simple-string string)
511 (type kernel:index start end ptr)
512 (type simple-base-string result)
513 (ignorable state))
514 (dotimes (i (- end start) (values result ptr))
515 (declare (type kernel:index i))
516 ,(char-to-octets extfmt (schar string (+ start i)) state
517 (lambda (b)
518 (when (= ptr (length result))
519 (setq result (adjust-array result (* 2 ptr))))
520 (setf (aref result (1- (incf ptr)))
521 (code-char b)))))))
522
523 (defun string-encode (string external-format &optional (start 0) end)
524 (multiple-value-bind (result ptr)
525 (lisp::with-array-data ((string string) (start start) (end end))
526 (funcall (ef-encode (find-external-format external-format))
527 string start end
528 (make-string (length string) :element-type 'base-char)))
529 (lisp::shrink-vector result ptr)))
530
531 (def-ef-macro ef-decode (extfmt lisp::lisp +ef-max+ +ef-de+)
532 `(lambda (string ptr end result &aux (pos -1) (count 0) (state nil))
533 (declare #|(optimize (speed 3) (safety 0) (space 0) (debug 0))|#
534 (type simple-string string)
535 (type kernel:index end count)
536 (type (integer -1 (#.array-dimension-limit)) ptr pos)
537 (type simple-string result)
538 (ignorable state))
539 (loop until (>= ptr end)
540 ;; increasing size of result shouldn't ever be necessary, unless
541 ;; someone implements an encoding smaller than the source string...
542 do (setf (schar result (incf pos))
543 ,(octets-to-char extfmt state count
544 ;; note the need to return NIL for EOF
545 (if (= (1+ ptr) (length string))
546 nil
547 (char-code (char string (incf ptr))))
548 (lambda (n) (decf ptr n))))
549 finally (return (values result (1+ pos))))))
550
551 (defun string-decode (string external-format &optional (start 0) end)
552 (multiple-value-bind (result pos)
553 (lisp::with-array-data ((string string) (start start) (end end))
554 (funcall (ef-decode (find-external-format external-format))
555 string (1- start) (1- end) (make-string (length string))))
556 (lisp::shrink-vector result pos)))

  ViewVC Help
Powered by ViewVC 1.1.5