CMUCL commit: src/code (extfmts.lisp fd-stream.lisp)

[Raymond Toy]

    Date: Friday, July 2, 2010 @ 12:29:55
  Author: rtoy
    Path: /project/cmucl/cvsroot/src/code

Modified: extfmts.lisp fd-stream.lisp

code/extfmts.lisp:
o The optional error parameter doesn't need to be optional in
  DEFINE-EXTERNAL-FORMAT, EF-STRING-TO-OCTETS, EF-OCTETS-TO-STRING,
  EF-ENCODE and EF-DECODE.

code/fd-stream.lisp:
o Update comments for char-to-octets-error and octets-to-char-error.
o Forgot to pass the error handler to char-to-octets in EF-SOUT and
  EF-STRLEN.


----------------+
 extfmts.lisp   |   14 +++++++-------
 fd-stream.lisp |   18 +++++++++---------
 2 files changed, 16 insertions(+), 16 deletions(-)


Index: src/code/extfmts.lisp
diff -u src/code/extfmts.lisp:1.27 src/code/extfmts.lisp:1.28
--- src/code/extfmts.lisp:1.27	Thu Jul  1 22:50:35 2010
+++ src/code/extfmts.lisp	Fri Jul  2 12:29:55 2010
@@ -5,7 +5,7 @@
 ;;; domain.
 ;;; 
 (ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/code/extfmts.lisp,v 1.27 2010-07-02 02:50:35 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/code/extfmts.lisp,v 1.28 2010-07-02 16:29:55 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -208,7 +208,7 @@
 			      ;; IDENTITY is here to protect against SETF
 			      (identity (svref %slots% ,',(second slot))))))))
     `(macrolet ((octets-to-code ((state input unput error &rest vars) body)
-		  `(lambda (,state ,input ,unput &optional ,error)
+		  `(lambda (,state ,input ,unput ,error)
 		     (declare (ignorable ,state ,input ,unput ,error)
 			      (optimize (ext:inhibit-warnings 3)))
 		     (let (,@',slotb
@@ -216,7 +216,7 @@
 			   ,@(loop for var in vars collect `(,var (gensym))))
 		       ,body)))
 		(code-to-octets ((code state output error &rest vars) body)
-		  `(lambda (,',tmp ,state ,output &optional ,error)
+		  `(lambda (,',tmp ,state ,output ,error)
 		     (declare (ignorable ,state ,output ,error)
 			      (optimize (ext:inhibit-warnings 3)))
 		     (let (,@',slotb
@@ -680,7 +680,7 @@
       (funcall f state))))
 
 (def-ef-macro ef-string-to-octets (extfmt lisp::lisp +ef-max+ +ef-so+)
-  `(lambda (string start end buffer &optional error &aux (ptr 0) (state nil))
+  `(lambda (string start end buffer error &aux (ptr 0) (state nil))
      (declare #|(optimize (speed 3) (safety 0) (space 0) (debug 0))|#
 	      (type simple-string string)
 	      (type kernel:index start end ptr)
@@ -715,7 +715,7 @@
       (values (if bufferp buffer (lisp::shrink-vector buffer ptr)) ptr))))
 
 (def-ef-macro ef-octets-to-string (extfmt lisp::lisp +ef-max+ +ef-os+)
-  `(lambda (octets ptr end state string s-start s-end &optional error
+  `(lambda (octets ptr end state string s-start s-end error
 	    &aux (pos s-start) (count 0) (last-octet 0))
      (declare (optimize (speed 3) (safety 0) #|(space 0) (debug 0)|#)
 	      (type (simple-array (unsigned-byte 8) (*)) octets)
@@ -776,7 +776,7 @@
 
 
 (def-ef-macro ef-encode (extfmt lisp::lisp +ef-max+ +ef-en+)
-  `(lambda (string start end result &optional error  &aux (ptr 0) (state nil))
+  `(lambda (string start end result error  &aux (ptr 0) (state nil))
      (declare #|(optimize (speed 3) (safety 0) (space 0) (debug 0))|#
 	      (type simple-string string)
 	      (type kernel:index start end ptr)
@@ -807,7 +807,7 @@
     (lisp::shrink-vector result ptr)))
 
 (def-ef-macro ef-decode (extfmt lisp::lisp +ef-max+ +ef-de+)
-  `(lambda (string ptr end result &optional error &aux (pos -1) (count 0) (state nil))
+  `(lambda (string ptr end result error &aux (pos -1) (count 0) (state nil))
      (declare #|(optimize (speed 3) (safety 0) (space 0) (debug 0))|#
 	      (type simple-string string)
 	      (type kernel:index end count)
Index: src/code/fd-stream.lisp
diff -u src/code/fd-stream.lisp:1.104 src/code/fd-stream.lisp:1.105
--- src/code/fd-stream.lisp:1.104	Fri Jul  2 07:57:53 2010
+++ src/code/fd-stream.lisp	Fri Jul  2 12:29:55 2010
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /project/cmucl/cvsroot/src/code/fd-stream.lisp,v 1.104 2010-07-02 11:57:53 rtoy Exp $")
+  "$Header: /project/cmucl/cvsroot/src/code/fd-stream.lisp,v 1.105 2010-07-02 16:29:55 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -270,12 +270,10 @@
   ;; characters.  If NIL, then the external format should handle it
   ;; itself, doing whatever is deemed appropriate.  If non-NIL, this
   ;; should be a function (or symbol) that the external format can
-  ;; funcall to deal with the error.  The function should take 4
-  ;; arguments: a message string, the offending octet, the number of
-  ;; octets read so far in decoding, and a function to unput
-  ;; characters.  If the function returns, it should return the code
-  ;; of the desired replacement character and the number of octets
-  ;; read (the input parameter).
+  ;; funcall to deal with the error.  The function should take three
+  ;; arguments: a message string, the offending octet, and the number
+  ;; of octets read so far in decoding; if the function returns it
+  ;; should return the codepoint of the desired replacement character.
   #+unicode
   (octets-to-char-error nil)
   ;;
@@ -706,7 +704,8 @@
 				     (do-output stream sap 0 tail t)
 				     (setq sap (fd-stream-obuf-sap stream)
 					   tail 0))
-				   (setf (bref sap (1- (incf tail))) byte))))
+				   (setf (bref sap (1- (incf tail))) byte))
+				 (fd-stream-char-to-octets-error stream)))
        (setf (fd-stream-obuf-tail stream) tail))))
 
 
@@ -2347,7 +2346,8 @@
 					(fd-stream-co-state stream)
 					(lambda (byte)
 					  (declare (ignore byte))
-					  (incf count)))))
+					  (incf count))
+					(fd-stream-char-to-octets-erroor stream))))
        (let* ((co-state (fd-stream-co-state stream))
 	      (old-ef-state (efstate (cdr (fd-stream-co-state stream))))
 	      (old-state (cons (car co-state) old-ef-state)))