/[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.4.4 by rtoy, Mon Oct 5 03:58:01 2009 UTC revision 1.18.4.5 by rtoy, Tue Oct 6 12:48:32 2009 UTC
# Line 567  Line 567 
567                              `(+ (ensure-cache ,tmp1 ',id ,reqd) ,idx))))                              `(+ (ensure-cache ,tmp1 ',id ,reqd) ,idx))))
568             (funcall (or (aref (ef-cache ,tmp1) ,tmp2)             (funcall (or (aref (ef-cache ,tmp1) ,tmp2)
569                          (setf (aref (ef-cache ,tmp1) ,tmp2)                          (setf (aref (ef-cache ,tmp1) ,tmp2)
570                              (let ((*compile-print* nil)                                (let ((*compile-print* nil)
571                                    ;; Set default format when we compile so we                                      ;; Set default format when we compile so we
572                                    ;; can see compiler messages.  If we don't,                                      ;; can see compiler messages.  If we don't,
573                                    ;; we run into a problem that we might be                                      ;; we run into a problem that we might be
574                                    ;; changing the default format while we're                                      ;; changing the default format while we're
575                                    ;; compiling, and we don't know how to output                                      ;; compiling, and we don't know how to output
576                                    ;; the compiler messages.                                      ;; the compiler messages.
577                                    #|(*default-external-format* :iso8859-1)|#)                                      #|(*default-external-format* :iso8859-1)|#)
578                                (compile nil `(lambda (%slots%)                                  (compile nil `(lambda (%slots%)
579                                                (declare (ignorable %slots%))                                                 (declare (ignorable %slots%))
580                                                (block ,',blknm                                                 (block ,',blknm
581                                                  ,,body))))))                                                   ,,body))))))
582                      (ef-slots ,tmp1))))                      (ef-slots ,tmp1))))
583         (declaim (inline ,name))         (declaim (inline ,name))
584         (defun ,name (,tmp1)         (defun ,name (,tmp1)
# Line 715  Line 715 
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))                                       (s-start 0) (s-end nil s-end-p)
719                                       (state nil))                                       (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
# 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 s-start s-end)             (type kernel:index start s-start)
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 new-state)    (let ((s-end (if s-end-p
733        (funcall (ef-octets-to-string external-format)                     s-end
734                 octets (1- start) (1- (or end (length octets)))                     (if stringp
735                 state                         (length string)
736                 (or string (make-string (length octets)))                         (length octets)))))
737                 s-start s-end)      (multiple-value-bind (string pos last-octet new-state)
738      (values (if stringp string (lisp::shrink-vector string pos)) pos last-octet new-state)))          (funcall (ef-octets-to-string external-format)
739                     octets (1- start) (1- (or end (length octets)))
740                     state
741                     (or string (make-string (length octets)))
742                     s-start s-end)
743          (values (if stringp string (lisp::shrink-vector string pos)) pos last-octet new-state))))
744    
745    
746    

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

  ViewVC Help
Powered by ViewVC 1.1.5