X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ffd-stream.lisp;h=753012881470e66e50042b9d7a57e03c82e8b3ce;hb=15d6e7c9a2c3234f95dfe278046fa2fee1b0c007;hp=fe180be124b9a5e37290ddff78c40a33a9c94a45;hpb=f3f1143a09fa2e50eec13614cc6b0306b2b11fad;p=sbcl.git

diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index fe180be..7530128 100644
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -574,7 +574,7 @@
 	   (let ((,element-var
 		  (catch 'eof-input-catcher
 		    (input-at-least ,stream-var ,bytes)
-		    ,@read-forms)))
+		    (locally ,@read-forms))))
 	     (cond (,element-var
 		    (incf (fd-stream-ibuf-head ,stream-var) ,bytes)
 		    ,element-var)
@@ -663,14 +663,17 @@
 	do (return-from pick-input-routine
 	     (values
 	      (lambda (stream eof-error eof-value)
-		(let ((sap (fd-stream-ibuf-sap stream))
-		      (head (fd-stream-ibuf-head stream)))
-		  (loop for j from 0 below (/ i 8)
-			with result = 0
-			do (setf result
-				 (+ (* 256 result)
-				    (sap-ref-8 sap (+ head j))))
-			finally (return (dpb result (byte i 0) -1)))))
+		(input-wrapper (stream (/ i 8) eof-error eof-value)
+		  (let ((sap (fd-stream-ibuf-sap stream))
+			(head (fd-stream-ibuf-head stream)))
+		    (loop for j from 0 below (/ i 8)
+			  with result = 0
+			  do (setf result
+				   (+ (* 256 result)
+				      (sap-ref-8 sap (+ head j))))
+			  finally (return (if (logbitp (1- i) result)
+                                              (dpb result (byte i 0) -1)
+                                              result))))))
 	      `(signed-byte ,i)
 	      (/ i 8)))))
 
@@ -882,27 +885,40 @@
      (setf (fd-stream-unread fd-stream) arg1)
      (setf (fd-stream-listen fd-stream) t))
     (:close
-     (cond (arg1
-	    ;; We got us an abort on our hands.
+     (cond (arg1 ; We got us an abort on our hands.
 	    (when (fd-stream-handler fd-stream)
-		  (sb!sys:remove-fd-handler (fd-stream-handler fd-stream))
-		  (setf (fd-stream-handler fd-stream) nil))
+	      (sb!sys:remove-fd-handler (fd-stream-handler fd-stream))
+	      (setf (fd-stream-handler fd-stream) nil))
+	    ;; We can't do anything unless we know what file were
+	    ;; dealing with, and we don't want to do anything
+	    ;; strange unless we were writing to the file.
 	    (when (and (fd-stream-file fd-stream)
 		       (fd-stream-obuf-sap fd-stream))
-	      ;; We can't do anything unless we know what file were
-	      ;; dealing with, and we don't want to do anything
-	      ;; strange unless we were writing to the file.
 	      (if (fd-stream-original fd-stream)
-		  ;; We have a handle on the original, just revert.
-		  (multiple-value-bind (okay err)
-		      (sb!unix:unix-rename (fd-stream-original fd-stream)
-					   (fd-stream-file fd-stream))
-		    (unless okay
-		      (simple-stream-perror
-		       "couldn't restore ~S to its original contents"
-		       fd-stream
-		       err)))
-		  ;; We can't restore the original, so nuke that puppy.
+		  ;; If the original is EQ to file we are appending
+		  ;; and can just close the file without renaming.
+		  (unless (eq (fd-stream-original fd-stream)
+			      (fd-stream-file fd-stream))
+		    ;; We have a handle on the original, just revert.
+		    (multiple-value-bind (okay err)
+			(sb!unix:unix-rename (fd-stream-original fd-stream)
+					     (fd-stream-file fd-stream))
+		      (unless okay
+			(simple-stream-perror
+			 "couldn't restore ~S to its original contents"
+			 fd-stream
+			 err))))
+		  ;; We can't restore the original, and aren't
+		  ;; appending, so nuke that puppy.
+		  ;;
+		  ;; FIXME: This is currently the fate of superseded
+		  ;; files, and according to the CLOSE spec this is
+		  ;; wrong. However, there seems to be no clean way to
+		  ;; do that that doesn't involve either copying the
+		  ;; data (bad if the :abort resulted from a full
+		  ;; disk), or renaming the old file temporarily
+		  ;; (probably bad because stream opening becomes more
+		  ;; racy).
 		  (multiple-value-bind (okay err)
 		      (sb!unix:unix-unlink (fd-stream-file fd-stream))
 		    (unless okay
@@ -1185,6 +1201,8 @@
    :IF-DOES-NOT-EXIST - one of :ERROR, :CREATE or NIL
   See the manual for details."
 
+  (declare (ignore external-format)) ; FIXME: CHECK-TYPE?  WARN-if-not?
+  
   ;; Calculate useful stuff.
   (multiple-value-bind (input output mask)
       (case direction
@@ -1240,12 +1258,16 @@
       (if (eq if-does-not-exist :create)
 	(setf mask (logior mask sb!unix:o_creat)))
 
-      (let ((original (if (member if-exists
-				  '(:rename :rename-and-delete))
-			  (pick-backup-name namestring)))
+      (let ((original (case if-exists
+			((:rename :rename-and-delete)
+			 (pick-backup-name namestring))
+			((:append)
+			 ;; KLUDGE: Provent CLOSE from deleting
+			 ;; appending streams when called with :ABORT T
+			 namestring)))
 	    (delete-original (eq if-exists :rename-and-delete))
 	    (mode #o666))
-	(when original
+	(when (and original (not (eq original namestring)))
 	  ;; We are doing a :RENAME or :RENAME-AND-DELETE. Determine
 	  ;; whether the file already exists, make sure the original
 	  ;; file is not a directory, and keep the mode.