/[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.18 by rtoy, Sat Sep 19 14:12:22 2009 UTC revision 1.18.4.2 by rtoy, Sat Sep 26 13:32:26 2009 UTC
# Line 694  Line 694 
694        (values (if bufferp buffer (lisp::shrink-vector buffer ptr)) ptr))))        (values (if bufferp buffer (lisp::shrink-vector buffer ptr)) ptr))))
695    
696  (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+)
697    `(lambda (octets ptr end string &aux (pos 0) (count 0) (state nil) (last-octet 0))    `(lambda (octets ptr end string s-start s-end &aux (pos s-start) (count 0) (state nil) (last-octet 0))
698       (declare (optimize (speed 3) #|(safety 0) (space 0) (debug 0)|#)       (declare (optimize (speed 3) #|(safety 0) (space 0) (debug 0)|#)
699                (type (simple-array (unsigned-byte 8) (*)) octets)                (type (simple-array (unsigned-byte 8) (*)) octets)
700                (type kernel:index pos end count last-octet)                (type kernel:index pos end count last-octet s-start s-end)
701                (type (integer -1 (#.array-dimension-limit)) ptr)                (type (integer -1 (#.array-dimension-limit)) ptr)
702                (type simple-string string)                (type simple-string string)
703                (ignorable state))                (ignorable state))
704       (catch 'end-of-octets       (catch 'end-of-octets
705         (loop         (loop while (< pos s-end)
706            (when (= pos (length string))            do (setf (schar string pos)
707              (setq string (adjust-array string (* 2 pos))))                     (octets-to-char ,extfmt state count
708            (setf (schar string pos)                                     (if (>= ptr end)
709                  (octets-to-char ,extfmt state count                                         (throw 'end-of-octets nil)
710                                  (if (>= ptr end)                                         (aref octets (incf ptr)))
711                                      (throw 'end-of-octets nil)                                     (lambda (n) (decf ptr n))))
                                     (aref octets (incf ptr)))  
                                 (lambda (n) (decf ptr n))))  
712            (incf pos)            (incf pos)
713            (incf last-octet count)))            (incf last-octet count)))
714       (values string pos last-octet)))       (values string pos last-octet)))
715    
716  (defun octets-to-string (octets &key (start 0) end (external-format :default)  (defun octets-to-string (octets &key (start 0) end (external-format :default)
717                                       (string nil stringp))                                       (string nil stringp)
718                                         (s-start 0) (s-end (length string)))
719    "Octets-to-string converts an array of octets in Octets to a string    "Octets-to-string converts an array of octets in Octets to a string
720    according to the specified External-format.  The array of octets is    according to the specified External-format.  The array of octets is
721    bounded by Start (defaulting ot 0) and End (defaulting to the end of    bounded by Start (defaulting ot 0) and End (defaulting to the end of
# Line 726  Line 725 
725    is created.  Three values are returned: the string, the number of    is created.  Three values are returned: the string, the number of
726    characters read, and the number of octets consumed."    characters read, and the number of octets consumed."
727    (declare (type (simple-array (unsigned-byte 8) (*)) octets)    (declare (type (simple-array (unsigned-byte 8) (*)) octets)
728             (type kernel:index start)             (type kernel:index start s-start s-end)
729             (type (or kernel:index null) end)             (type (or kernel:index null) end)
730             (type (or simple-string null) string))             (type (or simple-string null) string))
731    (multiple-value-bind (string pos last-octet)    (multiple-value-bind (string pos last-octet)
732        (funcall (ef-octets-to-string external-format)        (funcall (ef-octets-to-string external-format)
733                 octets (1- start) (1- (or end (length octets)))                 octets (1- start) (1- (or end (length octets)))
734                 (or string (make-string (length octets))))                 (or string (make-string (length octets)))
735                   s-start s-end)
736      (values (if stringp string (lisp::shrink-vector string pos)) pos last-octet)))      (values (if stringp string (lisp::shrink-vector string pos)) pos last-octet)))
737    
738    

Legend:
Removed from v.1.18  
changed lines
  Added in v.1.18.4.2

  ViewVC Help
Powered by ViewVC 1.1.5