(format *terminal-io* "~&;;; ** closed ~S (fd ~D)~%"
namestring fd)
(when original
- (revert-file namestring original))))
+ (revert-file namestring original)))
+ :dont-save t)
stream)))))))
(defmethod device-open ((stream file-simple-stream) options)
;;; TODO: use this in src/code/fd-stream.lisp:fd-stream-misc-routine
;;; as well, snarf error reporting from there.
(defun revert-file (filename original)
- (declare (type simple-base-string filename)
- (type (or simple-base-string null) original))
+ (declare (type simple-string filename)
+ (type (or simple-string null) original))
;; 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.
;;; TODO: use this in src/code/fd-stream.lisp:fd-stream-misc-routine
;;; as well, snarf error reporting from there.
(defun delete-original (filename original)
- (declare (type simple-base-string filename)
- (type (or simple-base-string null) original))
+ (declare (type simple-string filename)
+ (type (or simple-string null) original))
(when original
(multiple-value-bind (okay err) (sb-unix:unix-unlink original)
(unless okay
(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)
(warn "Unable to memory-map entire file.")
(setf size (1- most-positive-fixnum)))
(let ((buffer
+ #-win32
(handler-case
- (sb-posix:mmap nil size prot sb-posix::MAP-SHARED fd 0)
- (sb-posix:syscall-error nil))))
+ (sb-posix:mmap nil size prot sb-posix::MAP-SHARED fd 0)
+ (sb-posix:syscall-error nil))
+ #+win32
+ (let ((mapping
+ (sb-win32:create-file-mapping
+ (sb-win32:get-osfhandle fd) nil 2 0 size nil)))
+ (typecase mapping
+ ((integer -1 0) nil)
+ (t (let ((sap (prog1 (sb-win32:map-view-of-file
+ mapping 4 0 0 size)
+ (sb-win32:close-handle mapping))))
+ (and (not (zerop (sb-sys:sap-int sap))) sap)))))))
(when (null buffer)
(sb-unix:unix-close fd)
(sb-ext:cancel-finalization stream)
(melding-stream stream) efmt 'mapped))
(sb-ext:finalize stream
(lambda ()
- (sb-posix:munmap buffer size)
- (format *terminal-io* "~&;;; ** unmapped ~S" buffer))))))
+ #+win32 (sb-win32:unmap-view-of-file buffer)
+ #-win32 (sb-posix:munmap buffer size)
+ (format *terminal-io* "~&;;; ** unmapped ~S" buffer))
+ :dont-save t))))
stream)))
(defmethod device-close ((stream mapped-file-simple-stream) abort)
(with-stream-class (mapped-file-simple-stream stream)
(when (sm buffer stream)
- (sb-posix:munmap (sm buffer stream) (sm buf-len stream))
+ #+win32 (sb-win32:unmap-view-of-file (sm buffer stream))
+ #-win32 (sb-posix:munmap (sm buffer stream) (sm buf-len stream))
(setf (sm buffer stream) nil))
(sb-unix:unix-close (or (sm input-handle stream) (sm output-handle stream))))
t)
(let ((pathname (getf options :filename)))
(with-stream-class (probe-simple-stream stream)
(add-stream-instance-flags stream :simple)
- (when (sb-unix:unix-access (sb-int:unix-namestring pathname nil) sb-unix:f_ok)
+ (when (sb-unix:unix-access (file-namestring pathname) sb-unix:f_ok)
(setf (sm pathname stream) pathname)
t))))