/[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.4 by rtoy, Mon Oct 5 03:58:01 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 state string s-start s-end &aux (pos s-start) (count 0) (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)                                         (bref 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 state)))
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                                         (state nil))
720    "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
721    according to the specified External-format.  The array of octets is    according to the specified External-format.  The array of octets is
722    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 726 
726    is created.  Three values are returned: the string, the number of    is created.  Three values are returned: the string, the number of
727    characters read, and the number of octets consumed."    characters read, and the number of octets consumed."
728    (declare (type (simple-array (unsigned-byte 8) (*)) octets)    (declare (type (simple-array (unsigned-byte 8) (*)) octets)
729             (type kernel:index start)             (type kernel:index start s-start s-end)
730             (type (or kernel:index null) end)             (type (or kernel:index null) end)
731             (type (or simple-string null) string))             (type (or simple-string null) string))
732    (multiple-value-bind (string pos last-octet)    (multiple-value-bind (string pos last-octet new-state)
733        (funcall (ef-octets-to-string external-format)        (funcall (ef-octets-to-string external-format)
734                 octets (1- start) (1- (or end (length octets)))                 octets (1- start) (1- (or end (length octets)))
735                 (or string (make-string (length octets))))                 state
736      (values (if stringp string (lisp::shrink-vector string pos)) pos last-octet)))                 (or string (make-string (length octets)))
737                   s-start s-end)
738        (values (if stringp string (lisp::shrink-vector string pos)) pos last-octet new-state)))
739    
740    
741    

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

  ViewVC Help
Powered by ViewVC 1.1.5