- (output (any-stream-instance-flags stream :output))
- (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)
- (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)
- (declare (ignore ino mode nlink uid gid rdev))
- (unless okay
- (sb-unix:unix-close fd)
- (sb-ext:cancel-finalization stream)
- (error "Error fstating ~S: ~A" stream
- (sb-int:strerror dev)))
- (when (> size most-positive-fixnum)
- ;; Or else BUF-LEN has to be a general integer, or
- ;; maybe (unsigned-byte 32). In any case, this means
- ;; BUF-MAX and BUF-PTR have to be the same, which means
- ;; number-consing every time BUF-PTR moves...
- ;; Probably don't have the address space available to map
- ;; bigger files, anyway. Maybe DEVICE-READ can adjust
- ;; the mapped portion of the file when necessary?
- (warn "Unable to memory-map entire file.")
- (setf size most-positive-fixnum))
- (let ((buffer
- (handler-case
- (sb-posix:mmap nil size prot sb-posix::MAP-SHARED fd 0)
- (sb-posix:syscall-error nil))))
- (when (null buffer)
- (sb-unix:unix-close fd)
- (sb-ext:cancel-finalization stream)
- (error "Unable to map file."))
- (setf (sm buffer stream) buffer
- (sm buffpos stream) 0
- (sm buffer-ptr stream) size
- (sm buf-len stream) size)
- (when (any-stream-instance-flags stream :output)
- (setf (sm control-out stream) *std-control-out-table*))
- (let ((efmt (getf options :external-format :default)))
+ (output (any-stream-instance-flags stream :output))
+ (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)
+ (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)
+ (declare (ignore ino mode nlink uid gid rdev))
+ (unless okay
+ (sb-unix:unix-close fd)
+ (sb-ext:cancel-finalization stream)
+ (error "Error fstating ~S: ~A" stream
+ (sb-int:strerror dev)))
+ (when (>= size most-positive-fixnum)
+ ;; Or else BUF-LEN has to be a general integer, or
+ ;; maybe (unsigned-byte 32). In any case, this means
+ ;; BUF-MAX and BUF-PTR have to be the same, which means
+ ;; number-consing every time BUF-PTR moves...
+ ;; Probably don't have the address space available to map
+ ;; bigger files, anyway. Maybe DEVICE-READ can adjust
+ ;; the mapped portion of the file when necessary?
+ (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))
+ #+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)
+ (error "Unable to map file."))
+ (setf (sm buffer stream) buffer
+ (sm buffpos stream) 0
+ (sm buffer-ptr stream) size
+ (sm buf-len stream) size)
+ (when (any-stream-instance-flags stream :output)
+ (setf (sm control-out stream) *std-control-out-table*))
+ (let ((efmt (getf options :external-format :default)))