Simplify (and robustify) regular PACKing
[sbcl.git] / contrib / sb-simple-streams / file.lisp
index e668269..5602b28 100644 (file)
 
 (defmethod device-close ((stream file-simple-stream) abort)
   (with-stream-class (file-simple-stream stream)
-    (let ((fd (or (sm input-handle stream) (sm output-handle stream))))
-      (when (sb-int:fixnump fd)
+    (let ((fd (or (sm input-handle stream) (sm output-handle stream)))
+          (closed nil))
+      (when (integerp fd)
         (cond (abort
                (when (any-stream-instance-flags stream :output)
+                 #+win32 (progn (sb-unix:unix-close fd) (setf closed t))
                  (revert-file (sm filename stream) (sm original stream))))
               (t
                (when (sm delete-original stream)
                  (delete-original (sm filename stream) (sm original stream)))))
-        (sb-unix:unix-close fd))
+        (unless closed
+          (sb-unix:unix-close fd)))
       (when (sm buffer stream)
         (free-buffer (sm buffer stream))
         (setf (sm buffer stream) nil))))
 (defmethod device-file-position ((stream file-simple-stream))
   (with-stream-class (file-simple-stream stream)
     (let ((fd (or (sm input-handle stream) (sm output-handle stream))))
-      (if (sb-int:fixnump fd)
+      (if (integerp fd)
           (values (sb-unix:unix-lseek fd 0 sb-unix:l_incr))
           (file-position fd)))))
 
   (declare (type fixnum value))
   (with-stream-class (file-simple-stream stream)
     (let ((fd (or (sm input-handle stream) (sm output-handle stream))))
-      (if (sb-int:fixnump fd)
+      (if (integerp fd)
           (values (sb-unix:unix-lseek fd
                                       (if (minusp value) (1+ value) value)
                                       (if (minusp value) sb-unix:l_xtnd sb-unix:l_set)))
 (defmethod device-file-length ((stream file-simple-stream))
   (with-stream-class (file-simple-stream stream)
     (let ((fd (or (sm input-handle stream) (sm output-handle stream))))
-      (if (sb-int:fixnump fd)
+      (if (integerp fd)
           (multiple-value-bind (okay dev ino mode nlink uid gid rdev size)
               (sb-unix:unix-fstat (sm input-handle stream))
             (declare (ignore dev ino mode nlink uid gid rdev))
              (prot (logior (if input sb-posix::PROT-READ 0)
                            (if output sb-posix::PROT-WRITE 0)))
              (fd (or (sm input-handle stream) (sm output-handle stream))))
-        (unless (sb-int:fixnump fd)
+        (unless (integerp fd)
           (error "Can't memory-map an encapsulated stream."))
         (multiple-value-bind (okay dev ino mode nlink uid gid rdev size)
             (sb-unix:unix-fstat fd)
   (let ((pathname (getf options :filename)))
     (with-stream-class (probe-simple-stream stream)
       (add-stream-instance-flags stream :simple)
-      (when (sb-unix:unix-access (file-namestring pathname) sb-unix:f_ok)
+      (when (sb-unix:unix-access (%file-namestring pathname) sb-unix:f_ok)
         (setf (sm pathname stream) pathname)
         t))))